{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE Safe #-}
module Embedder.FrontEnd
      ( embedFile
      , LoadPath
      ) where

import Embedder.Config (Config, getAtmoFile, verbose)
import ReWire.Error (MonadError, AstError, runSyntaxError, printError)
import Embedder.ModCache (runCache, LoadPath, getModule)
import ReWire.Pretty (Pretty, prettyPrint, fastPrint)
import qualified Embedder.Config         as Config

import Control.Monad (when)
import Control.Lens ((^.))
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.State (MonadState)
import Data.Text (pack)
import qualified Data.Text.IO        as T
import System.Exit (exitFailure)

embedFile :: MonadIO m => Config -> FilePath -> m ()
embedFile :: forall (m :: * -> *). MonadIO m => Config -> FilePath -> m ()
embedFile  Config
conf FilePath
filename = do
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Config
confConfig -> Getting Bool Config Bool -> Bool
forall s a. s -> Getting a s a -> a
^.Getting Bool Config Bool
Lens' Config Bool
verbose) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Embedding: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
pack FilePath
filename
      SyntaxErrorT AstError m () -> m (Either AstError ())
forall (m :: * -> *) a.
Monad m =>
SyntaxErrorT AstError m a -> m (Either AstError a)
runSyntaxError (Config -> FilePath -> SyntaxErrorT AstError m ()
forall (m :: * -> *).
(MonadFail m, MonadError AstError m, MonadState AstError m,
 MonadIO m) =>
Config -> FilePath -> m ()
embedModule Config
conf FilePath
filename)
            m (Either AstError ()) -> (Either AstError () -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (AstError -> m ()) -> (() -> m ()) -> Either AstError () -> m ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\ AstError
err -> [FilePath] -> AstError -> m ()
forall (m :: * -> *). MonadIO m => [FilePath] -> AstError -> m ()
printError [FilePath
"."] AstError
err m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
forall a. IO a
exitFailure) () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Opens and parses a file and, recursively, its imports.
embedModule :: (MonadFail m, MonadError AstError m, MonadState AstError m, MonadIO m) => Config -> FilePath -> m ()
embedModule :: forall (m :: * -> *).
(MonadFail m, MonadError AstError m, MonadState AstError m,
 MonadIO m) =>
Config -> FilePath -> m ()
embedModule Config
conf FilePath
fp = Cache m () -> m ()
forall (m :: * -> *) a.
(MonadIO m, MonadError AstError m) =>
Cache m a -> m a
runCache (Cache m () -> m ()) -> Cache m () -> m ()
forall a b. (a -> b) -> a -> b
$ Config -> FilePath -> FilePath -> Cache m (Module, Exports)
forall (m :: * -> *).
(MonadIO m, MonadFail m, MonadError AstError m,
 MonadState AstError m) =>
Config -> FilePath -> FilePath -> Cache m (Module, Exports)
getModule Config
conf FilePath
"." FilePath
fp Cache m (Module, Exports)
-> ((Module, Exports) -> Cache m ()) -> Cache m ()
forall a b.
StateT (HashMap FilePath (Module, Exports)) m a
-> (a -> StateT (HashMap FilePath (Module, Exports)) m b)
-> StateT (HashMap FilePath (Module, Exports)) m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ (Module
m,Exports
_) -> Module -> Cache m ()
forall (m :: * -> *) a.
(MonadError AstError m, MonadIO m, Pretty a) =>
a -> m ()
writeOutput Module
m
      where
            writeOutput :: (MonadError AstError m, MonadIO m, Pretty a) => a -> m ()
            writeOutput :: forall (m :: * -> *) a.
(MonadError AstError m, MonadIO m, Pretty a) =>
a -> m ()
writeOutput a
a = do
                  let fout :: FilePath
fout = Config -> FilePath -> FilePath
getAtmoFile Config
conf FilePath
fp
                  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> IO ()
T.writeFile FilePath
fout (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ if Config
confConfig -> Getting Bool Config Bool -> Bool
forall s a. s -> Getting a s a -> a
^.Getting Bool Config Bool
Lens' Config Bool
Config.pretty then a -> Text
forall a. Pretty a => a -> Text
prettyPrint a
a else a -> Text
forall a. Pretty a => a -> Text
fastPrint a
a