module Language.Symantic.Document.Plain where

import Control.Monad (Monad(..), replicateM_)
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.Text.IO as T
import qualified Data.Text.Lazy as TL
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
	int         = Plain . fromString . show
	integer     = Plain . fromString . show
	replicate i = Plain . TLB.fromLazyText . TL.replicate (int64OfInt i) . TLB.toLazyText . plain
	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 ()
	int     i     = PlainIO $ \h -> IO.hPutStr  h (show i)
	integer i     = PlainIO $ \h -> IO.hPutStr  h (show i)
	replicate i d = PlainIO $ replicateM_ i . plainIO d
	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