module Unison.Codebase.Editor.HandleInput.RuntimeUtils
  ( evalUnisonTerm,
    evalUnisonTermE,
    evalPureUnison,
    displayDecompileErrors,
  )
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

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 ::
  Bool ->
  PPE.PrettyPrintEnv ->
  Bool ->
  Term Symbol Ann ->
  Cli (Either Runtime.Error (Term Symbol Ann))
evalUnisonTermE :: Bool
-> PrettyPrintEnv
-> Bool
-> Term Symbol Ann
-> Cli (Either (Pretty ColorText) (Term Symbol Ann))
evalUnisonTermE Bool
sandbox 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, Runtime Symbol
runtime :: Runtime Symbol
$sel:runtime:Env :: Env -> Runtime Symbol
runtime, Runtime Symbol
sandboxedRuntime :: Runtime Symbol
$sel:sandboxedRuntime:Env :: Env -> Runtime Symbol
sandboxedRuntime} <- Cli Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  let theRuntime :: Runtime Symbol
theRuntime = if Bool
sandbox then Runtime Symbol
sandboxedRuntime else Runtime Symbol
runtime

  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 ::
  Bool ->
  PPE.PrettyPrintEnv ->
  Bool ->
  Term Symbol Ann ->
  Cli (Term Symbol Ann)
evalUnisonTerm :: Bool
-> PrettyPrintEnv
-> Bool
-> Term Symbol Ann
-> Cli (Term Symbol Ann)
evalUnisonTerm Bool
sandbox PrettyPrintEnv
ppe Bool
useCache Term Symbol Ann
tm =
  Bool
-> PrettyPrintEnv
-> Bool
-> Term Symbol Ann
-> Cli (Either (Pretty ColorText) (Term Symbol Ann))
evalUnisonTermE Bool
sandbox 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 ::
  PPE.PrettyPrintEnv ->
  Bool ->
  Term Symbol Ann ->
  Cli (Either Runtime.Error (Term Symbol Ann))
evalPureUnison :: PrettyPrintEnv
-> Bool
-> Term Symbol Ann
-> Cli (Either (Pretty ColorText) (Term Symbol Ann))
evalPureUnison PrettyPrintEnv
ppe Bool
useCache Term Symbol Ann
tm = Bool
-> PrettyPrintEnv
-> Bool
-> Term Symbol Ann
-> Cli (Either (Pretty ColorText) (Term Symbol Ann))
evalUnisonTermE Bool
False PrettyPrintEnv
ppe Bool
useCache Term Symbol Ann
tm'
  where
    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"))]
    msg :: Text
msg = Text
"pure code can't perform I/O"