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