module Language.Haskell.Preprocessor.Ast (
Ast(..), flatten, flattenList, format, cons,
module Language.Haskell.Preprocessor.Token
) where
import Data.Typeable (Typeable)
import Data.Generics (Data, mkT, everywhere)
import Char (isDigit)
import Language.Haskell.Preprocessor.Loc (Locatable(..), bogus)
import Language.Haskell.Preprocessor.Token
data Ast =
Single { item :: Token }
| Block { item :: Token,
lbrace :: Maybe Token,
body :: [Ast],
rbrace :: Maybe Token,
next :: Ast }
| Empty
deriving (Eq, Show, Typeable, Data)
flatten :: Ast -> [Token] -> [Token]
flatten (Single item) = (com item ++) . (item { com = [] }:)
flatten Empty = id
flatten (Block item lbrace body rbrace next)
= (item :) .
maybe id (:) lbrace .
flattenList body .
maybe id (:) rbrace .
flatten next
flattenList :: [Ast] -> [Token] -> [Token]
flattenList lst = foldr (.) id (map flatten lst)
format :: Data a => a -> [Ast] -> a
format a subs = everywhere (mkT replace) a where
replace (Single Token { tag = CharLit,
val = '\'':'#':rest@(_:_) })
| all isDigit num && index < length subs
= subs !! index where
num = init rest
index = read num 1
replace t = t
cons :: Token -> Ast -> Ast
cons a b = Block a Nothing [b] Nothing Empty
instance Locatable Ast where
getLoc Empty = bogus
getLoc ast = loc (item ast)
setLoc Empty _ = Empty
setLoc ast l = ast { item = setLoc (item ast) l }