perga/lib/Preprocessor.hs

module Preprocessor where

import Control.Monad.Except
import qualified Data.Text as T
import System.FilePath

newtype PreprocessorError = ParseError Text

instance ToText PreprocessorError where
    toText (ParseError t) = "Preprocessor error on line '" <> t <> "'"

instance ToString PreprocessorError where
    toString = toString . toText

type Result = Either PreprocessorError
type ResultIO = ExceptT PreprocessorError IO

concatMapM :: (Applicative f) => (a -> f Text) -> [a] -> f Text
concatMapM _ [] = pure mempty
concatMapM f (x : xs) = ((<>) . (<> "\n") <$> f x) <*> concatMapM f xs

preprocess :: String -> ResultIO Text
preprocess filename = do
    text <- decodeUtf8With lenientDecode <$> readFileBS filename
    result <- concatMapM (preprocessLine $ takeDirectory filename) (lines text)
    putStrLn $ "loading: " ++ filename
    pure result

parseInclude :: Text -> Result Text
parseInclude line = maybeToRight (ParseError line) $ T.stripPrefix "@include " line

preprocessLine :: FilePath -> Text -> ResultIO Text
preprocessLine base line
    | "@include " `T.isPrefixOf` line = liftEither (parseInclude line) >>= preprocess . normalise . (base </>) . toString
    | otherwise = pure line