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

   1 module Language.Symantic.Document.Dim where
   2
   3 import Data.Eq (Eq)
   4 import Data.Foldable (Foldable(..))
   5 import Data.Function (($), id)
   6 import Data.Functor ((<$>))
   7 import Data.Int (Int)
   8 import Data.Monoid (Monoid(..))
   9 import Data.Ord (Ord(..))
  10 import Data.Semigroup (Semigroup(..))
  11 import Data.String (IsString(..))
  12 import Prelude (max, Num(..), toInteger)
  13 import Text.Show (Show(..))
  14 import qualified Data.List as L
  15 import qualified Data.Text as T
  16 import qualified Data.Text.Lazy as TL
  17
  18 import Language.Symantic.Document.Sym
  19
  20 -- * Type 'Dim'
  21 data Dim
  22  =   Dim
  23  { width       :: Int -- ^ Maximun line length.
  24  , height      :: Int -- ^ Number of newlines.
  25  , width_first :: Int -- ^ Length of the first line.
  26  , width_last  :: Int -- ^ Length of the last line.
  27  } deriving (Eq, Show)
  28 instance IsString Dim where
  29         fromString [] = Dim 0 0 0 0
  30         fromString s =
  31                 Dim
  32                  { width       = maximum ws
  33                  , height      = length ls
  34                  , width_first = if null ws then 0 else L.head ws
  35                  , width_last  = if null ws then 0 else L.last ws
  36                  }
  37                 where
  38                 ls = L.lines s
  39                 ws = length <$> ls
  40
  41 dim :: Dim -> Dim
  42 dim = id
  43
  44 instance Semigroup Dim where
  45         Dim wx hx wfx wlx <> Dim wy hy wfy wly =
  46                 let h = hx + hy in
  47                 case (hx, hy) of
  48                  (0, 0) -> let w = wx  + wy  in Dim w h w w
  49                  (0, _) -> let v = wfx + wfy in Dim (max v (wx + wy)) h v wly
  50                  (_, 0) -> let v = wlx + wfy in Dim (max v (wx + wy)) h wfx v
  51                  _      -> Dim (max wx wy) h wfx wly
  52 instance Monoid Dim where
  53         mempty  = empty
  54         mappend = (<>)
  55 instance Doc_Text Dim where
  56         spaces    i   = Dim i 0 i i
  57         replicate i d = if i <= 0 then empty else d <> replicate (i - 1) d
  58         int       i   = fromString $ show i
  59         integer   i   = fromString $ show i
  60         charH     _c  = Dim 1 0 1 1
  61         stringH   t   = Dim l 0 l l where l = length t
  62         textH     t   = Dim l 0 l l where l = T.length t
  63         ltextH    t   = Dim l 0 l l where l = fromInteger $ toInteger $ TL.length t
  64                                             -- XXX: conversion may overflow
  65 instance Doc_Color Dim where
  66         reverse     = id
  67         black       = id
  68         red         = id
  69         green       = id
  70         yellow      = id
  71         blue        = id
  72         magenta     = id
  73         cyan        = id
  74         white       = id
  75         blacker     = id
  76         redder      = id
  77         greener     = id
  78         yellower    = id
  79         bluer       = id
  80         magentaer   = id
  81         cyaner      = id
  82         whiter      = id
  83         onBlack     = id
  84         onRed       = id
  85         onGreen     = id
  86         onYellow    = id
  87         onBlue      = id
  88         onMagenta   = id
  89         onCyan      = id
  90         onWhite     = id
  91         onBlacker   = id
  92         onRedder    = id
  93         onGreener   = id
  94         onYellower  = id
  95         onBluer     = id
  96         onMagentaer = id
  97         onCyaner    = id
  98         onWhiter    = id
  99 instance Doc_Decoration Dim where
 100         bold        = id
 101         underline   = id
 102         italic      = id