module Text.Indent.Type.CodeGen (
CodeGen
) where
import Control.Arrow
import Control.Monad.ListM
import Control.Monad.State.Strict
import Data.Char
import Data.List
import Data.Maybe
import Data.Tagged
import Text.Indent.Class
data CodeGen
type IndentAmount = Int
type Line = String
data IndentItem
= Open
| Begin
| Brace
deriving (Show, Eq)
data MalformedStack = MalformedStack
data IndentState = IndentState {
indentAmount :: IndentAmount,
itemStack :: Either MalformedStack [IndentItem]
}
initState :: IndentState
initState = IndentState {
indentAmount = 0,
itemStack = Right [] }
instance Indenter CodeGen where
indent mode = Tagged . unlines . flip evalState initState . mapM (tabify . wsOp) . lines
where
wsOp = case mode of
DropOldTabs -> dropWs
KeepOldTabs -> id
tabify line = do
newTabAmount <- calculateTabs $ dropWs line
return $ replicate newTabAmount '\t' ++ line
dropWs :: String -> String
dropWs = dropWhile isSpace
lastNonWs :: String -> Maybe Char
lastNonWs s = case dropWs $ reverse s of
[] -> Nothing
c : _ -> Just c
calculateTabs :: Line -> State IndentState IndentAmount
calculateTabs line = case line of
(stripPrefix "DEFINE" -> Just (stripPrefix "(" . dropWs -> Just rest)) -> calculateTabs rest
(isPrefixOf "HC_Open_" -> True) -> do
n <- gets indentAmount
push Open
return n
(isPrefixOf "HC_KOpen_" -> True) -> do
n <- gets indentAmount
push Open
return n
(isPrefixOf "HC_Close_" -> True) -> do
pop Open
gets indentAmount
(isPrefixOf "HC_Begin_" -> True) -> do
n <- gets indentAmount
push Begin
return n
(isPrefixOf "HC_End_" -> True) -> do
pop Begin
gets indentAmount
(lastNonWs -> Just '{') -> do
n <- gets indentAmount
push Brace
return n
(isPrefixOf "}" -> True) -> do
popTill Brace
pop Brace
gets indentAmount
_ -> gets indentAmount
topItem :: State IndentState (Maybe IndentItem)
topItem = gets $ either (const Nothing) listToMaybe . itemStack
push :: IndentItem -> State IndentState ()
push item = do
modify $ \st -> st { itemStack = fmap (item :) $ itemStack st }
modify $ \st -> st { indentAmount = indentAmount st + 1 }
pop :: IndentItem -> State IndentState ()
pop item = do
mItem <- topItem
if Just item == mItem
then do
modify $ \st -> st { itemStack = fmap tail $ itemStack st }
modify $ \st -> st { indentAmount = indentAmount st 1 }
else modify $ \st -> st { itemStack = Left MalformedStack }
popTill :: IndentItem -> State IndentState ()
popTill destItem = do
mItem <- topItem
case mItem of
Nothing -> return ()
Just item -> if item == destItem
then return ()
else do
pop item
popTill destItem