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
-- CodeWriterT o s Identity 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 "{" "}"