module Language.Haskell.Preprocessor.Printer ( dump ) where
import Language.Haskell.Preprocessor.Ast
import Language.Haskell.Preprocessor.Token
import Language.Haskell.Preprocessor.Loc
import Control.Monad (foldM)
dump :: Monad m => (String -> m ()) -> [Ast] -> m ()
dump write forest = start where
start = do
let items = flattenList forest []
here = case items of
[] -> bogus
x:_ -> initial (file (loc x))
write (toDirective here)
write "\n"
foldM sayToken here items
write "\n"
sayToken here item
| null (val item) = do
return here
| isBogus (loc item) = do
foldM sayString here [" ", val item, " "]
| otherwise = do
here <- goto here (loc item)
sayString here (val item)
goto here there
| line here < line there = do
let directive = toDirective there
newlines = line there line here
if length directive < newlines
then do
write "\n"; write directive; write "\n"
else do
write (replicate (line there line here) '\n')
write (replicate (col there 1) ' ')
return there
| line here == line there && col here <= col there = do
write (replicate (col there col here) ' ')
return there
| otherwise = do
write "\n"
write (toDirective there)
write "\n"
write (replicate (col there 1) ' ')
return there
sayString here str = do
write str
return (here `advance` str)