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

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