{-# LANGUAGE CPP, OverloadedStrings #-} {-# OPTIONS_GHC -Wall -fwarn-tabs #-} module Language.Hakaru.Parser.Import (expandImports) where import Language.Hakaru.Parser.AST import Language.Hakaru.Parser.Parser (parseHakaruWithImports) import Control.Monad.Trans.Except import Control.Monad.IO.Class import qualified Data.Text as T import qualified Data.Text.IO as IO import Text.Parsec replaceBody :: AST' T.Text -> AST' T.Text -> AST' T.Text replaceBody :: AST' Text -> AST' Text -> AST' Text replaceBody AST' Text e1 AST' Text e2 = case AST' Text e1 of Let Text x AST' Text e3 AST' Text e4 -> Text -> AST' Text -> AST' Text -> AST' Text forall a. a -> AST' a -> AST' a -> AST' a Let Text x AST' Text e3 (AST' Text -> AST' Text -> AST' Text replaceBody AST' Text e4 AST' Text e2) Ann AST' Text e3 TypeAST' t -> AST' Text -> TypeAST' -> AST' Text forall a. AST' a -> TypeAST' -> AST' a Ann (AST' Text -> AST' Text -> AST' Text replaceBody AST' Text e3 AST' Text e2) TypeAST' t WithMeta AST' Text e3 SourceSpan s -> AST' Text -> SourceSpan -> AST' Text forall a. AST' a -> SourceSpan -> AST' a WithMeta (AST' Text -> AST' Text -> AST' Text replaceBody AST' Text e3 AST' Text e2) SourceSpan s AST' Text _ -> AST' Text e2 expandImports :: Maybe FilePath -> ASTWithImport' T.Text -> ExceptT ParseError IO (AST' T.Text) expandImports :: Maybe FilePath -> ASTWithImport' Text -> ExceptT ParseError IO (AST' Text) expandImports Maybe FilePath dir (ASTWithImport' (Import Text i:[Import Text] is) AST' Text ast) = do Text file <- IO Text -> ExceptT ParseError IO Text forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO Text -> ExceptT ParseError IO Text) -> (Text -> IO Text) -> Text -> ExceptT ParseError IO Text forall b c a. (b -> c) -> (a -> b) -> a -> c . FilePath -> IO Text IO.readFile (FilePath -> IO Text) -> (Text -> FilePath) -> Text -> IO Text forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> FilePath T.unpack (Text -> ExceptT ParseError IO Text) -> Text -> ExceptT ParseError IO Text forall a b. (a -> b) -> a -> b $ [Text] -> Text T.concat ([Text] -> Text) -> [Text] -> Text forall a b. (a -> b) -> a -> b $ [Text] -> (FilePath -> [Text]) -> Maybe FilePath -> [Text] forall b a. b -> (a -> b) -> Maybe a -> b maybe [] ((Text -> [Text] -> [Text] forall a. a -> [a] -> [a] :[Text "/"]) (Text -> [Text]) -> (FilePath -> Text) -> FilePath -> [Text] forall b c a. (b -> c) -> (a -> b) -> a -> c . FilePath -> Text T.pack) Maybe FilePath dir [Text] -> [Text] -> [Text] forall a. [a] -> [a] -> [a] ++ [ Text i, Text ".hk" ] ASTWithImport' Text astIm <- IO (Either ParseError (ASTWithImport' Text)) -> ExceptT ParseError IO (ASTWithImport' Text) forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a ExceptT (IO (Either ParseError (ASTWithImport' Text)) -> ExceptT ParseError IO (ASTWithImport' Text)) -> (Either ParseError (ASTWithImport' Text) -> IO (Either ParseError (ASTWithImport' Text))) -> Either ParseError (ASTWithImport' Text) -> ExceptT ParseError IO (ASTWithImport' Text) forall b c a. (b -> c) -> (a -> b) -> a -> c . Either ParseError (ASTWithImport' Text) -> IO (Either ParseError (ASTWithImport' Text)) forall (m :: * -> *) a. Monad m => a -> m a return (Either ParseError (ASTWithImport' Text) -> ExceptT ParseError IO (ASTWithImport' Text)) -> Either ParseError (ASTWithImport' Text) -> ExceptT ParseError IO (ASTWithImport' Text) forall a b. (a -> b) -> a -> b $ Text -> Either ParseError (ASTWithImport' Text) parseHakaruWithImports Text file AST' Text ast' <- Maybe FilePath -> ASTWithImport' Text -> ExceptT ParseError IO (AST' Text) expandImports Maybe FilePath dir ASTWithImport' Text astIm Maybe FilePath -> ASTWithImport' Text -> ExceptT ParseError IO (AST' Text) expandImports Maybe FilePath dir ([Import Text] -> AST' Text -> ASTWithImport' Text forall a. [Import a] -> AST' a -> ASTWithImport' a ASTWithImport' [Import Text] is (AST' Text -> AST' Text -> AST' Text replaceBody AST' Text ast' AST' Text ast)) expandImports Maybe FilePath _ (ASTWithImport' [] AST' Text ast) = AST' Text -> ExceptT ParseError IO (AST' Text) forall (m :: * -> *) a. Monad m => a -> m a return AST' Text ast