{-# 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