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

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