module Language.Symantic.Document.Term.Dim
 ( module Language.Symantic.Document.Sym
 , module Language.Symantic.Document.Term.Dim
 ) where

import Control.Applicative (Applicative(..))
import Data.Bool
import Data.Eq (Eq(..))
import Data.Function (($), (.), id)
import Data.Int (Int)
import Data.Monoid (Monoid(..))
import Data.Ord (Ord(..))
import Data.Semigroup (Semigroup(..))
import Data.String (IsString(..))
import GHC.Exts (IsList(..))
import Prelude ((+), pred)
import Text.Show (Show(..))
import qualified Data.List as List
import qualified Data.Text as Text
import qualified Data.Text.Lazy as TL

import Language.Symantic.Document.Sym

-- * Type 'Dim'
data Dim
 =   Dim
 {   dim_width       :: Int -- ^ Maximun line length.
 ,   dim_height      :: Int -- ^ Number of newlines.
 ,   dim_width_first :: Int -- ^ Length of the first line.
 ,   dim_width_last  :: Int -- ^ Length of the last line.
 } deriving (Eq, Show)
instance Semigroup Dim where
	Dim{dim_width=wx, dim_height=hx, dim_width_first=wfx, dim_width_last=wlx} <>
	 Dim{dim_width=wy, dim_height=hy, dim_width_first=wfy, dim_width_last=wly} =
		let h = hx + hy in
		case (hx, hy) of
		 (0, 0) -> let w = wx  + wy  in Dim w h w w
		 (0, _) -> let v = wfx + wfy in Dim (max v (wx + wy)) h v wly
		 (_, 0) -> let v = wlx + wfy in Dim (max v (wx + wy)) h wfx v
		 _      -> Dim (max wx wy) h wfx wly
instance Monoid Dim where
	mempty  = Dim 0 0 0 0
	mappend = (<>)

-- * Type 'Reader'
data Reader
 =   Reader
 {   reader_indent      :: !(Indent Dimension) -- ^ Current indentation level, used by 'newline'.
 ,   reader_newline     :: Dimension           -- ^ How to display 'newline'.
 ,   reader_wrap_column :: !(Column Dimension) -- ^ 'Column' after which 'wrap' breaks on a 'breakpoint' or 'breakspace'.
 }

-- | Default 'Reader'.
defReader :: Reader
defReader = Reader
 { reader_indent      = 0
 , reader_newline     = newlineWithIndent
 , reader_wrap_column = 80
 }

-- * Type 'State'
type State = Column Dimension

defState :: State
defState = 0

-- * Type 'Dimension'
newtype Dimension
 =      Dimension
 {    unDimension :: Reader ->
                     State  ->
                     (State -> Dim -> Dim) -> -- normal continuation
                     (State -> Dim -> Dim) -> -- should-wrap continuation
                     Dim }
type instance Column Dimension = Int
type instance Indent Dimension = Int

dim :: Dimension -> Dim
dim (Dimension p) = p defReader defState oko oko
	where oko _st = id

instance IsList Dimension where
	type Item Dimension = Dimension
	fromList = mconcat
	toList   = pure
instance Semigroup Dimension where
	x <> y = Dimension $ \ro st ok ko ->
		unDimension x ro st
		 (\sx tx -> unDimension y ro sx
			 (\sy ty -> ok sy (tx<>ty))
			 (\sy ty -> ko sy (tx<>ty)))
		 (\sx tx -> unDimension y ro sx
			 (\sy ty -> ko sy (tx<>ty))
			 (\sy ty -> ko sy (tx<>ty)))
instance Monoid Dimension where
	mempty  = empty
	mappend = (<>)
instance IsString Dimension where
	fromString = string

writeH :: Column Dimension -> Dimension
writeH len =
	Dimension $ \ro col ok ko ->
		let newCol = col + len in
		(if newCol <= reader_wrap_column ro then ok else ko)
		newCol Dim
		 { dim_width       = newCol
		 , dim_height      = 0
		 , dim_width_last  = newCol
		 , dim_width_first = newCol
		 }

instance Doc_Text Dimension where
	empty     = Dimension $ \_ro st ok _ko -> ok st mempty
	charH   _ = writeH 1
	stringH t = writeH $ List.length t
	textH   t = writeH $ Text.length t
	ltextH  t = writeH $ intOfInt64 $ TL.length t
	int       = stringH . show
	integer   = stringH . show
	replicate cnt p | cnt <= 0  = empty
	                | otherwise = p <> replicate (pred cnt) p
	newline = Dimension $ \ro -> unDimension (reader_newline ro) ro
instance Doc_Align Dimension where
	align p = Dimension $ \ro st -> unDimension p ro{reader_indent=st} st
	withNewline nl  p = Dimension $ \ro -> unDimension p ro{reader_newline=nl}
	withIndent  ind p = Dimension $ \ro -> unDimension p ro{reader_indent=ind}
	incrIndent  ind p = Dimension $ \ro -> unDimension p ro{reader_indent=reader_indent ro + ind}
	column f = Dimension $ \ro st -> unDimension (f st) ro st
	newlineWithoutIndent = Dimension $ \_ro _st ok _ko ->
		ok 0 Dim
		 { dim_width       = 0
		 , dim_height      = 1
		 , dim_width_first = 0
		 , dim_width_last  = 0
		 }
	newlineWithIndent = Dimension $ \ro _st ok _ko ->
		let ind = reader_indent ro in
		ok ind Dim
		 { dim_width       = ind
		 , dim_height      = 1
		 , dim_width_first = 0
		 , dim_width_last  = ind
		 }

instance Doc_Wrap Dimension where
	ifFit x y = Dimension $ \ro st ok ko ->
		unDimension x ro st ok (\_sx _tx -> unDimension y ro st ok ko)
	breakpoint onNoBreak onBreak p = Dimension $ \ro st ok ko ->
		unDimension (onNoBreak <> p) ro st ok
		 (\_sp _tp -> unDimension (onBreak <> p) ro st ok ko)
	withWrapColumn col p = Dimension $ \ro -> unDimension p ro{reader_wrap_column=col}
instance Doc_Color Dimension where
	reverse     = id
	black       = id
	red         = id
	green       = id
	yellow      = id
	blue        = id
	magenta     = id
	cyan        = id
	white       = id
	blacker     = id
	redder      = id
	greener     = id
	yellower    = id
	bluer       = id
	magentaer   = id
	cyaner      = id
	whiter      = id
	onBlack     = id
	onRed       = id
	onGreen     = id
	onYellow    = id
	onBlue      = id
	onMagenta   = id
	onCyan      = id
	onWhite     = id
	onBlacker   = id
	onRedder    = id
	onGreener   = id
	onYellower  = id
	onBluer     = id
	onMagentaer = id
	onCyaner    = id
	onWhiter    = id
instance Doc_Decoration Dimension where
	bold      = id
	underline = id
	italic    = id