perga/lib/Preprocessor.hs

module Preprocessor where

import qualified Data.Set as S
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 ResultStateIO = ExceptT PreprocessorError (StateT (S.Set FilePath) IO)

-- There's a clever way to do this with `foldM` or something, but I think this is still pretty elegant
handleLines :: FilePath -> [Text] -> ResultStateIO Text
handleLines _ [] = pure ""
handleLines filename (line : rest) = do
    line' <- preprocessLine (takeDirectory filename) line
    rest' <- handleLines filename rest
    pure $ line' <> "\n" <> rest'

preprocess :: String -> ResultStateIO Text
preprocess filename =
    ifM (gets $ S.member filename) (pure "") $ do
        modify $ S.insert filename
        text <- decodeUtf8With lenientDecode <$> readFileBS filename
        result <- handleLines filename $ lines text
        putStrLn $ "loading: " ++ filename
        pure result

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

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

runPreprocessor :: String -> ExceptT PreprocessorError IO Text
runPreprocessor filename = liftIO (evalStateT (runExceptT (preprocess filename)) S.empty) >>= hoistEither