{-| Module : Morloc.Frontend.API Description : Morloc frontend API Copyright : (c) Zebulun Arendsee, 2020 License : GPL-3 Maintainer : zbwrnz@gmail.com Stability : experimental -} module Morloc.Frontend.API ( parse , typecheck , runStack , Parser.readType , Pretty.ugly , Pretty.cute ) where import Morloc.Frontend.Namespace import qualified Control.Monad.Except as ME import qualified Control.Monad.Reader as MR import qualified Control.Monad.State as MS import qualified Control.Monad.Writer as MW import qualified Data.Map as Map import qualified Data.Set as Set import qualified Morloc.Data.DAG as MDD import qualified Morloc.Data.Text as MT import qualified Morloc.Module as Mod import qualified Morloc.Monad as MM import qualified Morloc.Frontend.Parser as Parser import qualified Morloc.Frontend.Infer as Infer import qualified Morloc.Frontend.Pretty as Pretty parse :: Maybe Path -> Code -- ^ code of the current module -> MorlocMonad (DAG MVar Import ParserNode) parse f (Code code) = parseImports (Parser.readProgram f code mempty) where parseImports :: DAG MVar Import ParserNode -> MorlocMonad (DAG MVar Import ParserNode) parseImports d | length unimported == 0 = return d | otherwise = do importPath <- Mod.findModule (head unimported) Mod.loadModuleMetadata importPath (path', code') <- openLocalModule importPath parseImports (Parser.readProgram path' code' d) where g = MDD.edgelist d parents = Map.keysSet d children = Set.fromList (map snd g) unimported = Set.toList $ Set.difference children parents -- | assume @t@ is a filename and open it, return file name and contents openLocalModule :: Path -> MorlocMonad (Maybe Path, MT.Text) openLocalModule filename = do code <- liftIO $ MT.readFile (MT.unpack . unPath $ filename) return (Just filename, code) typecheck :: DAG MVar [(EVar, EVar)] PreparedNode -> MorlocMonad (DAG MVar [(EVar, EVar)] TypedNode) typecheck d = do verbosity <- MS.gets stateVerbosity x <- liftIO $ runStack verbosity (Infer.typecheck d) case x of ((Right result, _), _) -> return result ((Left err, _), _) -> MM.throwError err -- | currently I do nothing with the Reader and Writer monads, but I'm leaving -- them in for now since I will need them when I plug this all into Morloc. runStack :: Int -> Stack a -> IO ((Either MorlocError a, [MT.Text]), StackState) runStack verbosity e = flip MS.runStateT emptyState . MW.runWriterT . ME.runExceptT . MR.runReaderT e $ StackConfig verbosity emptyState = StackState { stateVar = 0 , stateQul = 0 , stateSer = [] , stateDepth = 0 }