module Unison.Codebase.Editor.HandleInput.RuntimeUtils
  ( evalUnisonTerm,
    evalUnisonTermE,
    evalPureUnison,
    displayDecompileErrors,
    selectRuntime,
    EvalMode (..),
  )
where

import Control.Lens
import Control.Monad.Reader (ask)
import Unison.ABT qualified as ABT
import Unison.Cli.Monad (Cli)
import Unison.Cli.Monad qualified as Cli
import Unison.Codebase qualified as Codebase
import Unison.Codebase.Editor.Output
import Unison.Codebase.Execute qualified as Codebase
import Unison.Codebase.Runtime qualified as Runtime
import Unison.Hashing.V2.Convert qualified as Hashing
import Unison.Parser.Ann (Ann (..))
import Unison.Parser.Ann qualified as Ann
import Unison.Prelude
import Unison.PrettyPrintEnv qualified as PPE
import Unison.Reference qualified as Reference
import Unison.Referent qualified as Referent
import Unison.Symbol (Symbol)
import Unison.Term (Term)
import Unison.Term qualified as Term
import Unison.Util.Pretty qualified as P
import Unison.WatchKind qualified as WK

data EvalMode = Sandboxed | Permissive | Native

selectRuntime :: EvalMode -> Cli (Runtime.Runtime Symbol)
selectRuntime :: EvalMode -> Cli (Runtime Symbol)
selectRuntime EvalMode
mode =
  Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask Cli Env -> (Env -> Runtime Symbol) -> Cli (Runtime Symbol)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Cli.Env {Runtime Symbol
runtime :: Runtime Symbol
$sel:runtime:Env :: Env -> Runtime Symbol
runtime, Runtime Symbol
sandboxedRuntime :: Runtime Symbol
$sel:sandboxedRuntime:Env :: Env -> Runtime Symbol
sandboxedRuntime, Runtime Symbol
nativeRuntime :: Runtime Symbol
$sel:nativeRuntime:Env :: Env -> Runtime Symbol
nativeRuntime} -> case EvalMode
mode of
    EvalMode
Permissive -> Runtime Symbol
runtime
    EvalMode
Sandboxed -> Runtime Symbol
sandboxedRuntime
    EvalMode
Native -> Runtime Symbol
nativeRuntime

displayDecompileErrors :: [Runtime.Error] -> Cli ()
displayDecompileErrors :: [Pretty ColorText] -> Cli ()
displayDecompileErrors [Pretty ColorText]
errs = Output -> Cli ()
Cli.respond (Pretty ColorText -> Output
PrintMessage Pretty ColorText
msg)
  where
    msg :: Pretty ColorText
msg =
      [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ([Pretty ColorText] -> Pretty ColorText)
-> [Pretty ColorText] -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
        [ Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.warnCallout Pretty ColorText
"I had trouble decompiling some results.",
          Pretty ColorText
"",
          Pretty ColorText
"The following errors were encountered:"
        ]
          [Pretty ColorText] -> [Pretty ColorText] -> [Pretty ColorText]
forall a. [a] -> [a] -> [a]
++ (Pretty ColorText -> Pretty ColorText)
-> [Pretty ColorText] -> [Pretty ColorText]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Width -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2) [Pretty ColorText]
errs

-- | Evaluate a single closed definition.
evalUnisonTermE ::
  EvalMode ->
  PPE.PrettyPrintEnv ->
  Bool ->
  Term Symbol Ann ->
  Cli (Either Runtime.Error (Term Symbol Ann))
evalUnisonTermE :: EvalMode
-> PrettyPrintEnv
-> Bool
-> Term Symbol Ann
-> Cli (Either (Pretty ColorText) (Term Symbol Ann))
evalUnisonTermE EvalMode
mode PrettyPrintEnv
ppe Bool
useCache Term Symbol Ann
tm = do
  Cli.Env {Codebase IO Symbol Ann
codebase :: Codebase IO Symbol Ann
$sel:codebase:Env :: Env -> Codebase IO Symbol Ann
codebase} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  Runtime Symbol
theRuntime <- EvalMode -> Cli (Runtime Symbol)
selectRuntime EvalMode
mode

  let watchCache :: Reference.Id -> IO (Maybe (Term Symbol ()))
      watchCache :: Id -> IO (Maybe (Term Symbol ()))
watchCache Id
ref = do
        Maybe (Term Symbol Ann)
maybeTerm <- Codebase IO Symbol Ann
-> Transaction (Maybe (Term Symbol Ann))
-> IO (Maybe (Term Symbol Ann))
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase IO Symbol Ann
codebase (Codebase IO Symbol Ann
-> Id -> Transaction (Maybe (Term Symbol Ann))
forall (m :: * -> *) v a.
Codebase m v a -> Id -> Transaction (Maybe (Term v a))
Codebase.lookupWatchCache Codebase IO Symbol Ann
codebase Id
ref)
        pure ((Ann -> ()) -> Term Symbol Ann -> Term Symbol ()
forall v a a2. Ord v => (a -> a2) -> Term v a -> Term v a2
Term.amap (\(Ann
_ :: Ann) -> ()) (Term Symbol Ann -> Term Symbol ())
-> Maybe (Term Symbol Ann) -> Maybe (Term Symbol ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Term Symbol Ann)
maybeTerm)

  let cache :: Id -> IO (Maybe (Term Symbol ()))
cache = if Bool
useCache then Id -> IO (Maybe (Term Symbol ()))
watchCache else Id -> IO (Maybe (Term Symbol ()))
forall v. Id -> IO (Maybe (Term v))
Runtime.noCache
  Either (Pretty ColorText) ([Pretty ColorText], Term Symbol ())
r <- IO (Either (Pretty ColorText) ([Pretty ColorText], Term Symbol ()))
-> Cli
     (Either (Pretty ColorText) ([Pretty ColorText], Term Symbol ()))
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (CodeLookup Symbol IO Ann
-> (Id -> IO (Maybe (Term Symbol ())))
-> PrettyPrintEnv
-> Runtime Symbol
-> Term Symbol Ann
-> IO
     (Either (Pretty ColorText) ([Pretty ColorText], Term Symbol ()))
forall v a.
(Var v, Monoid a) =>
CodeLookup v IO a
-> (Id -> IO (Maybe (Term v)))
-> PrettyPrintEnv
-> Runtime v
-> Term v a
-> IO (Either (Pretty ColorText) ([Pretty ColorText], Term v))
Runtime.evaluateTerm' (Codebase IO Symbol Ann -> CodeLookup Symbol IO Ann
forall (m :: * -> *).
MonadIO m =>
Codebase m Symbol Ann -> CodeLookup Symbol m Ann
Codebase.codebaseToCodeLookup Codebase IO Symbol Ann
codebase) Id -> IO (Maybe (Term Symbol ()))
cache PrettyPrintEnv
ppe Runtime Symbol
theRuntime Term Symbol Ann
tm)
  Bool -> Cli () -> Cli ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
useCache do
    case Either (Pretty ColorText) ([Pretty ColorText], Term Symbol ())
r of
      Right ([Pretty ColorText]
errs, Term Symbol ()
tmr)
        -- don't cache when there were errors
        | [Pretty ColorText] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Pretty ColorText]
errs ->
            Transaction () -> Cli ()
forall a. Transaction a -> Cli a
Cli.runTransaction do
              WatchKind -> Id -> Term Symbol Ann -> Transaction ()
Codebase.putWatch
                WatchKind
forall a. (Eq a, IsString a) => a
WK.RegularWatch
                (Term Symbol Ann -> Id
forall v a. Var v => Term v a -> Id
Hashing.hashClosedTerm Term Symbol Ann
tm)
                ((() -> Ann) -> Term Symbol () -> Term Symbol Ann
forall v a a2. Ord v => (a -> a2) -> Term v a -> Term v a2
Term.amap (Ann -> () -> Ann
forall a b. a -> b -> a
const Ann
Ann.External) Term Symbol ()
tmr)
        | Bool
otherwise -> [Pretty ColorText] -> Cli ()
displayDecompileErrors [Pretty ColorText]
errs
      Left Pretty ColorText
_ -> () -> Cli ()
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  pure $ Either (Pretty ColorText) ([Pretty ColorText], Term Symbol ())
r Either (Pretty ColorText) ([Pretty ColorText], Term Symbol ())
-> (([Pretty ColorText], Term Symbol ()) -> Term Symbol Ann)
-> Either (Pretty ColorText) (Term Symbol Ann)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (() -> Ann) -> Term Symbol () -> Term Symbol Ann
forall v a a2. Ord v => (a -> a2) -> Term v a -> Term v a2
Term.amap (\() -> Ann
Ann.External) (Term Symbol () -> Term Symbol Ann)
-> (([Pretty ColorText], Term Symbol ()) -> Term Symbol ())
-> ([Pretty ColorText], Term Symbol ())
-> Term Symbol Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Pretty ColorText], Term Symbol ()) -> Term Symbol ()
forall a b. (a, b) -> b
snd

-- | Evaluate a single closed definition.
evalUnisonTerm ::
  EvalMode ->
  PPE.PrettyPrintEnv ->
  Bool ->
  Term Symbol Ann ->
  Cli (Term Symbol Ann)
evalUnisonTerm :: EvalMode
-> PrettyPrintEnv
-> Bool
-> Term Symbol Ann
-> Cli (Term Symbol Ann)
evalUnisonTerm EvalMode
mode PrettyPrintEnv
ppe Bool
useCache Term Symbol Ann
tm =
  EvalMode
-> PrettyPrintEnv
-> Bool
-> Term Symbol Ann
-> Cli (Either (Pretty ColorText) (Term Symbol Ann))
evalUnisonTermE EvalMode
mode PrettyPrintEnv
ppe Bool
useCache Term Symbol Ann
tm Cli (Either (Pretty ColorText) (Term Symbol Ann))
-> (Cli (Either (Pretty ColorText) (Term Symbol Ann))
    -> Cli (Term Symbol Ann))
-> Cli (Term Symbol Ann)
forall a b. a -> (a -> b) -> b
& (Pretty ColorText -> Cli (Term Symbol Ann))
-> Cli (Either (Pretty ColorText) (Term Symbol Ann))
-> Cli (Term Symbol Ann)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> m (Either a b) -> m b
onLeftM \Pretty ColorText
err ->
    Output -> Cli (Term Symbol Ann)
forall a. Output -> Cli a
Cli.returnEarly (Pretty ColorText -> Output
EvaluationFailure Pretty ColorText
err)

evalPureUnison ::
  Bool ->
  PPE.PrettyPrintEnv ->
  Bool ->
  Term Symbol Ann ->
  Cli (Either Runtime.Error (Term Symbol Ann))
evalPureUnison :: Bool
-> PrettyPrintEnv
-> Bool
-> Term Symbol Ann
-> Cli (Either (Pretty ColorText) (Term Symbol Ann))
evalPureUnison Bool
native PrettyPrintEnv
ppe Bool
useCache Term Symbol Ann
tm =
  EvalMode
-> PrettyPrintEnv
-> Bool
-> Term Symbol Ann
-> Cli (Either (Pretty ColorText) (Term Symbol Ann))
evalUnisonTermE EvalMode
mode PrettyPrintEnv
ppe Bool
useCache Term Symbol Ann
tm'
  where
    mode :: EvalMode
mode = if Bool
native then EvalMode
Native else EvalMode
Permissive
    tm' :: Term Symbol Ann
tm' =
      Ann
-> Term Symbol Ann
-> Term Symbol Ann
-> Term Symbol Ann
-> Term Symbol Ann
forall v a vt at ap.
Ord v =>
a
-> Term2 vt at ap v a
-> Term2 vt at ap v a
-> Term2 vt at ap v a
-> Term2 vt at ap v a
Term.iff
        Ann
a
        (Term Symbol Ann -> [Term Symbol Ann] -> Term Symbol Ann
forall v a vt at ap.
(Ord v, Semigroup a) =>
Term2 vt at ap v a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
Term.apps' (Ann -> Text -> Term Symbol Ann
forall v a vt at ap. Ord v => a -> Text -> Term2 vt at ap v a
Term.builtin Ann
a Text
"validateSandboxed") [Term Symbol Ann
allow, Ann -> Term Symbol Ann -> Term Symbol Ann
forall v a vt at ap.
Var v =>
a -> Term2 vt at ap v a -> Term2 vt at ap v a
Term.delay Ann
a Term Symbol Ann
tm])
        Term Symbol Ann
tm
        (Ann -> Term Symbol Ann -> Term Symbol Ann -> Term Symbol Ann
forall v a vt at ap.
Ord v =>
a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a
Term.app Ann
a (Ann -> Text -> Term Symbol Ann
forall v a vt at ap. Ord v => a -> Text -> Term2 vt at ap v a
Term.builtin Ann
a Text
"bug") (Ann -> Text -> Term Symbol Ann
forall v a vt at ap. Ord v => a -> Text -> Term2 vt at ap v a
Term.text Ann
a Text
msg))
    a :: Ann
a = Term Symbol Ann -> Ann
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term Symbol Ann
tm
    allow :: Term Symbol Ann
allow = Ann -> [Term Symbol Ann] -> Term Symbol Ann
forall v a vt at ap.
Ord v =>
a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
Term.list Ann
a [
        Ann -> Referent -> Term Symbol Ann
forall v a vt at ap. Ord v => a -> Referent -> Term2 vt at ap v a
Term.termLink Ann
a (TermReference -> Referent
Referent.Ref (Text -> TermReference
forall t h. t -> Reference' t h
Reference.Builtin Text
"Debug.toText"))
      , Ann -> Referent -> Term Symbol Ann
forall v a vt at ap. Ord v => a -> Referent -> Term2 vt at ap v a
Term.termLink Ann
a (TermReference -> Referent
Referent.Ref (Text -> TermReference
forall t h. t -> Reference' t h
Reference.Builtin Text
"Value.value"))
      ]
    msg :: Text
msg = Text
"pure code can't perform I/O"