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