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

   1 module Language.Symantic.Document.Dim where
   2
   3 {-
   4 import Control.Applicative (Applicative(..))
   5 import Control.Monad (Monad(..))
   6 import Data.Bool
   7 import Data.Eq (Eq(..))
   8 import Data.Foldable (Foldable(..))
   9 import Data.Function (($), id)
  10 import Data.Functor ((<$>), ($>))
  11 import Data.Int (Int)
  12 import Data.Monoid (Monoid(..))
  13 import Data.Ord (Ord(..))
  14 import Data.Semigroup (Semigroup(..))
  15 import Data.String (IsString(..))
  16 import Prelude (max, Num(..), toInteger)
  17 import Text.Show (Show(..))
  18 import qualified Data.List as L
  19 import qualified Data.Text as T
  20 import qualified Data.Text.Lazy as TL
  21 import qualified Control.Monad.Trans.State as S
  22
  23 import Language.Symantic.Document.Sym
  24
  25 -- * Type 'Dim'
  26 data Dim
  27  =   Dim
  28  {   dim_width       :: Int -- ^ Maximun line length.
  29  ,   dim_height      :: Int -- ^ Number of newlines.
  30  ,   dim_width_first :: Int -- ^ Length of the first line.
  31  ,   dim_width_last  :: Int -- ^ Length of the last line.
  32  } deriving (Eq, Show)
  33 instance Semigroup Dim where
  34         Dim{dim_width=wx, dim_height=hx, dim_width_first=wfx, dim_width_last=wlx} <>
  35          Dim{dim_width=wy, dim_height=hy, dim_width_first=wfy, dim_width_last=wly} =
  36                 let h = hx + hy in
  37                 case (hx, hy) of
  38                  (0, 0) -> let w = wx  + wy  in Dim w h w w
  39                  (0, _) -> let v = wfx + wfy in Dim (max v (wx + wy)) h v wly
  40                  (_, 0) -> let v = wlx + wfy in Dim (max v (wx + wy)) h wfx v
  41                  _      -> Dim (max wx wy) h wfx wly
  42 instance Monoid Dim where
  43         mempty  = Dim 0 0 0 0
  44         mappend = (<>)
  45
  46 -- * Type 'Dimension'
  47 newtype Dimension = Dimension { unDimension :: Inh -> S.State Column Dim }
  48
  49 instance IsString Dimension where
  50         fromString [] = mempty
  51         fromString s =
  52                 Dimension $ \inh ->
  53                         let ls = L.lines s in
  54                         return $
  55                         case inh_newline inh of
  56                          NewlineEmpty ->
  57                                 let w = sum $ length <$> ls in
  58                                 Dim
  59                                  { dim_width       = w
  60                                  , dim_height      = 0
  61                                  , dim_width_first = w
  62                                  , dim_width_last  = w
  63                                  }
  64                          NewlineWithIndent ->
  65                                 let ws = case length <$> ls of [] -> []; c:cs -> c : ((inh_indent inh +)<$>cs) in
  66                                 Dim
  67                                  { dim_width       = maximum ws
  68                                  , dim_height      = length ls
  69                                  , dim_width_first = if null ws then 0 else L.head ws
  70                                  , dim_width_last  = if null ws then 0 else L.last ws
  71                                  }
  72                          NewlineWithoutIndent ->
  73                                 let ws = length <$> ls in
  74                                 Dim
  75                                  { dim_width       = maximum ws
  76                                  , dim_height      = length ls
  77                                  , dim_width_first = if null ws then 0 else L.head ws
  78                                  , dim_width_last  = if null ws then 0 else L.last ws
  79                                  }
  80
  81 dimension :: Dimension -> Dimension
  82 dimension = id
  83
  84
  85 instance Semigroup Dimension where
  86         -- Dimension x <> Dimension y = Dimension (x <> y)
  87         Dimension x <> Dimension y = Dimension (\inh -> (<>) <$> x inh <*> y inh)
  88 instance Monoid Dimension where
  89         mempty  = empty
  90         mappend = (<>)
  91 instance Doc_Text Dimension where
  92         spaces    i   = Dimension $ \_inh -> return $ Dim i 0 i i
  93         replicate i d = if i <= 0 then empty else d <> replicate (i - 1) d
  94         int       i   = stringH $ show i
  95         integer   i   = stringH $ show i
  96         empty         = Dimension $ \_inh -> return mempty
  97         newline       = Dimension $ \_inh -> return $ Dim 0 1 0 0
  98         charH     _c  = incrColumn $ 1
  99         stringH   t   = incrColumn $ length t
 100         textH     t   = incrColumn $ T.length t
 101         ltextH    t   = incrColumn $ fromInteger $ toInteger $ TL.length t
 102                                             -- XXX: conversion may overflow
 103 instance Doc_Color Dimension where
 104         reverse     = id
 105         black       = id
 106         red         = id
 107         green       = id
 108         yellow      = id
 109         blue        = id
 110         magenta     = id
 111         cyan        = id
 112         white       = id
 113         blacker     = id
 114         redder      = id
 115         greener     = id
 116         yellower    = id
 117         bluer       = id
 118         magentaer   = id
 119         cyaner      = id
 120         whiter      = id
 121         onBlack     = id
 122         onRed       = id
 123         onGreen     = id
 124         onYellow    = id
 125         onBlue      = id
 126         onMagenta   = id
 127         onCyan      = id
 128         onWhite     = id
 129         onBlacker   = id
 130         onRedder    = id
 131         onGreener   = id
 132         onYellower  = id
 133         onBluer     = id
 134         onMagentaer = id
 135         onCyaner    = id
 136         onWhiter    = id
 137 instance Doc_Decoration Dimension where
 138         bold        = id
 139         underline   = id
 140         italic      = id
 141 instance Doc_Align Dimension where
 142 instance Doc_Wrap Dimension where
 143 -}