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

import Control.Applicative (Applicative(..))
import Data.Bool
import Data.Eq (Eq(..))
import Data.Function (($), (.), id)
import Data.Maybe (Maybe(..))
import Data.Monoid (Monoid(..))
import Data.Ord (Ord(..))
import Data.Semigroup (Semigroup(..))
import Data.String (IsString(..))
import GHC.Exts (IsList(..))
import Prelude ((+))
import Text.Show (Show(..))

import Language.Symantic.Document.Sym

-- * Type 'Dim'
data Dim
 =   Dim
 {   dim_width       :: Nat -- ^ Maximun line length.
 ,   dim_height      :: Nat -- ^ Number of newlines.
 ,   dim_width_first :: Nat -- ^ Nat of the first line.
 ,   dim_width_last  :: Nat -- ^ Nat 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 = wx  + wfy in Dim (max v wy) h v wly
                 (_, 0) -> let v = wlx + wy in Dim (max v wx) 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         -- ^ Current indentation level, used by 'newline'.
 ,   reader_newline   :: Dimension       -- ^ How to display 'newline'.
 ,   reader_breakable :: !(Maybe Column) -- ^ 'Column' after which to break, or 'Nothing'
 ,   reader_colorable :: !Bool           -- ^ Whether colors are activated or not.
 ,   reader_decorable :: !Bool           -- ^ Whether decorations are activated or not.
 }

-- | Default 'Reader'.
defReader :: Reader
defReader = Reader
 { reader_indent    = 0
 , reader_newline   = newlineWithIndent
 , reader_breakable = Nothing
 , reader_colorable = True
 , reader_decorable = True
 }

-- * Type 'State'
type State = Column

defState :: State
defState = 0

-- * Type 'Dimension'
newtype Dimension
 =      Dimension
 {    unDimension :: Reader ->
                     State  ->
                     (State -> Dim -> Dim) -> -- normal continuation
                     (State -> Dim -> Dim) -> -- should-break continuation
                     Dim }

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
writeH len =
        Dimension $ \ro col ok ko ->
                let newCol = col + len in
                (case reader_breakable ro of
                 Just breakCol | breakCol < newCol -> ko
                 _ -> ok)
                newCol Dim
                 { dim_width       = len
                 , dim_height      = 0
                 , dim_width_last  = len
                 , dim_width_first = len
                 }

instance Textable Dimension where
        empty     = Dimension $ \_ro st ok _ko -> ok st mempty
        charH   _ = writeH 1
        stringH   = writeH . length
        textH     = writeH . length
        ltextH    = writeH . length
        newline   = Dimension $ \ro -> unDimension (reader_newline ro) ro
instance Indentable 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
        indent f = Dimension $ \ro -> unDimension (f (reader_indent ro)) ro
        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 Breakable Dimension where
        breakable f = Dimension $ \ro -> unDimension (f (reader_breakable ro)) ro
        withBreakable col p = Dimension $ \ro -> unDimension p ro{reader_breakable=col}
        ifBreak y x = Dimension $ \ro st ok ko ->
                unDimension x ro st ok $
                case reader_breakable ro of
                 Nothing -> ko
                 Just{} -> (\_sx _tx -> unDimension y ro st ok ko)
        breakpoint onNoBreak onBreak t = Dimension $ \ro st ok ko ->
                unDimension (onNoBreak <> t) ro st ok $
                case reader_breakable ro of
                 Nothing -> ko
                 Just{} -> (\_sp _tp -> unDimension (onBreak <> t) ro st ok ko)
instance Colorable Dimension where
        colorable f       = Dimension $ \ro -> unDimension (f (reader_colorable ro)) ro
        withColorable b t = Dimension $ \ro -> unDimension t ro{reader_colorable=b}
        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 Decorable Dimension where
        decorable f       = Dimension $ \ro -> unDimension (f (reader_decorable ro)) ro
        withDecorable b t = Dimension $ \ro -> unDimension t ro{reader_decorable=b}
        bold      = id
        underline = id
        italic    = id