symantic-document/Language/Symantic/Document/Term/Dim.hs

   1 module Language.Symantic.Document.Term.Dim
   2  ( module Language.Symantic.Document.Sym
   3  , module Language.Symantic.Document.Term.Dim
   4  ) where
   5
   6 import Control.Applicative (Applicative(..))
   7 import Data.Bool
   8 import Data.Eq (Eq(..))
   9 import Data.Function (($), (.), id)
  10 import Data.Monoid (Monoid(..))
  11 import Data.Ord (Ord(..))
  12 import Data.Semigroup (Semigroup(..))
  13 import Data.String (IsString(..))
  14 import GHC.Exts (IsList(..))
  15 import Prelude ((+), pred)
  16 import Text.Show (Show(..))
  17
  18 import Language.Symantic.Document.Sym
  19
  20 -- * Type 'Dim'
  21 data Dim
  22  =   Dim
  23  {   dim_width       :: Nat -- ^ Maximun line length.
  24  ,   dim_height      :: Nat -- ^ Number of newlines.
  25  ,   dim_width_first :: Nat -- ^ Nat of the first line.
  26  ,   dim_width_last  :: Nat -- ^ Nat of the last line.
  27  } deriving (Eq, Show)
  28 instance Semigroup Dim where
  29         Dim{dim_width=wx, dim_height=hx, dim_width_first=wfx, dim_width_last=wlx} <>
  30          Dim{dim_width=wy, dim_height=hy, dim_width_first=wfy, dim_width_last=wly} =
  31                 let h = hx + hy in
  32                 case (hx, hy) of
  33                  (0, 0) -> let w = wx  + wy  in Dim w h w w
  34                  (0, _) -> let v = wfx + wfy in Dim (max v (wx + wy)) h v wly
  35                  (_, 0) -> let v = wlx + wfy in Dim (max v (wx + wy)) h wfx v
  36                  _      -> Dim (max wx wy) h wfx wly
  37 instance Monoid Dim where
  38         mempty  = Dim 0 0 0 0
  39         mappend = (<>)
  40
  41 -- * Type 'Reader'
  42 data Reader
  43  =   Reader
  44  {   reader_indent      :: !Indent   -- ^ Current indentation level, used by 'newline'.
  45  ,   reader_newline     :: Dimension -- ^ How to display 'newline'.
  46  ,   reader_wrap_column :: !Column   -- ^ 'Column' after which 'wrap' breaks on a 'breakpoint' or 'breakspace'.
  47  ,   reader_colorable   :: !Bool     -- ^ Whether colors are activated or not.
  48  ,   reader_decorable   :: !Bool     -- ^ Whether decorations are activated or not.
  49  }
  50
  51 -- | Default 'Reader'.
  52 defReader :: Reader
  53 defReader = Reader
  54  { reader_indent      = 0
  55  , reader_newline     = newlineWithIndent
  56  , reader_wrap_column = Nat 80
  57  , reader_colorable   = True
  58  , reader_decorable   = True
  59  }
  60
  61 -- * Type 'State'
  62 type State = Column
  63
  64 defState :: State
  65 defState = 0
  66
  67 -- * Type 'Dimension'
  68 newtype Dimension
  69  =      Dimension
  70  {    unDimension :: Reader ->
  71                      State  ->
  72                      (State -> Dim -> Dim) -> -- normal continuation
  73                      (State -> Dim -> Dim) -> -- should-wrap continuation
  74                      Dim }
  75
  76 dim :: Dimension -> Dim
  77 dim (Dimension p) = p defReader defState oko oko
  78         where oko _st = id
  79
  80 instance IsList Dimension where
  81         type Item Dimension = Dimension
  82         fromList = mconcat
  83         toList   = pure
  84 instance Semigroup Dimension where
  85         x <> y = Dimension $ \ro st ok ko ->
  86                 unDimension x ro st
  87                  (\sx tx -> unDimension y ro sx
  88                          (\sy ty -> ok sy (tx<>ty))
  89                          (\sy ty -> ko sy (tx<>ty)))
  90                  (\sx tx -> unDimension y ro sx
  91                          (\sy ty -> ko sy (tx<>ty))
  92                          (\sy ty -> ko sy (tx<>ty)))
  93 instance Monoid Dimension where
  94         mempty  = empty
  95         mappend = (<>)
  96 instance IsString Dimension where
  97         fromString = string
  98
  99 writeH :: Column -> Dimension
 100 writeH len =
 101         Dimension $ \ro col ok ko ->
 102                 let newCol = col + len in
 103                 (if newCol <= reader_wrap_column ro then ok else ko)
 104                 newCol Dim
 105                  { dim_width       = newCol
 106                  , dim_height      = 0
 107                  , dim_width_last  = newCol
 108                  , dim_width_first = newCol
 109                  }
 110
 111 instance Textable Dimension where
 112         empty     = Dimension $ \_ro st ok _ko -> ok st mempty
 113         charH   _ = writeH 1
 114         stringH   = writeH . length
 115         textH     = writeH . length
 116         ltextH    = writeH . length
 117         int       = stringH . show
 118         integer   = stringH . show
 119         replicate cnt p | cnt <= 0  = empty
 120                         | otherwise = p <> replicate (pred cnt) p
 121         newline = Dimension $ \ro -> unDimension (reader_newline ro) ro
 122 instance Alignable Dimension where
 123         align p = Dimension $ \ro st -> unDimension p ro{reader_indent=st} st
 124         withNewline nl  p = Dimension $ \ro -> unDimension p ro{reader_newline=nl}
 125         withIndent  ind p = Dimension $ \ro -> unDimension p ro{reader_indent=ind}
 126         incrIndent  ind p = Dimension $ \ro -> unDimension p ro{reader_indent=reader_indent ro + ind}
 127         column f = Dimension $ \ro st -> unDimension (f st) ro st
 128         newlineWithoutIndent = Dimension $ \_ro _st ok _ko ->
 129                 ok 0 Dim
 130                  { dim_width       = 0
 131                  , dim_height      = 1
 132                  , dim_width_first = 0
 133                  , dim_width_last  = 0
 134                  }
 135         newlineWithIndent = Dimension $ \ro _st ok _ko ->
 136                 let ind = reader_indent ro in
 137                 ok ind Dim
 138                  { dim_width       = ind
 139                  , dim_height      = 1
 140                  , dim_width_first = 0
 141                  , dim_width_last  = ind
 142                  }
 143
 144 instance Wrapable Dimension where
 145         ifWrap y x = Dimension $ \ro st ok ko ->
 146                 unDimension x ro st ok (\_sx _tx -> unDimension y ro st ok ko)
 147         breakpoint onNoBreak onBreak p = Dimension $ \ro st ok ko ->
 148                 unDimension (onNoBreak <> p) ro st ok
 149                  (\_sp _tp -> unDimension (onBreak <> p) ro st ok ko)
 150         withWrapColumn col p = Dimension $ \ro -> unDimension p ro{reader_wrap_column=col}
 151 instance Colorable Dimension where
 152         colorable f       = Dimension $ \ro -> unDimension (f (reader_colorable ro)) ro
 153         withColorable b t = Dimension $ \ro -> unDimension t ro{reader_colorable=b}
 154         reverse     = id
 155         black       = id
 156         red         = id
 157         green       = id
 158         yellow      = id
 159         blue        = id
 160         magenta     = id
 161         cyan        = id
 162         white       = id
 163         blacker     = id
 164         redder      = id
 165         greener     = id
 166         yellower    = id
 167         bluer       = id
 168         magentaer   = id
 169         cyaner      = id
 170         whiter      = id
 171         onBlack     = id
 172         onRed       = id
 173         onGreen     = id
 174         onYellow    = id
 175         onBlue      = id
 176         onMagenta   = id
 177         onCyan      = id
 178         onWhite     = id
 179         onBlacker   = id
 180         onRedder    = id
 181         onGreener   = id
 182         onYellower  = id
 183         onBluer     = id
 184         onMagentaer = id
 185         onCyaner    = id
 186         onWhiter    = id
 187 instance Decorable Dimension where
 188         decorable f       = Dimension $ \ro -> unDimension (f (reader_decorable ro)) ro
 189         withDecorable b t = Dimension $ \ro -> unDimension t ro{reader_decorable=b}
 190         bold      = id
 191         underline = id
 192         italic    = id