44 lines
1.6 KiB
Haskell
44 lines
1.6 KiB
Haskell
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
|