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

   1 module Language.Symantic.Document.Plain where
   2
   3 import Control.Monad (Monad(..), replicateM_)
   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.Text.IO as T
  11 import qualified Data.Text.Lazy as TL
  12 import qualified Data.Text.Lazy.IO as TL
  13 import qualified Data.Text.Lazy.Builder as TLB
  14 import qualified System.IO as IO
  15
  16 import Language.Symantic.Document.Sym
  17
  18 -- * Type 'Plain'
  19 newtype Plain
  20  =      Plain TLB.Builder
  21  deriving (Show)
  22 instance IsString Plain where
  23         fromString = Plain . fromString
  24
  25 plain :: Plain -> TLB.Builder
  26 plain (Plain d) = d
  27
  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         int         = Plain . fromString . show
  36         integer     = Plain . fromString . show
  37         replicate i = Plain . TLB.fromLazyText . TL.replicate (int64OfInt i) . TLB.toLazyText . plain
  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         int     i     = PlainIO $ \h -> IO.hPutStr  h (show i)
 103         integer i     = PlainIO $ \h -> IO.hPutStr  h (show i)
 104         replicate i d = PlainIO $ replicateM_ i . plainIO d
 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