module Language.Symantic.Document.Plain where

import Control.Monad (Monad(..))
import Data.Function (($), (.), id)
import Data.Monoid (Monoid(..))
import Data.Semigroup (Semigroup(..))
import Data.String (IsString(..))
import System.IO (IO)
import Text.Show (Show(..))
import qualified Data.List as L
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.Lazy.IO as TL
import qualified Data.Text.Lazy.Builder as TLB
import qualified System.IO as IO

import Language.Symantic.Document.Sym

-- * Type 'Plain'
newtype Plain
 =      Plain TLB.Builder
 deriving (Show)
instance IsString Plain where
	fromString = Plain . fromString

plain :: Plain -> TLB.Builder
plain (Plain d) = d

instance Semigroup Plain where
	Plain x <> Plain y = Plain (x <> y)
instance Monoid Plain where
	mempty  = empty
	mappend = (<>)
instance Doc_Text Plain where
	spaces i    = Plain $ TLB.fromText $ T.replicate i " "
	int         = Plain . fromString . show
	integer     = Plain . fromString . show
	char        = Plain . TLB.singleton
	string      = Plain . fromString
	text        = Plain . TLB.fromText
	ltext       = Plain . TLB.fromLazyText
	charH       = char
	stringH     = string
	textH       = text
	ltextH      = ltext
instance Doc_Color Plain where
	reverse     = id
	black       = id
	red         = id
	green       = id
	yellow      = id
	blue        = id
	magenta     = id
	cyan        = id
	white       = id
	blacker     = id
	redder      = id
	greener     = id
	yellower    = id
	bluer       = id
	magentaer   = id
	cyaner      = id
	whiter      = id
	onBlack     = id
	onRed       = id
	onGreen     = id
	onYellow    = id
	onBlue      = id
	onMagenta   = id
	onCyan      = id
	onWhite     = id
	onBlacker   = id
	onRedder    = id
	onGreener   = id
	onYellower  = id
	onBluer     = id
	onMagentaer = id
	onCyaner    = id
	onWhiter    = id
instance Doc_Decoration Plain where
	bold        = id
	underline   = id
	italic      = id

-- * Type 'PlainIO'
newtype PlainIO
 =      PlainIO { unPlainH :: IO.Handle -> IO () }
instance IsString PlainIO where
	fromString s = PlainIO $ \h -> IO.hPutStr h t
		where t = fromString s

plainIO :: PlainIO -> IO.Handle -> IO ()
plainIO (PlainIO d) = d

instance Semigroup PlainIO where
	PlainIO x <> PlainIO y = PlainIO $ \h -> do {x h; y h}
instance Monoid PlainIO where
	mempty  = empty
	mappend = (<>)
instance Doc_Text PlainIO where
	empty       = PlainIO $ \_ -> return ()
	spaces  i   = PlainIO $ \h -> IO.hPutStr  h (L.replicate i ' ')
	int     i   = PlainIO $ \h -> IO.hPutStr  h (show i)
	integer i   = PlainIO $ \h -> IO.hPutStr  h (show i)
	char    x   = PlainIO $ \h -> IO.hPutChar h x
	string  x   = PlainIO $ \h -> IO.hPutStr  h x
	text    x   = PlainIO $ \h -> T.hPutStr   h x
	ltext   x   = PlainIO $ \h -> TL.hPutStr  h x
	charH       = char
	stringH     = string
	textH       = text
	ltextH      = ltext
instance Doc_Color PlainIO where
	reverse     = id
	black       = id
	red         = id
	green       = id
	yellow      = id
	blue        = id
	magenta     = id
	cyan        = id
	white       = id
	blacker     = id
	redder      = id
	greener     = id
	yellower    = id
	bluer       = id
	magentaer   = id
	cyaner      = id
	whiter      = id
	onBlack     = id
	onRed       = id
	onGreen     = id
	onYellow    = id
	onBlue      = id
	onMagenta   = id
	onCyan      = id
	onWhite     = id
	onBlacker   = id
	onRedder    = id
	onGreener   = id
	onYellower  = id
	onBluer     = id
	onMagentaer = id
	onCyaner    = id
	onWhiter    = id
instance Doc_Decoration PlainIO where
	bold        = id
	underline   = id
	italic      = id