{-# LANGUAGE BlockArguments        #-}
{-# LANGUAGE ImportQualifiedPost   #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE ScopedTypeVariables   #-}

module Dovetail.REPL (defaultMain) where

import Control.Monad.Catch (MonadMask)
import Control.Monad.Fix (MonadFix)
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Trans.Class (lift)
import Data.Map qualified as Map
import Data.Text qualified as Text
import Dovetail.Build qualified as Build
import Dovetail.Evaluate qualified as Evaluate
import Dovetail.Types
import Language.PureScript qualified as P
import Language.PureScript.AST.Binders qualified as AST
import Language.PureScript.AST.Declarations qualified as AST
import Language.PureScript.CoreFn qualified as CoreFn
import System.Console.Haskeline

renderOptions :: RenderValueOptions
renderOptions :: RenderValueOptions
renderOptions = RenderValueOptions :: Bool -> Maybe Int -> RenderValueOptions
RenderValueOptions
  { colorOutput :: Bool
colorOutput = Bool
True
  , maximumDepth :: Maybe Int
maximumDepth = Maybe Int
forall a. Maybe a
Nothing
  }

-- | Starts a minimal interactive debugger (REPL) session. 
--
-- It is more likely that you will want to use the 'Dovetail.repl' function to
-- start a REPL session from within an 'Dovetail.InterpretT' block.
defaultMain 
  :: forall m
   . (MonadFix m, MonadIO m, MonadMask m)
  => Maybe P.ModuleName
  -- ^ The default module, whose members will be available unqualified in scope.
  -> [P.ExternsFile]
  -- ^ Any externs files to load
  -> [P.Ident]
  -- ^ Any additional identifiers which are available in the environment, but not
  -- given types in the externs file. These will be made available without type
  -- information, for debugging purposes.
  -> Env m
  -- ^ The evaluation environment
  -> m ()
defaultMain :: Maybe ModuleName -> [ExternsFile] -> [Ident] -> Env m -> m ()
defaultMain Maybe ModuleName
defaultModule [ExternsFile]
externs [Ident]
additionalIdentsInScope Env m
env = Settings m -> InputT m () -> m ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Settings m -> InputT m a -> m a
runInputT Settings m
settings InputT m ()
loop where
  loop :: InputT m ()
  loop :: InputT m ()
loop = do
    Maybe String
minput <- String -> InputT m (Maybe String)
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> InputT m (Maybe String)
getInputLine String
"> "
    case Maybe String
minput of
      Maybe String
Nothing -> () -> InputT m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just String
input -> do
        case (Expr -> Expr)
-> Maybe ModuleName
-> [ExternsFile]
-> Text
-> Either BuildError (Expr Ann, SourceType)
Build.buildSingleExpressionWith Expr -> Expr
abstractAdditionalInputs Maybe ModuleName
defaultModule [ExternsFile]
externs (String -> Text
Text.pack String
input) of
          Right (Expr Ann
expr, SourceType
_) -> do
            let appliedExpr :: Expr Ann
appliedExpr = Expr Ann -> Expr Ann
applyAdditionalInputs Expr Ann
expr
            Either (EvaluationError m) (Value m)
mresult <- m (Either (EvaluationError m) (Value m))
-> InputT m (Either (EvaluationError m) (Value m))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either (EvaluationError m) (Value m))
 -> InputT m (Either (EvaluationError m) (Value m)))
-> (EvalT m (Value m) -> m (Either (EvaluationError m) (Value m)))
-> EvalT m (Value m)
-> InputT m (Either (EvaluationError m) (Value m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalT m (Value m) -> m (Either (EvaluationError m) (Value m))
forall (m :: * -> *) a.
EvalT m a -> m (Either (EvaluationError m) a)
runEvalT (EvalT m (Value m)
 -> InputT m (Either (EvaluationError m) (Value m)))
-> EvalT m (Value m)
-> InputT m (Either (EvaluationError m) (Value m))
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
appliedExpr
            case Either (EvaluationError m) (Value m)
mresult of
              Right Value m
result ->
                String -> InputT m ()
forall (m :: * -> *). MonadIO m => String -> InputT m ()
outputStrLn (String -> InputT m ()) -> (Text -> String) -> Text -> InputT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack (Text -> InputT m ()) -> Text -> InputT m ()
forall a b. (a -> b) -> a -> b
$ RenderValueOptions -> Value m -> Text
forall (m :: * -> *). RenderValueOptions -> Value m -> Text
renderValue RenderValueOptions
renderOptions Value m
result
              Left EvaluationError m
err ->
                String -> InputT m ()
forall (m :: * -> *). MonadIO m => String -> InputT m ()
outputStrLn (String -> InputT m ()) -> String -> InputT m ()
forall a b. (a -> b) -> a -> b
$ RenderValueOptions -> EvaluationError m -> String
forall (m :: * -> *).
RenderValueOptions -> EvaluationError m -> String
renderEvaluationError RenderValueOptions
renderOptions EvaluationError m
err
          Left BuildError
err ->
            String -> InputT m ()
forall (m :: * -> *). MonadIO m => String -> InputT m ()
outputStrLn (String -> InputT m ()) -> String -> InputT m ()
forall a b. (a -> b) -> a -> b
$ BuildError -> String
Build.renderBuildError BuildError
err
        InputT m ()
loop
        
  -- Since we might have additional identifiers in scope which are not defined
  -- in the externs files (for example, if we stopped at an error), we need to
  -- introduce those names into scope another way, without running afoul of the
  -- typechecker. We do this by binding them to the arguments of a temporary
  -- function, typechecking _that_ function, and applying it in the evaluator
  -- after type checking is complete.
  abstractAdditionalInputs :: Expr -> Expr
abstractAdditionalInputs Expr
expr =
    (Expr -> Ident -> Expr) -> Expr -> [Ident] -> Expr
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Expr
e Ident
name -> 
      Binder -> Expr -> Expr
AST.Abs (SourceSpan -> Ident -> Binder
AST.VarBinder SourceSpan
P.nullSourceSpan Ident
name) Expr
e)
      Expr
expr 
      [Ident]
additionalIdentsInScope
  
  applyAdditionalInputs :: Expr Ann -> Expr Ann
applyAdditionalInputs Expr Ann
expr =
    (Expr Ann -> Ident -> Expr Ann) -> Expr Ann -> [Ident] -> Expr Ann
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Expr Ann
e Ident
name -> 
      Ann -> Expr Ann -> Expr Ann -> Expr Ann
forall a. a -> Expr a -> Expr a -> Expr a
CoreFn.App (SourceSpan -> Ann
CoreFn.ssAnn SourceSpan
P.nullSourceSpan) Expr Ann
e 
       (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 Maybe ModuleName
forall a. Maybe a
Nothing Ident
name))) 
      Expr Ann
expr 
      [Ident]
additionalIdentsInScope
        
  settings :: Settings m
settings = CompletionFunc m -> Settings m -> Settings m
forall (m :: * -> *). CompletionFunc m -> Settings m -> Settings m
setComplete CompletionFunc m
completionFunc Settings m
forall (m :: * -> *). MonadIO m => Settings m
defaultSettings
  
  completionFunc :: CompletionFunc m
completionFunc = Maybe Char
-> String -> (String -> m [Completion]) -> CompletionFunc m
forall (m :: * -> *).
Monad m =>
Maybe Char
-> String -> (String -> m [Completion]) -> CompletionFunc m
completeWord Maybe Char
forall a. Maybe a
Nothing String
" \t" \String
s ->
    [Completion] -> m [Completion]
forall (f :: * -> *) a. Applicative f => a -> f a
pure 
      [ String -> Completion
simpleCompletion (Text -> String
Text.unpack Text
ident)
      | Text
ident <- [Text]
allCompletions
      , Text -> Text -> Bool
Text.isPrefixOf (String -> Text
Text.pack String
s) Text
ident
      ]
    
  allCompletions :: [Text]
allCompletions = (Qualified Ident -> Text) -> [Qualified Ident] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Ident -> Text) -> Qualified Ident -> Text
forall a. (a -> Text) -> Qualified a -> Text
P.showQualified Ident -> Text
P.showIdent) (Env m -> [Qualified Ident]
forall k a. Map k a -> [k]
Map.keys Env m
env)