{-# LANGUAGE BlockArguments             #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ImportQualifiedPost        #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE OverloadedStrings          #-}

module Dovetail
  ( module Dovetail.Types
  , module Dovetail.FFI
  , module Dovetail.FFI.Builder
  
  -- * High-level API
  , InterpretT
  , runInterpretT
  , runInterpret
  , liftEvalT
  
  -- ** Debugging
  , runInterpretTWithDebugger
  
  -- ** Error messages
  , InterpretError(..)
  , renderInterpretError
  
  -- ** Foreign function interface
  , ffi
  
  -- ** Building PureScript source
  , build
  , buildCoreFn
  , module Dovetail.Build
  
  -- ** Evaluating expressions
  , eval
  , evalCoreFn
  , evalMain
  , module Dovetail.Evaluate
  
  -- ** REPL
  , repl
  
  -- * Re-exports
  , module Language.PureScript.CoreFn
  , module Language.PureScript.Names
  ) where

import Control.Monad.Catch (MonadMask)
import Control.Monad.Error.Class (MonadError(..))
import Control.Monad.Fix (MonadFix)
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Trans.Class (MonadTrans(..))
import Control.Monad.Trans.Except (ExceptT(..), runExceptT)
import Control.Monad.Trans.State (StateT, evalStateT, get, put, modify, runStateT)
import Data.Bifunctor (first)
import Data.Functor.Identity (Identity(..))
import Data.Map qualified as Map
import Data.Text (Text)
import Dovetail.Build (BuildError(..), renderBuildError)
import Dovetail.Build qualified as Build
import Dovetail.Evaluate (Env, EvalT(..), runEvalT, Eval, runEval, 
                          ToValue(..), ToValueRHS(..))
import Dovetail.Evaluate qualified as Evaluate
import Dovetail.FFI
import Dovetail.FFI qualified as FFI
import Dovetail.FFI.Builder
import Dovetail.REPL qualified as REPL
import Dovetail.Types 
import Language.PureScript qualified as P
import Language.PureScript.CoreFn (Ann, Expr, Module)
import Language.PureScript.CoreFn qualified as CoreFn
import Language.PureScript.Names

-- | A monad transformer for high-level tasks involving PureScript code, including separate 
-- compilation. Its job is to keep track of available modules, any foreign imports
-- from Haskell code, and run PureScript code.
--
-- Note: do not confuse this monad transformer with 'EvalT', which is only
-- responsible for powering evaluation of PureScript expressions.
--
-- The transformed monad is used to track any benign side effects that might be
-- exposed via the foreign function interface to PureScript code, in the same sense
-- as 'EvalT'.
newtype InterpretT m a = InterpretT { InterpretT m a
-> ExceptT (InterpretError m) (StateT ([ExternsFile], Env m) m) a
unInterpretT :: ExceptT (InterpretError m) (StateT ([P.ExternsFile], Env m) m) a }
  deriving newtype (a -> InterpretT m b -> InterpretT m a
(a -> b) -> InterpretT m a -> InterpretT m b
(forall a b. (a -> b) -> InterpretT m a -> InterpretT m b)
-> (forall a b. a -> InterpretT m b -> InterpretT m a)
-> Functor (InterpretT m)
forall a b. a -> InterpretT m b -> InterpretT m a
forall a b. (a -> b) -> InterpretT m a -> InterpretT m b
forall (m :: * -> *) a b.
Functor m =>
a -> InterpretT m b -> InterpretT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> InterpretT m a -> InterpretT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> InterpretT m b -> InterpretT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> InterpretT m b -> InterpretT m a
fmap :: (a -> b) -> InterpretT m a -> InterpretT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> InterpretT m a -> InterpretT m b
Functor, Functor (InterpretT m)
a -> InterpretT m a
Functor (InterpretT m)
-> (forall a. a -> InterpretT m a)
-> (forall a b.
    InterpretT m (a -> b) -> InterpretT m a -> InterpretT m b)
-> (forall a b c.
    (a -> b -> c)
    -> InterpretT m a -> InterpretT m b -> InterpretT m c)
-> (forall a b. InterpretT m a -> InterpretT m b -> InterpretT m b)
-> (forall a b. InterpretT m a -> InterpretT m b -> InterpretT m a)
-> Applicative (InterpretT m)
InterpretT m a -> InterpretT m b -> InterpretT m b
InterpretT m a -> InterpretT m b -> InterpretT m a
InterpretT m (a -> b) -> InterpretT m a -> InterpretT m b
(a -> b -> c) -> InterpretT m a -> InterpretT m b -> InterpretT m c
forall a. a -> InterpretT m a
forall a b. InterpretT m a -> InterpretT m b -> InterpretT m a
forall a b. InterpretT m a -> InterpretT m b -> InterpretT m b
forall a b.
InterpretT m (a -> b) -> InterpretT m a -> InterpretT m b
forall a b c.
(a -> b -> c) -> InterpretT m a -> InterpretT m b -> InterpretT m c
forall (m :: * -> *). Monad m => Functor (InterpretT m)
forall (m :: * -> *) a. Monad m => a -> InterpretT m a
forall (m :: * -> *) a b.
Monad m =>
InterpretT m a -> InterpretT m b -> InterpretT m a
forall (m :: * -> *) a b.
Monad m =>
InterpretT m a -> InterpretT m b -> InterpretT m b
forall (m :: * -> *) a b.
Monad m =>
InterpretT m (a -> b) -> InterpretT m a -> InterpretT m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> InterpretT m a -> InterpretT m b -> InterpretT m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: InterpretT m a -> InterpretT m b -> InterpretT m a
$c<* :: forall (m :: * -> *) a b.
Monad m =>
InterpretT m a -> InterpretT m b -> InterpretT m a
*> :: InterpretT m a -> InterpretT m b -> InterpretT m b
$c*> :: forall (m :: * -> *) a b.
Monad m =>
InterpretT m a -> InterpretT m b -> InterpretT m b
liftA2 :: (a -> b -> c) -> InterpretT m a -> InterpretT m b -> InterpretT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> InterpretT m a -> InterpretT m b -> InterpretT m c
<*> :: InterpretT m (a -> b) -> InterpretT m a -> InterpretT m b
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
InterpretT m (a -> b) -> InterpretT m a -> InterpretT m b
pure :: a -> InterpretT m a
$cpure :: forall (m :: * -> *) a. Monad m => a -> InterpretT m a
$cp1Applicative :: forall (m :: * -> *). Monad m => Functor (InterpretT m)
Applicative, Applicative (InterpretT m)
a -> InterpretT m a
Applicative (InterpretT m)
-> (forall a b.
    InterpretT m a -> (a -> InterpretT m b) -> InterpretT m b)
-> (forall a b. InterpretT m a -> InterpretT m b -> InterpretT m b)
-> (forall a. a -> InterpretT m a)
-> Monad (InterpretT m)
InterpretT m a -> (a -> InterpretT m b) -> InterpretT m b
InterpretT m a -> InterpretT m b -> InterpretT m b
forall a. a -> InterpretT m a
forall a b. InterpretT m a -> InterpretT m b -> InterpretT m b
forall a b.
InterpretT m a -> (a -> InterpretT m b) -> InterpretT m b
forall (m :: * -> *). Monad m => Applicative (InterpretT m)
forall (m :: * -> *) a. Monad m => a -> InterpretT m a
forall (m :: * -> *) a b.
Monad m =>
InterpretT m a -> InterpretT m b -> InterpretT m b
forall (m :: * -> *) a b.
Monad m =>
InterpretT m a -> (a -> InterpretT m b) -> InterpretT m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> InterpretT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> InterpretT m a
>> :: InterpretT m a -> InterpretT m b -> InterpretT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
InterpretT m a -> InterpretT m b -> InterpretT m b
>>= :: InterpretT m a -> (a -> InterpretT m b) -> InterpretT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
InterpretT m a -> (a -> InterpretT m b) -> InterpretT m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (InterpretT m)
Monad, MonadError (InterpretError m))
  
instance MonadTrans InterpretT where
  lift :: m a -> InterpretT m a
lift = ExceptT (InterpretError m) (StateT ([ExternsFile], Env m) m) a
-> InterpretT m a
forall (m :: * -> *) a.
ExceptT (InterpretError m) (StateT ([ExternsFile], Env m) m) a
-> InterpretT m a
InterpretT (ExceptT (InterpretError m) (StateT ([ExternsFile], Env m) m) a
 -> InterpretT m a)
-> (m a
    -> ExceptT (InterpretError m) (StateT ([ExternsFile], Env m) m) a)
-> m a
-> InterpretT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT ([ExternsFile], Env m) m a
-> ExceptT (InterpretError m) (StateT ([ExternsFile], Env m) m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT ([ExternsFile], Env m) m a
 -> ExceptT (InterpretError m) (StateT ([ExternsFile], Env m) m) a)
-> (m a -> StateT ([ExternsFile], Env m) m a)
-> m a
-> ExceptT (InterpretError m) (StateT ([ExternsFile], Env m) m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> StateT ([ExternsFile], Env m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

-- | Run a computation in the 'InterpretT' monad, possibly returning an error.
-- Note: errors can occur during module building or evaluation (i.e. module loading).
--
-- The 'runInterpret' function is a simpler alternative in the case where benign
-- side-effects are not needed.
--
-- For example:
--
-- @
-- runInterpret @Module do
--   -- Load the prelude
--   'ffi' 'prelude'
--   -- Build a module from source
--   'build' "module Main where main = \\\"example\\\"" --
--
-- runInterpret @(Eval Text) do
--   'ffi' 'prelude'
--   _ <- 'build' "module Main where main = \\\"example\\\""
--   -- Evaluate the main function
--   'evalMain' ('P.ModuleName' \"Main\")
-- @
runInterpretT :: Monad m => InterpretT m a -> m (Either (InterpretError m) a)
runInterpretT :: InterpretT m a -> m (Either (InterpretError m) a)
runInterpretT = (StateT ([ExternsFile], Env m) m (Either (InterpretError m) a)
 -> ([ExternsFile], Env m) -> m (Either (InterpretError m) a))
-> ([ExternsFile], Env m)
-> StateT ([ExternsFile], Env m) m (Either (InterpretError m) a)
-> m (Either (InterpretError m) a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT ([ExternsFile], Env m) m (Either (InterpretError m) a)
-> ([ExternsFile], Env m) -> m (Either (InterpretError m) a)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT ([], Env m
forall a. Monoid a => a
mempty) (StateT ([ExternsFile], Env m) m (Either (InterpretError m) a)
 -> m (Either (InterpretError m) a))
-> (InterpretT m a
    -> StateT ([ExternsFile], Env m) m (Either (InterpretError m) a))
-> InterpretT m a
-> m (Either (InterpretError m) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT (InterpretError m) (StateT ([ExternsFile], Env m) m) a
-> StateT ([ExternsFile], Env m) m (Either (InterpretError m) a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT (InterpretError m) (StateT ([ExternsFile], Env m) m) a
 -> StateT ([ExternsFile], Env m) m (Either (InterpretError m) a))
-> (InterpretT m a
    -> ExceptT (InterpretError m) (StateT ([ExternsFile], Env m) m) a)
-> InterpretT m a
-> StateT ([ExternsFile], Env m) m (Either (InterpretError m) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InterpretT m a
-> ExceptT (InterpretError m) (StateT ([ExternsFile], Env m) m) a
forall (m :: * -> *) a.
InterpretT m a
-> ExceptT (InterpretError m) (StateT ([ExternsFile], Env m) m) a
unInterpretT

-- | Like 'runInterpretT', but starts an interactive debugging session in the
-- event of a debugging error.
runInterpretTWithDebugger 
  :: (MonadIO m, MonadFix m, MonadMask m)
  => InterpretT m a
  -> m ()
runInterpretTWithDebugger :: InterpretT m a -> m ()
runInterpretTWithDebugger InterpretT m a
x = do
  (Either (InterpretError m) a
e, ([ExternsFile]
externs, Env m
env)) <- (StateT ([ExternsFile], Env m) m (Either (InterpretError m) a)
 -> ([ExternsFile], Env m)
 -> m (Either (InterpretError m) a, ([ExternsFile], Env m)))
-> ([ExternsFile], Env m)
-> StateT ([ExternsFile], Env m) m (Either (InterpretError m) a)
-> m (Either (InterpretError m) a, ([ExternsFile], Env m))
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT ([ExternsFile], Env m) m (Either (InterpretError m) a)
-> ([ExternsFile], Env m)
-> m (Either (InterpretError m) a, ([ExternsFile], Env m))
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT ([], Env m
forall a. Monoid a => a
mempty) (StateT ([ExternsFile], Env m) m (Either (InterpretError m) a)
 -> m (Either (InterpretError m) a, ([ExternsFile], Env m)))
-> StateT ([ExternsFile], Env m) m (Either (InterpretError m) a)
-> m (Either (InterpretError m) a, ([ExternsFile], Env m))
forall a b. (a -> b) -> a -> b
$ ExceptT (InterpretError m) (StateT ([ExternsFile], Env m) m) a
-> StateT ([ExternsFile], Env m) m (Either (InterpretError m) a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (InterpretT m a
-> ExceptT (InterpretError m) (StateT ([ExternsFile], Env m) m) a
forall (m :: * -> *) a.
InterpretT m a
-> ExceptT (InterpretError m) (StateT ([ExternsFile], Env m) m) a
unInterpretT InterpretT m a
x)
  case Either (InterpretError m) a
e of
    Left InterpretError m
err -> do
      IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (String -> IO ()) -> String -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStrLn (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ RenderValueOptions -> InterpretError m -> String
forall (m :: * -> *).
RenderValueOptions -> InterpretError m -> String
renderInterpretError RenderValueOptions
defaultTerminalRenderValueOptions InterpretError m
err
      case InterpretError m
err of
        ErrorDuringEvaluation EvaluationError m
evalErr -> do
          IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (String -> IO ()) -> String -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStrLn (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"\nStarting the debugger. ^C to exit."
          let withEnvAtError :: Env m
withEnvAtError =
                case EvaluationError m -> EvaluationContext m
forall (m :: * -> *). EvaluationError m -> EvaluationContext m
errorContext EvaluationError m
evalErr of
                  EvaluationContext (EvaluationStackFrame m
frame : [EvaluationStackFrame m]
_) ->
                    (EvaluationStackFrame m -> Env m
forall (m :: * -> *). EvaluationStackFrame m -> Env m
frameEnv EvaluationStackFrame m
frame Env m -> Env m -> Env m
forall a. Semigroup a => a -> a -> a
<> Env m
env)
                  EvaluationContext m
_ -> Env m
env
              additionalNames :: [Ident]
additionalNames = 
                [ Qualified Ident -> Ident
forall a. Qualified a -> a
P.disqualify Qualified Ident
ident
                | Qualified Ident
ident <- Env m -> [Qualified Ident]
forall k a. Map k a -> [k]
Map.keys (Env m
withEnvAtError Env m -> Env m -> Env m
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.\\ Env m
env)
                , Bool -> Bool
not (Qualified Ident -> Bool
forall a. Qualified a -> Bool
P.isQualified Qualified Ident
ident)
                ]
          Maybe ModuleName -> [ExternsFile] -> [Ident] -> Env m -> m ()
forall (m :: * -> *).
(MonadFix m, MonadIO m, MonadMask m) =>
Maybe ModuleName -> [ExternsFile] -> [Ident] -> Env m -> m ()
REPL.defaultMain Maybe ModuleName
forall a. Maybe a
Nothing [ExternsFile]
externs [Ident]
additionalNames Env m
withEnvAtError
        InterpretError m
_ -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Right{} -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

type Interpret = InterpretT Identity

runInterpret :: Interpret a -> Either (InterpretError Identity) a
runInterpret :: Interpret a -> Either (InterpretError Identity) a
runInterpret = Identity (Either (InterpretError Identity) a)
-> Either (InterpretError Identity) a
forall a. Identity a -> a
runIdentity (Identity (Either (InterpretError Identity) a)
 -> Either (InterpretError Identity) a)
-> (Interpret a -> Identity (Either (InterpretError Identity) a))
-> Interpret a
-> Either (InterpretError Identity) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Interpret a -> Identity (Either (InterpretError Identity) a)
forall (m :: * -> *) a.
Monad m =>
InterpretT m a -> m (Either (InterpretError m) a)
runInterpretT

-- | A convenience function for running 'EvalT' computations in 'InterpretT',
-- reporting errors via 'InterpretError'.
liftEvalT :: Monad m => EvalT m a -> InterpretT m a
liftEvalT :: EvalT m a -> InterpretT m a
liftEvalT = (InterpretT m (Either (EvaluationError m) a)
-> (Either (EvaluationError m) a -> InterpretT m a)
-> InterpretT m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (EvaluationError m -> InterpretT m a)
-> (a -> InterpretT m a)
-> Either (EvaluationError m) a
-> InterpretT m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (InterpretError m -> InterpretT m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (InterpretError m -> InterpretT m a)
-> (EvaluationError m -> InterpretError m)
-> EvaluationError m
-> InterpretT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvaluationError m -> InterpretError m
forall (m :: * -> *). EvaluationError m -> InterpretError m
ErrorDuringEvaluation) a -> InterpretT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (InterpretT m (Either (EvaluationError m) a) -> InterpretT m a)
-> (EvalT m a -> InterpretT m (Either (EvaluationError m) a))
-> EvalT m a
-> InterpretT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Either (EvaluationError m) a)
-> InterpretT m (Either (EvaluationError m) a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either (EvaluationError m) a)
 -> InterpretT m (Either (EvaluationError m) a))
-> (EvalT m a -> m (Either (EvaluationError m) a))
-> EvalT m a
-> InterpretT m (Either (EvaluationError m) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalT m a -> m (Either (EvaluationError m) a)
forall (m :: * -> *) a.
EvalT m a -> m (Either (EvaluationError m) a)
runEvalT

-- | Make an 'FFI' module available for use to subsequent operations.
--
-- For example, to make the 'Dovetail.Prelude.prelude' available:
--
-- @
-- ffi 'Dovetail.Prelude.prelude'
-- @
ffi :: Monad m => FFI m -> InterpretT m ()
ffi :: FFI m -> InterpretT m ()
ffi FFI m
f = ExceptT (InterpretError m) (StateT ([ExternsFile], Env m) m) ()
-> InterpretT m ()
forall (m :: * -> *) a.
ExceptT (InterpretError m) (StateT ([ExternsFile], Env m) m) a
-> InterpretT m a
InterpretT (ExceptT (InterpretError m) (StateT ([ExternsFile], Env m) m) ()
 -> InterpretT m ())
-> (StateT ([ExternsFile], Env m) m ()
    -> ExceptT (InterpretError m) (StateT ([ExternsFile], Env m) m) ())
-> StateT ([ExternsFile], Env m) m ()
-> InterpretT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT ([ExternsFile], Env m) m ()
-> ExceptT (InterpretError m) (StateT ([ExternsFile], Env m) m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT ([ExternsFile], Env m) m () -> InterpretT m ())
-> StateT ([ExternsFile], Env m) m () -> InterpretT m ()
forall a b. (a -> b) -> a -> b
$ (([ExternsFile], Env m) -> ([ExternsFile], Env m))
-> StateT ([ExternsFile], Env m) m ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify \([ExternsFile]
externs, Env m
env) -> 
  ( FFI m -> ExternsFile
forall (m :: * -> *). FFI m -> ExternsFile
FFI.toExterns FFI m
f ExternsFile -> [ExternsFile] -> [ExternsFile]
forall a. a -> [a] -> [a]
: [ExternsFile]
externs
  , Env m
env Env m -> Env m -> Env m
forall a. Semigroup a => a -> a -> a
<> FFI m -> Env m
forall (m :: * -> *). FFI m -> Env m
FFI.toEnv FFI m
f
  )

-- | The type of errors that can occur in the 'InterpretT' monad.
data InterpretError m
  = ErrorDuringEvaluation (Evaluate.EvaluationError m)
  -- ^ Evaluation errors can occur during the initial evaluation of the module
  -- when it is loaded into the environment.
  | ErrorDuringBuild Build.BuildError
  -- ^ Build errors can occur if we are building modules from source or corefn.

renderInterpretError :: RenderValueOptions -> InterpretError m -> String
renderInterpretError :: RenderValueOptions -> InterpretError m -> String
renderInterpretError RenderValueOptions
_ (ErrorDuringBuild BuildError
err) =
  String
"Build error: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> BuildError -> String
Build.renderBuildError BuildError
err
renderInterpretError RenderValueOptions
opts (ErrorDuringEvaluation EvaluationError m
err) =
  String
"Evaluation error: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> RenderValueOptions -> EvaluationError m -> String
forall (m :: * -> *).
RenderValueOptions -> EvaluationError m -> String
Evaluate.renderEvaluationError RenderValueOptions
opts EvaluationError m
err

liftWith :: Monad m => (e -> InterpretError m) -> m (Either e a) -> InterpretT m a
liftWith :: (e -> InterpretError m) -> m (Either e a) -> InterpretT m a
liftWith e -> InterpretError m
f m (Either e a)
ma = ExceptT (InterpretError m) (StateT ([ExternsFile], Env m) m) a
-> InterpretT m a
forall (m :: * -> *) a.
ExceptT (InterpretError m) (StateT ([ExternsFile], Env m) m) a
-> InterpretT m a
InterpretT (ExceptT (InterpretError m) (StateT ([ExternsFile], Env m) m) a
 -> InterpretT m a)
-> (m (Either (InterpretError m) a)
    -> ExceptT (InterpretError m) (StateT ([ExternsFile], Env m) m) a)
-> m (Either (InterpretError m) a)
-> InterpretT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT ([ExternsFile], Env m) m (Either (InterpretError m) a)
-> ExceptT (InterpretError m) (StateT ([ExternsFile], Env m) m) a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (StateT ([ExternsFile], Env m) m (Either (InterpretError m) a)
 -> ExceptT (InterpretError m) (StateT ([ExternsFile], Env m) m) a)
-> (m (Either (InterpretError m) a)
    -> StateT ([ExternsFile], Env m) m (Either (InterpretError m) a))
-> m (Either (InterpretError m) a)
-> ExceptT (InterpretError m) (StateT ([ExternsFile], Env m) m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Either (InterpretError m) a)
-> StateT ([ExternsFile], Env m) m (Either (InterpretError m) a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either (InterpretError m) a) -> InterpretT m a)
-> m (Either (InterpretError m) a) -> InterpretT m a
forall a b. (a -> b) -> a -> b
$ (Either e a -> Either (InterpretError m) a)
-> m (Either e a) -> m (Either (InterpretError m) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((e -> InterpretError m)
-> Either e a -> Either (InterpretError m) a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first e -> InterpretError m
f) m (Either e a)
ma

-- | Build a PureScript module from source, and make its exported functions available
-- during subsequent evaluations.
build :: MonadFix m => Text -> InterpretT m (CoreFn.Module CoreFn.Ann)
build :: Text -> InterpretT m (Module Ann)
build Text
moduleText = do
  ([ExternsFile]
externs, Env m
_) <- ExceptT
  (InterpretError m)
  (StateT ([ExternsFile], Env m) m)
  ([ExternsFile], Env m)
-> InterpretT m ([ExternsFile], Env m)
forall (m :: * -> *) a.
ExceptT (InterpretError m) (StateT ([ExternsFile], Env m) m) a
-> InterpretT m a
InterpretT (StateT ([ExternsFile], Env m) m ([ExternsFile], Env m)
-> ExceptT
     (InterpretError m)
     (StateT ([ExternsFile], Env m) m)
     ([ExternsFile], Env m)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT ([ExternsFile], Env m) m ([ExternsFile], Env m)
forall (m :: * -> *) s. Monad m => StateT s m s
get)
  (Module Ann
m, ExternsFile
newExterns) <- (BuildError -> InterpretError m)
-> m (Either BuildError (Module Ann, ExternsFile))
-> InterpretT m (Module Ann, ExternsFile)
forall (m :: * -> *) e a.
Monad m =>
(e -> InterpretError m) -> m (Either e a) -> InterpretT m a
liftWith BuildError -> InterpretError m
forall (m :: * -> *). BuildError -> InterpretError m
ErrorDuringBuild (m (Either BuildError (Module Ann, ExternsFile))
 -> InterpretT m (Module Ann, ExternsFile))
-> m (Either BuildError (Module Ann, ExternsFile))
-> InterpretT m (Module Ann, ExternsFile)
forall a b. (a -> b) -> a -> b
$ Either BuildError (Module Ann, ExternsFile)
-> m (Either BuildError (Module Ann, ExternsFile))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either BuildError (Module Ann, ExternsFile)
 -> m (Either BuildError (Module Ann, ExternsFile)))
-> Either BuildError (Module Ann, ExternsFile)
-> m (Either BuildError (Module Ann, ExternsFile))
forall a b. (a -> b) -> a -> b
$ [ExternsFile]
-> Text -> Either BuildError (Module Ann, ExternsFile)
Build.buildSingleModule [ExternsFile]
externs Text
moduleText
  ExternsFile -> Module Ann -> InterpretT m (Module Ann)
forall (m :: * -> *).
MonadFix m =>
ExternsFile -> Module Ann -> InterpretT m (Module Ann)
buildCoreFn ExternsFile
newExterns Module Ann
m

-- | Build a PureScript module from corefn, and make its exported functions available
-- during subsequent evaluations.
--
-- The corefn module may be preprepared, for example by compiling from source text using the
-- functions in the "Dovetail.Build" module.
buildCoreFn :: MonadFix m => P.ExternsFile -> CoreFn.Module CoreFn.Ann -> InterpretT m (CoreFn.Module CoreFn.Ann)
buildCoreFn :: ExternsFile -> Module Ann -> InterpretT m (Module Ann)
buildCoreFn ExternsFile
newExterns Module Ann
m = do
  ([ExternsFile]
externs, Env m
env) <- ExceptT
  (InterpretError m)
  (StateT ([ExternsFile], Env m) m)
  ([ExternsFile], Env m)
-> InterpretT m ([ExternsFile], Env m)
forall (m :: * -> *) a.
ExceptT (InterpretError m) (StateT ([ExternsFile], Env m) m) a
-> InterpretT m a
InterpretT (StateT ([ExternsFile], Env m) m ([ExternsFile], Env m)
-> ExceptT
     (InterpretError m)
     (StateT ([ExternsFile], Env m) m)
     ([ExternsFile], Env m)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT ([ExternsFile], Env m) m ([ExternsFile], Env m)
forall (m :: * -> *) s. Monad m => StateT s m s
get)
  Env m
newEnv <- (EvaluationError m -> InterpretError m)
-> m (Either (EvaluationError m) (Env m)) -> InterpretT m (Env m)
forall (m :: * -> *) e a.
Monad m =>
(e -> InterpretError m) -> m (Either e a) -> InterpretT m a
liftWith EvaluationError m -> InterpretError m
forall (m :: * -> *). EvaluationError m -> InterpretError m
ErrorDuringEvaluation (EvalT m (Env m) -> m (Either (EvaluationError m) (Env m))
forall (m :: * -> *) a.
EvalT m a -> m (Either (EvaluationError m) a)
Evaluate.runEvalT (Env m -> Module Ann -> EvalT m (Env m)
forall (m :: * -> *).
MonadFix m =>
Env m -> Module Ann -> EvalT m (Env m)
Evaluate.buildCoreFn Env m
env Module Ann
m))
  ExceptT (InterpretError m) (StateT ([ExternsFile], Env m) m) ()
-> InterpretT m ()
forall (m :: * -> *) a.
ExceptT (InterpretError m) (StateT ([ExternsFile], Env m) m) a
-> InterpretT m a
InterpretT (ExceptT (InterpretError m) (StateT ([ExternsFile], Env m) m) ()
 -> InterpretT m ())
-> (StateT ([ExternsFile], Env m) m ()
    -> ExceptT (InterpretError m) (StateT ([ExternsFile], Env m) m) ())
-> StateT ([ExternsFile], Env m) m ()
-> InterpretT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT ([ExternsFile], Env m) m ()
-> ExceptT (InterpretError m) (StateT ([ExternsFile], Env m) m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT ([ExternsFile], Env m) m () -> InterpretT m ())
-> StateT ([ExternsFile], Env m) m () -> InterpretT m ()
forall a b. (a -> b) -> a -> b
$ ([ExternsFile], Env m) -> StateT ([ExternsFile], Env m) m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put ([ExternsFile]
externs [ExternsFile] -> [ExternsFile] -> [ExternsFile]
forall a. Semigroup a => a -> a -> a
<> [ExternsFile
newExterns], Env m
newEnv)
  Module Ann -> InterpretT m (Module Ann)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Module Ann
m

-- | Evaluate a PureScript expression from source
eval
  :: (MonadFix m, ToValueRHS m a)
  => Maybe P.ModuleName
  -- ^ The name of the "default module" whose exports will be made available unqualified
  -- to the evaluated expression.
  -> Text
  -> InterpretT m (a, P.SourceType)
eval :: Maybe ModuleName -> Text -> InterpretT m (a, SourceType)
eval Maybe ModuleName
defaultModule Text
exprText = do
  ([ExternsFile]
externs, Env m
env) <- ExceptT
  (InterpretError m)
  (StateT ([ExternsFile], Env m) m)
  ([ExternsFile], Env m)
-> InterpretT m ([ExternsFile], Env m)
forall (m :: * -> *) a.
ExceptT (InterpretError m) (StateT ([ExternsFile], Env m) m) a
-> InterpretT m a
InterpretT (StateT ([ExternsFile], Env m) m ([ExternsFile], Env m)
-> ExceptT
     (InterpretError m)
     (StateT ([ExternsFile], Env m) m)
     ([ExternsFile], Env m)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT ([ExternsFile], Env m) m ([ExternsFile], Env m)
forall (m :: * -> *) s. Monad m => StateT s m s
get)
  (Expr Ann
expr, SourceType
ty) <- (BuildError -> InterpretError m)
-> m (Either BuildError (Expr Ann, SourceType))
-> InterpretT m (Expr Ann, SourceType)
forall (m :: * -> *) e a.
Monad m =>
(e -> InterpretError m) -> m (Either e a) -> InterpretT m a
liftWith BuildError -> InterpretError m
forall (m :: * -> *). BuildError -> InterpretError m
ErrorDuringBuild (m (Either BuildError (Expr Ann, SourceType))
 -> InterpretT m (Expr Ann, SourceType))
-> m (Either BuildError (Expr Ann, SourceType))
-> InterpretT m (Expr Ann, SourceType)
forall a b. (a -> b) -> a -> b
$ Either BuildError (Expr Ann, SourceType)
-> m (Either BuildError (Expr Ann, SourceType))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either BuildError (Expr Ann, SourceType)
 -> m (Either BuildError (Expr Ann, SourceType)))
-> Either BuildError (Expr Ann, SourceType)
-> m (Either BuildError (Expr Ann, SourceType))
forall a b. (a -> b) -> a -> b
$ Maybe ModuleName
-> [ExternsFile]
-> Text
-> Either BuildError (Expr Ann, SourceType)
Build.buildSingleExpression Maybe ModuleName
defaultModule [ExternsFile]
externs Text
exprText
  (a, SourceType) -> InterpretT m (a, SourceType)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EvalT m (Value m) -> a
forall (m :: * -> *) a. ToValueRHS m a => EvalT m (Value m) -> a
Evaluate.fromValueRHS (Env m -> Expr Ann -> EvalT m (Value m)
forall (m :: * -> *).
MonadFix m =>
Env m -> Expr Ann -> EvalT m (Value m)
Evaluate.eval Env m
env Expr Ann
expr), SourceType
ty)

-- | Evaluate a PureScript corefn expression and return the result.
-- Note: The expression is not type-checked by the PureScript typechecker. 
-- See the documentation for 'ToValueRHS' for valid result types.
evalCoreFn :: (MonadFix m, ToValueRHS m a) => CoreFn.Expr CoreFn.Ann -> InterpretT m a
evalCoreFn :: Expr Ann -> InterpretT m a
evalCoreFn Expr Ann
expr = do
  ([ExternsFile]
_externs, Env m
env) <- ExceptT
  (InterpretError m)
  (StateT ([ExternsFile], Env m) m)
  ([ExternsFile], Env m)
-> InterpretT m ([ExternsFile], Env m)
forall (m :: * -> *) a.
ExceptT (InterpretError m) (StateT ([ExternsFile], Env m) m) a
-> InterpretT m a
InterpretT (StateT ([ExternsFile], Env m) m ([ExternsFile], Env m)
-> ExceptT
     (InterpretError m)
     (StateT ([ExternsFile], Env m) m)
     ([ExternsFile], Env m)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT ([ExternsFile], Env m) m ([ExternsFile], Env m)
forall (m :: * -> *) s. Monad m => StateT s m s
get)
  a -> InterpretT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> InterpretT m a)
-> (EvalT m (Value m) -> a) -> EvalT m (Value m) -> InterpretT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalT m (Value m) -> a
forall (m :: * -> *) a. ToValueRHS m a => EvalT m (Value m) -> a
Evaluate.fromValueRHS (EvalT m (Value m) -> InterpretT m a)
-> EvalT m (Value m) -> InterpretT m a
forall a b. (a -> b) -> a -> b
$ Env m -> Expr Ann -> EvalT m (Value m)
forall (m :: * -> *).
MonadFix m =>
Env m -> Expr Ann -> EvalT m (Value m)
Evaluate.eval Env m
env Expr Ann
expr

-- | Evaluate @main@ in the specified module and return the result.
evalMain :: (MonadFix m, ToValueRHS m a) => P.ModuleName -> InterpretT m a
evalMain :: ModuleName -> InterpretT m a
evalMain ModuleName
moduleName = Expr Ann -> InterpretT m a
forall (m :: * -> *) a.
(MonadFix m, ToValueRHS m a) =>
Expr Ann -> InterpretT m a
evalCoreFn (Ann -> Qualified Ident -> Expr Ann
forall a. a -> Qualified Ident -> Expr a
CoreFn.Var (SourceSpan -> Ann
CoreFn.ssAnn SourceSpan
P.nullSourceSpan) (Maybe ModuleName -> Ident -> Qualified Ident
forall a. Maybe ModuleName -> a -> Qualified a
P.Qualified (ModuleName -> Maybe ModuleName
forall a. a -> Maybe a
Just ModuleName
moduleName) (Text -> Ident
P.Ident Text
"main")))

-- | Start an interactive debugger (REPL) session.
repl 
  :: (MonadFix m, MonadIO m, MonadMask m) 
  => Maybe P.ModuleName 
  -- ^ The default module, whose members will be available unqualified in scope
  -> InterpretT m ()
repl :: Maybe ModuleName -> InterpretT m ()
repl Maybe ModuleName
defaultModule = do
  ([ExternsFile]
externs, Env m
env) <- ExceptT
  (InterpretError m)
  (StateT ([ExternsFile], Env m) m)
  ([ExternsFile], Env m)
-> InterpretT m ([ExternsFile], Env m)
forall (m :: * -> *) a.
ExceptT (InterpretError m) (StateT ([ExternsFile], Env m) m) a
-> InterpretT m a
InterpretT (StateT ([ExternsFile], Env m) m ([ExternsFile], Env m)
-> ExceptT
     (InterpretError m)
     (StateT ([ExternsFile], Env m) m)
     ([ExternsFile], Env m)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT ([ExternsFile], Env m) m ([ExternsFile], Env m)
forall (m :: * -> *) s. Monad m => StateT s m s
get)
  m () -> InterpretT m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> InterpretT m ()) -> m () -> InterpretT m ()
forall a b. (a -> b) -> a -> b
$ Maybe ModuleName -> [ExternsFile] -> [Ident] -> Env m -> m ()
forall (m :: * -> *).
(MonadFix m, MonadIO m, MonadMask m) =>
Maybe ModuleName -> [ExternsFile] -> [Ident] -> Env m -> m ()
REPL.defaultMain Maybe ModuleName
defaultModule [ExternsFile]
externs [] Env m
env