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 instance Semigroup Plain where
  29         Plain x <> Plain y = Plain (x <> y)
  30 instance Monoid Plain where
  31         mempty  = empty
  32         mappend = (<>)
  33 instance Doc_Text Plain where
  34         int         = Plain . fromString . show
  35         integer     = Plain . fromString . show
  36         replicate i = Plain . TLB.fromLazyText . TL.replicate (int64OfInt i) . TLB.toLazyText . plain
  37         char        = Plain . TLB.singleton
  38         string      = Plain . fromString
  39         text        = Plain . TLB.fromText
  40         ltext       = Plain . TLB.fromLazyText
  41         charH       = char
  42         stringH     = string
  43         textH       = text
  44         ltextH      = ltext
  45 instance Doc_Color Plain where
  46         reverse     = id
  47         black       = id
  48         red         = id
  49         green       = id
  50         yellow      = id
  51         blue        = id
  52         magenta     = id
  53         cyan        = id
  54         white       = id
  55         blacker     = id
  56         redder      = id
  57         greener     = id
  58         yellower    = id
  59         bluer       = id
  60         magentaer   = id
  61         cyaner      = id
  62         whiter      = id
  63         onBlack     = id
  64         onRed       = id
  65         onGreen     = id
  66         onYellow    = id
  67         onBlue      = id
  68         onMagenta   = id
  69         onCyan      = id
  70         onWhite     = id
  71         onBlacker   = id
  72         onRedder    = id
  73         onGreener   = id
  74         onYellower  = id
  75         onBluer     = id
  76         onMagentaer = id
  77         onCyaner    = id
  78         onWhiter    = id
  79 instance Doc_Decoration Plain where
  80         bold        = id
  81         underline   = id
  82         italic      = id
  83
  84 -- * Type 'PlainIO'
  85 newtype PlainIO
  86  =      PlainIO { unPlainH :: IO.Handle -> IO () }
  87 instance IsString PlainIO where
  88         fromString s = PlainIO $ \h -> IO.hPutStr h t
  89                 where t = fromString s
  90
  91 plainIO :: PlainIO -> IO.Handle -> IO ()
  92 plainIO (PlainIO d) = d
  93
  94 instance Semigroup PlainIO where
  95         PlainIO x <> PlainIO y = PlainIO $ \h -> do {x h; y h}
  96 instance Monoid PlainIO where
  97         mempty  = empty
  98         mappend = (<>)
  99 instance Doc_Text PlainIO where
 100         empty         = PlainIO $ \_ -> return ()
 101         int     i     = PlainIO $ \h -> IO.hPutStr  h (show i)
 102         integer i     = PlainIO $ \h -> IO.hPutStr  h (show i)
 103         replicate i d = PlainIO $ replicateM_ i . plainIO d
 104         char    x     = PlainIO $ \h -> IO.hPutChar h x
 105         string  x     = PlainIO $ \h -> IO.hPutStr  h x
 106         text    x     = PlainIO $ \h -> T.hPutStr   h x
 107         ltext   x     = PlainIO $ \h -> TL.hPutStr  h x
 108         charH         = char
 109         stringH       = string
 110         textH         = text
 111         ltextH        = ltext
 112 instance Doc_Color PlainIO where
 113         reverse       = id
 114         black         = id
 115         red           = id
 116         green         = id
 117         yellow        = id
 118         blue          = id
 119         magenta       = id
 120         cyan          = id
 121         white         = id
 122         blacker       = id
 123         redder        = id
 124         greener       = id
 125         yellower      = id
 126         bluer         = id
 127         magentaer     = id
 128         cyaner        = id
 129         whiter        = id
 130         onBlack       = id
 131         onRed         = id
 132         onGreen       = id
 133         onYellow      = id
 134         onBlue        = id
 135         onMagenta     = id
 136         onCyan        = id
 137         onWhite       = id
 138         onBlacker     = id
 139         onRedder      = id
 140         onGreener     = id
 141         onYellower    = id
 142         onBluer       = id
 143         onMagentaer   = id
 144         onCyaner      = id
 145         onWhiter      = id
 146 instance Doc_Decoration PlainIO where
 147         bold          = id
 148         underline     = id
 149         italic        = id