38 lines
1.3 KiB
Haskell
38 lines
1.3 KiB
Haskell
|
module Preprocessor where
|
||
|
|
|
||
|
|
import Control.Monad.Except
|
||
|
|
import Control.Monad.IO.Class
|
||
|
|
import Data.Text (Text)
|
||
|
|
import qualified Data.Text as T
|
||
|
|
import qualified Data.Text.IO as TIO
|
||
|
|
import System.FilePath
|
||
|
|
import System.IO
|
||
|
|
|
||
|
|
newtype PreprocessorError = ParseError Text
|
||
|
|
|
||
|
|
instance Show PreprocessorError where
|
||
|
|
show (ParseError t) = "Preprocessor error on line '" ++ show t ++ "'"
|
||
|
|
|
||
|
|
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
|
||
|
|
handle <- liftIO $ openFile filename ReadMode
|
||
|
|
text <- liftIO $ T.lines <$> TIO.hGetContents handle
|
||
|
|
result <- concatMapM (preprocessLine $ takeDirectory filename) text
|
||
|
|
liftIO $ putStrLn $ "loading: " ++ filename
|
||
|
|
pure result
|
||
|
|
|
||
|
|
parseInclude :: Text -> Result Text
|
||
|
|
parseInclude line = maybe (Left $ ParseError line) pure $ T.stripPrefix "@include " line
|
||
|
|
|
||
|
|
preprocessLine :: FilePath -> Text -> ResultIO Text
|
||
|
|
preprocessLine base line
|
||
|
|
| "@include " `T.isPrefixOf` line = liftEither (parseInclude line) >>= preprocess . normalise . (base </>) . T.unpack
|
||
|
|
| otherwise = pure line
|