module Hpp.Types where
import Hpp.Config
import Hpp.Tokens
type LineNum = Int
data Error = UnterminatedBranch
| BadMacroDefinition LineNum
| BadIfPredicate
| BadLineArgument LineNum String
| IncludeDoesNotExist LineNum FilePath
| FailedInclude LineNum FilePath
| UserError LineNum String
| UnknownCommand LineNum String
| TooFewArgumentsToMacro LineNum String
| BadMacroArguments LineNum String
| NoInputFile
| BadCommandLine String
deriving (Eq, Ord, Show)
data Hpp a = Pure a
| ReadFile Int FilePath (String -> Hpp a)
| ReadNext Int FilePath (String -> Hpp a)
| GetConfig (Config -> Hpp a)
| SetConfig Config (Hpp a)
instance Functor Hpp where
fmap f (Pure a) = Pure (f a)
fmap f (ReadFile ln file k) = ReadFile ln file (fmap f . k)
fmap f (ReadNext ln file k) = ReadNext ln file (fmap f . k)
fmap f (GetConfig k) = GetConfig (fmap f . k)
fmap f (SetConfig cfg k) = SetConfig cfg (fmap f k)
instance Applicative Hpp where
pure = Pure
Pure f <*> Pure x = Pure (f x)
Pure f <*> ReadFile ln file k = ReadFile ln file (fmap f . k)
Pure f <*> ReadNext ln file k = ReadNext ln file (fmap f . k)
Pure f <*> GetConfig k = GetConfig (fmap f . k)
Pure f <*> SetConfig cfg k = SetConfig cfg (fmap f k)
ReadFile ln file k <*> x = ReadFile ln file ((<*> x) . k)
ReadNext ln file k <*> x = ReadNext ln file ((<*> x) . k)
GetConfig k <*> x = GetConfig ((<*> x) . k)
SetConfig cfg k <*> x = SetConfig cfg (k <*> x)
instance Monad Hpp where
return = pure
Pure x >>= f = f x
ReadFile ln file k >>= f = ReadFile ln file ((>>= f) . k)
ReadNext ln file k >>= f = ReadNext ln file ((>>= f) . k)
GetConfig k >>= f = GetConfig ((>>= f) . k)
SetConfig cfg k >>= f = SetConfig cfg (k >>= f)
newtype ErrHpp a = ErrHpp { runErrHpp :: Hpp (Either (FilePath,Error) a) }
instance Functor ErrHpp where
fmap f = ErrHpp . fmap (fmap f) . runErrHpp
instance Applicative ErrHpp where
pure = ErrHpp . pure . pure
ErrHpp f <*> ErrHpp x =
ErrHpp $
do f >>= \case
Left err -> return (Left err)
Right f' -> do x >>= \case
Left err' -> return (Left err')
Right x' -> return (Right $ f' x')
instance Monad ErrHpp where
return = pure
ErrHpp x >>= fb = ErrHpp $ do x >>= \case
Left err -> return (Left err)
Right x' -> runErrHpp (fb x')
data Scan = Unmask String
| Mask String
| Scan Token
| Rescan Token
deriving Show
type DList a = [a] -> [a]
data Macro = Object [Token]
| Function Int ([([Scan],String)] -> [Scan])
instance Show Macro where
show (Object ts) = "Object "++ detokenize ts
show (Function n _) = "Fun<"++show n++">"