module Ast.Parser.PreProcessor.Import where
import qualified Ast.Parser.State as PS
import qualified Ast.Parser.Utils as PU
import qualified Control.Monad.IO.Class as IO
import qualified Control.Monad.State as S
import qualified Data.ByteString.Char8 as BS
import qualified Data.CaseInsensitive as CI
import qualified Network.HTTP.Simple as N
import qualified System.Environment as E
import qualified System.IO.Error as IOE
import qualified Text.Megaparsec as M
parseImport :: String -> PU.Parser String -> PU.Parser String
parseImport :: String -> Parser String -> Parser String
parseImport String
sourceFile Parser String
parser = do
String
import' <- String -> Parser String
PU.symbol String
"import" Parser String -> Parser String -> Parser String
forall a b.
ParsecT ParseErrorCustom String (StateT ParserState IO) a
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
-> ParsecT ParseErrorCustom String (StateT ParserState IO) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser String -> Parser String -> Parser String -> Parser String
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
M.between (String -> Parser String
PU.symbol String
"\"") (String -> Parser String
PU.symbol String
"\"") (ParsecT ParseErrorCustom String (StateT ParserState IO) Char
-> Parser String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
M.some (ParsecT ParseErrorCustom String (StateT ParserState IO) Char
-> Parser String)
-> ParsecT ParseErrorCustom String (StateT ParserState IO) Char
-> Parser String
forall a b. (a -> b) -> a -> b
$ Token String
-> ParsecT
ParseErrorCustom String (StateT ParserState IO) (Token String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
M.anySingleBut Char
Token String
'\"')
ParserState
state <- ParsecT ParseErrorCustom String (StateT ParserState IO) ParserState
forall s (m :: * -> *). MonadState s m => m s
S.get
let visited :: Bool
visited = String -> ParserState -> Bool
PS.lookupImport String
import' ParserState
state
depth :: Int
depth = ParserState -> Int
PS.getImportDepth ParserState
state
if Bool
visited
then String -> Parser String
forall a.
a -> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
else
if Int
depth Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
maxDepth
then String -> Parser String
forall a.
String -> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Maximum depth exceeded"
else do
(ParserState -> ParserState)
-> ParsecT ParseErrorCustom String (StateT ParserState IO) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
S.modify ((ParserState -> ParserState)
-> ParsecT ParseErrorCustom String (StateT ParserState IO) ())
-> (ParserState -> ParserState)
-> ParsecT ParseErrorCustom String (StateT ParserState IO) ()
forall a b. (a -> b) -> a -> b
$ String -> ParserState -> ParserState
PS.insertImport String
import'
(ParserState -> ParserState)
-> ParsecT ParseErrorCustom String (StateT ParserState IO) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
S.modify ((ParserState -> ParserState)
-> ParsecT ParseErrorCustom String (StateT ParserState IO) ())
-> (ParserState -> ParserState)
-> ParsecT ParseErrorCustom String (StateT ParserState IO) ()
forall a b. (a -> b) -> a -> b
$ Int -> ParserState -> ParserState
PS.setImportDepth (Int -> ParserState -> ParserState)
-> Int -> ParserState -> ParserState
forall a b. (a -> b) -> a -> b
$ Int
depth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
String
source <- IO String -> Parser String
forall a.
IO a -> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO (IO String -> Parser String) -> IO String -> Parser String
forall a b. (a -> b) -> a -> b
$ IO String -> (IOError -> IO String) -> IO String
forall a. IO a -> (IOError -> IO a) -> IO a
IOE.catchIOError (String -> String -> IO String
localImport String
sourceFile String
import') (\IOError
_ -> String -> IO String
externalImport String
import')
String
input <- Parser String
forall e s (m :: * -> *). MonadParsec e s m => m s
M.getInput
String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) ()
forall e s (m :: * -> *). MonadParsec e s m => s -> m ()
M.setInput (String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) ())
-> String
-> ParsecT ParseErrorCustom String (StateT ParserState IO) ()
forall a b. (a -> b) -> a -> b
$ String
source String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
input
String
source' <- Parser String
parser
(ParserState -> ParserState)
-> ParsecT ParseErrorCustom String (StateT ParserState IO) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
S.modify ((ParserState -> ParserState)
-> ParsecT ParseErrorCustom String (StateT ParserState IO) ())
-> (ParserState -> ParserState)
-> ParsecT ParseErrorCustom String (StateT ParserState IO) ()
forall a b. (a -> b) -> a -> b
$ Int -> ParserState -> ParserState
PS.setImportDepth Int
depth
String -> Parser String
forall a.
a -> ParsecT ParseErrorCustom String (StateT ParserState IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return String
source'
where
maxDepth :: Int
maxDepth = Int
25
localImport :: String -> String -> IO String
localImport :: String -> String -> IO String
localImport String
sourceFile String
import' = String -> IO String
readFile (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String -> String
dir String
sourceFile String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
import'
where
dir :: String -> String
dir = String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'/') (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse
externalImport :: String -> IO String
externalImport :: String -> IO String
externalImport String
url = do
Maybe String
auth <- String -> IO (Maybe String)
E.lookupEnv String
"FROST_PRIVATE_REGISTRY_AUTH"
Request
req <- case Maybe String
auth of
Just String
token ->
RequestHeaders -> Request -> Request
N.setRequestHeaders
[(ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
CI.mk (ByteString -> CI ByteString) -> ByteString -> CI ByteString
forall a b. (a -> b) -> a -> b
$ String -> ByteString
BS.pack String
"Authorization", String -> ByteString
BS.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ String
"Bearer " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
token)]
(Request -> Request) -> IO Request -> IO Request
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
N.parseRequestThrow String
url
Maybe String
Nothing -> String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
N.parseRequestThrow String
url
Response ByteString
res <- Request -> IO (Response ByteString)
forall (m :: * -> *).
MonadIO m =>
Request -> m (Response ByteString)
N.httpBS Request
req
String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ ByteString -> String
BS.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ Response ByteString -> ByteString
forall a. Response a -> a
N.getResponseBody Response ByteString
res