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

   1 module Language.Symantic.Document.Plain where
   2
   3 import Control.Monad (Monad(..))
   4 import Data.Function (($), (.), id)
   5 import Data.Monoid (Monoid(..))
   6 import Data.Semigroup (Semigroup(..))
   7 import Data.String (IsString(..))
   8 import System.IO (IO)
   9 import Text.Show (Show(..))
  10 import qualified Data.List as L
  11 import qualified Data.Text as T
  12 import qualified Data.Text.IO as T
  13 import qualified Data.Text.Lazy.IO as TL
  14 import qualified Data.Text.Lazy.Builder as TLB
  15 import qualified System.IO as IO
  16
  17 import Language.Symantic.Document.Sym
  18
  19 -- * Type 'Plain'
  20 newtype Plain
  21  =      Plain TLB.Builder
  22  deriving (Show)
  23 instance IsString Plain where
  24         fromString = Plain . fromString
  25
  26 plain :: Plain -> TLB.Builder
  27 plain (Plain d) = d
  28
  29 instance Semigroup Plain where
  30         Plain x <> Plain y = Plain (x <> y)
  31 instance Monoid Plain where
  32         mempty  = empty
  33         mappend = (<>)
  34 instance Doc_Text Plain where
  35         spaces i    = Plain $ TLB.fromText $ T.replicate i " "
  36         int         = Plain . fromString . show
  37         integer     = Plain . fromString . show
  38         char        = Plain . TLB.singleton
  39         string      = Plain . fromString
  40         text        = Plain . TLB.fromText
  41         ltext       = Plain . TLB.fromLazyText
  42         charH       = char
  43         stringH     = string
  44         textH       = text
  45         ltextH      = ltext
  46 instance Doc_Color Plain where
  47         reverse     = id
  48         black       = id
  49         red         = id
  50         green       = id
  51         yellow      = id
  52         blue        = id
  53         magenta     = id
  54         cyan        = id
  55         white       = id
  56         blacker     = id
  57         redder      = id
  58         greener     = id
  59         yellower    = id
  60         bluer       = id
  61         magentaer   = id
  62         cyaner      = id
  63         whiter      = id
  64         onBlack     = id
  65         onRed       = id
  66         onGreen     = id
  67         onYellow    = id
  68         onBlue      = id
  69         onMagenta   = id
  70         onCyan      = id
  71         onWhite     = id
  72         onBlacker   = id
  73         onRedder    = id
  74         onGreener   = id
  75         onYellower  = id
  76         onBluer     = id
  77         onMagentaer = id
  78         onCyaner    = id
  79         onWhiter    = id
  80 instance Doc_Decoration Plain where
  81         bold        = id
  82         underline   = id
  83         italic      = id
  84
  85 -- * Type 'PlainIO'
  86 newtype PlainIO
  87  =      PlainIO { unPlainH :: IO.Handle -> IO () }
  88 instance IsString PlainIO where
  89         fromString s = PlainIO $ \h -> IO.hPutStr h t
  90                 where t = fromString s
  91
  92 plainIO :: PlainIO -> IO.Handle -> IO ()
  93 plainIO (PlainIO d) = d
  94
  95 instance Semigroup PlainIO where
  96         PlainIO x <> PlainIO y = PlainIO $ \h -> do {x h; y h}
  97 instance Monoid PlainIO where
  98         mempty  = empty
  99         mappend = (<>)
 100 instance Doc_Text PlainIO where
 101         empty       = PlainIO $ \_ -> return ()
 102         spaces  i   = PlainIO $ \h -> IO.hPutStr  h (L.replicate i ' ')
 103         int     i   = PlainIO $ \h -> IO.hPutStr  h (show i)
 104         integer i   = PlainIO $ \h -> IO.hPutStr  h (show i)
 105         char    x   = PlainIO $ \h -> IO.hPutChar h x
 106         string  x   = PlainIO $ \h -> IO.hPutStr  h x
 107         text    x   = PlainIO $ \h -> T.hPutStr   h x
 108         ltext   x   = PlainIO $ \h -> TL.hPutStr  h x
 109         charH       = char
 110         stringH     = string
 111         textH       = text
 112         ltextH      = ltext
 113 instance Doc_Color PlainIO where
 114         reverse     = id
 115         black       = id
 116         red         = id
 117         green       = id
 118         yellow      = id
 119         blue        = id
 120         magenta     = id
 121         cyan        = id
 122         white       = id
 123         blacker     = id
 124         redder      = id
 125         greener     = id
 126         yellower    = id
 127         bluer       = id
 128         magentaer   = id
 129         cyaner      = id
 130         whiter      = id
 131         onBlack     = id
 132         onRed       = id
 133         onGreen     = id
 134         onYellow    = id
 135         onBlue      = id
 136         onMagenta   = id
 137         onCyan      = id
 138         onWhite     = id
 139         onBlacker   = id
 140         onRedder    = id
 141         onGreener   = id
 142         onYellower  = id
 143         onBluer     = id
 144         onMagentaer = id
 145         onCyaner    = id
 146         onWhiter    = id
 147 instance Doc_Decoration PlainIO where
 148         bold        = id
 149         underline   = id
 150         italic      = id