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