module Text.HPaco.Writers.Internal.CodeWriter
( CodeWriter
, CodeWriterOptions (..)
, CodeWriterState (..)
, runCodeWriterT
, runCodeWriter
, write
, writeIndent
, writeIndented
, writeLn
, endl
, pushIndent
, popIndent
, pushFilter
, popFilter
, withIndent
, withFilter
, withParens
, withBrackets
, withBraces
, withParensLn
, withBracketsLn
, withBracesLn
)
where
import Control.Monad.Identity
import Control.Monad.RWS
import Control.Monad.IO.Class
import Data.Monoid
import Safe
import Data.List
type CodeWriterT o s m a = RWST o String s m a
type CodeWriter o s a = RWS o String s a
class CodeWriterOptions o where
cwoIndent :: o -> String
cwoNewline :: o -> String
type Filter = String -> String
class CodeWriterState s where
cwsGetIndent :: s -> Int
cwsSetIndent :: Int -> s -> s
cwsGetFilters :: s -> [ Filter ]
cwsSetFilters :: [ Filter ] -> s -> s
cwsModifyIndent :: CodeWriterState s => Int -> s -> s
cwsModifyIndent d s = cwsSetIndent (cwsGetIndent s + d) s
cwsIncreaseIndent :: CodeWriterState s => s -> s
cwsIncreaseIndent = cwsModifyIndent 1
cwsDecreaseIndent :: CodeWriterState s => s -> s
cwsDecreaseIndent = cwsModifyIndent (1)
cwsPushFilter x s =
let xs = cwsGetFilters s
in cwsSetFilters (x:xs) s
cwsPopFilter s =
let x:xs = cwsGetFilters s
in cwsSetFilters xs s
runCodeWriterT :: (Monad m, CodeWriterOptions o, CodeWriterState s) => CodeWriterT o s m () -> o -> s -> m String
runCodeWriterT a opts s = do
(s, w) <- execRWST a opts s
return w
runCodeWriter :: (CodeWriterOptions o, CodeWriterState s) => CodeWriter o s () -> o -> s -> String
runCodeWriter a o s =
let (_, w) = execRWS a o s
in w
write :: (Monad m, CodeWriterOptions o, CodeWriterState s) => String -> CodeWriterT o s m ()
write str = do
filter <- foldl (.) id `liftM` gets cwsGetFilters
tell $ filter str
writeLn :: (Monad m, CodeWriterOptions o, CodeWriterState s) => String -> CodeWriterT o s m ()
writeLn = between writeIndent endl . write
writeIndented :: (Monad m, CodeWriterOptions o, CodeWriterState s) => String -> CodeWriterT o s m ()
writeIndented str = writeIndent >> write str
writeIndent :: (Monad m, CodeWriterOptions o, CodeWriterState s) => CodeWriterT o s m ()
writeIndent = do
indentLevel <- gets cwsGetIndent
indentStr <- asks cwoIndent
write $ concat $ replicate indentLevel indentStr
endl :: (Monad m, CodeWriterOptions o, CodeWriterState s) => CodeWriterT o s m ()
endl = asks cwoNewline >>= write
pushIndent :: (Monad m, CodeWriterOptions o, CodeWriterState s) => CodeWriterT o s m ()
pushIndent = modify cwsIncreaseIndent
popIndent :: (Monad m, CodeWriterOptions o, CodeWriterState s) => CodeWriterT o s m ()
popIndent = modify cwsDecreaseIndent
pushFilter :: (Monad m, CodeWriterOptions o, CodeWriterState s) => (String -> String) -> CodeWriterT o s m ()
pushFilter f = modify (cwsPushFilter f)
popFilter :: (Monad m, CodeWriterOptions o, CodeWriterState s) => CodeWriterT o s m ()
popFilter = modify cwsPopFilter
surroundedBy :: (Monad m, CodeWriterOptions o, CodeWriterState s) => String -> String -> CodeWriterT o s m a -> CodeWriterT o s m a
surroundedBy l r = between (write l) (write r)
surroundedByLn :: (Monad m, CodeWriterOptions o, CodeWriterState s) => String -> String -> CodeWriterT o s m a -> CodeWriterT o s m a
surroundedByLn l r = between (writeLn l) (writeLn r)
between :: (Monad m, CodeWriterOptions o) => CodeWriterT o s m () -> CodeWriterT o s m () -> CodeWriterT o s m a -> CodeWriterT o s m a
between l r a = do
l
x <- a
r
return x
withIndent :: (Monad m, CodeWriterOptions o, CodeWriterState s) => CodeWriterT o s m a -> CodeWriterT o s m a
withIndent = between pushIndent popIndent
withFilter :: (Monad m, CodeWriterOptions o, CodeWriterState s) => (String -> String) -> CodeWriterT o s m a -> CodeWriterT o s m a
withFilter f = between (pushFilter f) popFilter
withParens :: (Monad m, CodeWriterOptions o, CodeWriterState s) => CodeWriterT o s m a -> CodeWriterT o s m a
withParens = surroundedBy "(" ")"
withBrackets :: (Monad m, CodeWriterOptions o, CodeWriterState s) => CodeWriterT o s m a -> CodeWriterT o s m a
withBrackets = surroundedBy "[" "]"
withBraces :: (Monad m, CodeWriterOptions o, CodeWriterState s) => CodeWriterT o s m a -> CodeWriterT o s m a
withBraces = surroundedBy "{" "}"
withParensLn :: (Monad m, CodeWriterOptions o, CodeWriterState s) => CodeWriterT o s m a -> CodeWriterT o s m a
withParensLn = surroundedByLn "(" ")"
withBracketsLn :: (Monad m, CodeWriterOptions o, CodeWriterState s) => CodeWriterT o s m a -> CodeWriterT o s m a
withBracketsLn = surroundedByLn "[" "]"
withBracesLn :: (Monad m, CodeWriterOptions o, CodeWriterState s) => CodeWriterT o s m a -> CodeWriterT o s m a
withBracesLn = surroundedByLn "{" "}"