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.Int (Int)
  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 import qualified Data.List as List
  19 import qualified Data.Text as Text
  20 import qualified Data.Text.Lazy as TL
  21
  22 import Language.Symantic.Document.Sym
  23
  24 -- * Type 'Dim'
  25 data Dim
  26  =   Dim
  27  {   dim_width       :: Int -- ^ Maximun line length.
  28  ,   dim_height      :: Int -- ^ Number of newlines.
  29  ,   dim_width_first :: Int -- ^ Length of the first line.
  30  ,   dim_width_last  :: Int -- ^ Length of the last line.
  31  } deriving (Eq, Show)
  32 instance Semigroup Dim where
  33         Dim{dim_width=wx, dim_height=hx, dim_width_first=wfx, dim_width_last=wlx} <>
  34          Dim{dim_width=wy, dim_height=hy, dim_width_first=wfy, dim_width_last=wly} =
  35                 let h = hx + hy in
  36                 case (hx, hy) of
  37                  (0, 0) -> let w = wx  + wy  in Dim w h w w
  38                  (0, _) -> let v = wfx + wfy in Dim (max v (wx + wy)) h v wly
  39                  (_, 0) -> let v = wlx + wfy in Dim (max v (wx + wy)) h wfx v
  40                  _      -> Dim (max wx wy) h wfx wly
  41 instance Monoid Dim where
  42         mempty  = Dim 0 0 0 0
  43         mappend = (<>)
  44
  45 -- * Type 'Reader'
  46 data Reader
  47  =   Reader
  48  {   reader_indent      :: !(Indent Dimension) -- ^ Current indentation level, used by 'newline'.
  49  ,   reader_newline     :: Dimension           -- ^ How to display 'newline'.
  50  ,   reader_wrap_column :: !(Column Dimension) -- ^ 'Column' after which 'wrap' breaks on a 'breakpoint' or 'breakspace'.
  51  }
  52
  53 -- | Default 'Reader'.
  54 defReader :: Reader
  55 defReader = Reader
  56  { reader_indent      = 0
  57  , reader_newline     = newlineWithIndent
  58  , reader_wrap_column = 80
  59  }
  60
  61 -- * Type 'State'
  62 type State = Column Dimension
  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 type instance Column Dimension = Int
  76 type instance Indent Dimension = Int
  77
  78 dim :: Dimension -> Dim
  79 dim (Dimension p) = p defReader defState oko oko
  80         where oko _st = id
  81
  82 instance IsList Dimension where
  83         type Item Dimension = Dimension
  84         fromList = mconcat
  85         toList   = pure
  86 instance Semigroup Dimension where
  87         x <> y = Dimension $ \ro st ok ko ->
  88                 unDimension x ro st
  89                  (\sx tx -> unDimension y ro sx
  90                          (\sy ty -> ok sy (tx<>ty))
  91                          (\sy ty -> ko sy (tx<>ty)))
  92                  (\sx tx -> unDimension y ro sx
  93                          (\sy ty -> ko sy (tx<>ty))
  94                          (\sy ty -> ko sy (tx<>ty)))
  95 instance Monoid Dimension where
  96         mempty  = empty
  97         mappend = (<>)
  98 instance IsString Dimension where
  99         fromString = string
 100
 101 writeH :: Column Dimension -> Dimension
 102 writeH len =
 103         Dimension $ \ro col ok ko ->
 104                 let newCol = col + len in
 105                 (if newCol <= reader_wrap_column ro then ok else ko)
 106                 newCol Dim
 107                  { dim_width       = newCol
 108                  , dim_height      = 0
 109                  , dim_width_last  = newCol
 110                  , dim_width_first = newCol
 111                  }
 112
 113 instance Doc_Text Dimension where
 114         empty     = Dimension $ \_ro st ok _ko -> ok st mempty
 115         charH   _ = writeH 1
 116         stringH t = writeH $ List.length t
 117         textH   t = writeH $ Text.length t
 118         ltextH  t = writeH $ intOfInt64 $ TL.length t
 119         int       = stringH . show
 120         integer   = stringH . show
 121         replicate cnt p | cnt <= 0  = empty
 122                         | otherwise = p <> replicate (pred cnt) p
 123         newline = Dimension $ \ro -> unDimension (reader_newline ro) ro
 124 instance Doc_Align Dimension where
 125         align p = Dimension $ \ro st -> unDimension p ro{reader_indent=st} st
 126         withNewline nl  p = Dimension $ \ro -> unDimension p ro{reader_newline=nl}
 127         withIndent  ind p = Dimension $ \ro -> unDimension p ro{reader_indent=ind}
 128         incrIndent  ind p = Dimension $ \ro -> unDimension p ro{reader_indent=reader_indent ro + ind}
 129         column f = Dimension $ \ro st -> unDimension (f st) ro st
 130         newlineWithoutIndent = Dimension $ \_ro _st ok _ko ->
 131                 ok 0 Dim
 132                  { dim_width       = 0
 133                  , dim_height      = 1
 134                  , dim_width_first = 0
 135                  , dim_width_last  = 0
 136                  }
 137         newlineWithIndent = Dimension $ \ro _st ok _ko ->
 138                 let ind = reader_indent ro in
 139                 ok ind Dim
 140                  { dim_width       = ind
 141                  , dim_height      = 1
 142                  , dim_width_first = 0
 143                  , dim_width_last  = ind
 144                  }
 145
 146 instance Doc_Wrap Dimension where
 147         ifFit x y = Dimension $ \ro st ok ko ->
 148                 unDimension x ro st ok (\_sx _tx -> unDimension y ro st ok ko)
 149         breakpoint onNoBreak onBreak p = Dimension $ \ro st ok ko ->
 150                 unDimension (onNoBreak <> p) ro st ok
 151                  (\_sp _tp -> unDimension (onBreak <> p) ro st ok ko)
 152         withWrapColumn col p = Dimension $ \ro -> unDimension p ro{reader_wrap_column=col}
 153 instance Doc_Color Dimension where
 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 Doc_Decoration Dimension where
 188         bold      = id
 189         underline = id
 190         italic    = id