{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE RecursiveDo #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}

module Language.Jsonnet.Eval
  ( eval,
    evalClos,
    mergeWith,
    module Language.Jsonnet.Eval.Monad,
  )
where

import Control.Applicative
import Control.Monad.Except
import Control.Monad.Reader
import Control.Monad.State.Lazy
import Data.Aeson.Text
import Data.Bifunctor (second)
import Data.Bits
import Data.Foldable
import qualified Data.HashMap.Lazy as H
import Data.Int
import Data.List
import qualified Data.Map.Lazy as M
import Data.Maybe (catMaybes, isNothing)
import Data.Scientific (isInteger, toBoundedInteger)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Lazy (toStrict)
import Data.Vector (Vector, (!?))
import qualified Data.Vector as V
import Debug.Trace
import Language.Jsonnet.Common hiding (span)
import Language.Jsonnet.Core
import Language.Jsonnet.Error
import Language.Jsonnet.Eval.Monad
import Language.Jsonnet.Manifest
import Language.Jsonnet.Parser.SrcSpan
import Language.Jsonnet.Pretty ()
import qualified Language.Jsonnet.Std.Lib as Std
import Language.Jsonnet.Value
import Text.PrettyPrint.ANSI.Leijen (pretty)
import Unbound.Generics.LocallyNameless
import Unbound.Generics.LocallyNameless.Bind

-- an evaluator for the core calculus, based on a
-- big-step, call-by-need operational semantics, matching
-- jsonnet specificaton

eval :: Core -> Eval Value
eval :: Core -> Eval Value
eval = \case
  CLoc SrcSpan
sp Core
e -> do
    --traceShowM (spanBegin sp)
    Maybe SrcSpan -> Eval ()
updateSpan (SrcSpan -> Maybe SrcSpan
forall a. a -> Maybe a
Just SrcSpan
sp) Eval () -> Eval Value -> Eval Value
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Core -> Eval Value
eval Core
e
  CLit Literal
l -> Literal -> Eval Value
evalLiteral Literal
l
  CVar Name Core
n -> do
    Ctx
env <- (Env -> Ctx) -> Eval Ctx
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env -> Ctx
ctx
    --sp <- gets currentPos
    --traceShowM (spanBegin <$> sp)
    Thunk
v <- EvalError -> Maybe Thunk -> Eval Thunk
forall a. EvalError -> Maybe a -> Eval a
liftMaybe (Doc -> EvalError
VarNotFound (Name Core -> Doc
forall a. Pretty a => a -> Doc
pretty Name Core
n)) (Name Core -> Ctx -> Maybe Thunk
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name Core
n Ctx
env)
    Thunk -> Eval Value
force Thunk
v
  CFun Fun
f -> Fun -> Env -> Value
VClos Fun
f (Env -> Value) -> Eval Env -> Eval Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eval Env
forall r (m :: * -> *). MonadReader r m => m r
ask
  CApp Core
e Args Core
es -> Core -> [Arg Thunk] -> Eval Value
evalApp Core
e ([Arg Thunk] -> Eval Value) -> Eval [Arg Thunk] -> Eval Value
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Args Core -> Eval [Arg Thunk]
evalArgs Args Core
es
  cc :: Core
cc@(CLet (Let Bind (Rec [(Name Core, Embed Core)]) Core
bnd)) -> mdo
    (Rec [(Name Core, Embed Core)]
r, Core
e1) <- Bind (Rec [(Name Core, Embed Core)]) Core
-> Eval (Rec [(Name Core, Embed Core)], Core)
forall p t (m :: * -> *).
(Alpha p, Alpha t, Fresh m) =>
Bind p t -> m (p, t)
unbind Bind (Rec [(Name Core, Embed Core)]) Core
bnd
    [(Name Core, Thunk)]
bnds <-
      ((Name Core, Embed Core) -> Eval (Name Core, Thunk))
-> [(Name Core, Embed Core)] -> Eval [(Name Core, Thunk)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
        ( \(Name Core
v, Embed Core
e) -> do
            Thunk
th <- Eval Value -> Eval Thunk
forall (m :: * -> *). MonadIO m => Eval Value -> m Thunk
mkThunk (Eval Value -> Eval Thunk) -> Eval Value -> Eval Thunk
forall a b. (a -> b) -> a -> b
$ [(Name Core, Thunk)] -> Eval Value -> Eval Value
forall a. [(Name Core, Thunk)] -> Eval a -> Eval a
extendCtx' [(Name Core, Thunk)]
bnds (Eval Value -> Eval Value) -> Eval Value -> Eval Value
forall a b. (a -> b) -> a -> b
$ Core -> Eval Value
eval Core
e
            (Name Core, Thunk) -> Eval (Name Core, Thunk)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name Core
v, Thunk
th)
        )
        (Rec [(Name Core, Embed Core)] -> [(Name Core, Embed Core)]
forall p. Alpha p => Rec p -> p
unrec Rec [(Name Core, Embed Core)]
r)

    --traceShowM "applying the body of the local binding"
    --traceShowM e1
    [(Name Core, Thunk)] -> Eval Value -> Eval Value
forall a. [(Name Core, Thunk)] -> Eval a -> Eval a
extendCtx' [(Name Core, Thunk)]
bnds (Core -> Eval Value
eval Core
e1)
  CObj [KeyValue Core]
e -> [KeyValue Core] -> Eval Value
evalObj [KeyValue Core]
e
  CArr [Core]
e -> Vector Thunk -> Value
VArr (Vector Thunk -> Value)
-> ([Thunk] -> Vector Thunk) -> [Thunk] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Thunk] -> Vector Thunk
forall a. [a] -> Vector a
V.fromList ([Thunk] -> Value) -> Eval [Thunk] -> Eval Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Core -> Eval Thunk) -> [Core] -> Eval [Thunk]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Core -> Eval Thunk
thunk [Core]
e
  CBinOp (Logical LogicalOp
op) Core
e1 Core
e2 -> do
    Thunk
e1' <- Core -> Eval Thunk
thunk Core
e1
    Thunk
e2' <- Core -> Eval Thunk
thunk Core
e2
    LogicalOp -> Thunk -> Thunk -> Eval Value
evalLogical LogicalOp
op Thunk
e1' Thunk
e2'
  CBinOp BinOp
op Core
e1 Core
e2 -> do
    Value
e1' <- Core -> Eval Value
eval Core
e1
    Value
e2' <- Core -> Eval Value
eval Core
e2
    BinOp -> Value -> Value -> Eval Value
evalBinOp BinOp
op Value
e1' Value
e2'
  CUnyOp UnyOp
op Core
e -> do
    Value
e' <- Core -> Eval Value
eval Core
e
    UnyOp -> Value -> Eval Value
evalUnyOp UnyOp
op Value
e'
  CLookup Core
e1 Core
e2 -> do
    Value
v1 <- Core -> Eval Value
eval Core
e1
    Value
v2 <- Core -> Eval Value
eval Core
e2
    Value -> Value -> Eval Value
evalLookup Value
v1 Value
v2
  CIfElse Core
c Core
e1 Core
e2 -> do
    Core -> Eval Value
eval Core
c Eval Value -> (Value -> Eval Value) -> Eval Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      VBool Bool
b ->
        if Bool
b
          then Core -> Eval Value
eval Core
e1
          else Core -> Eval Value
eval Core
e2
      Value
v -> Text -> Value -> Eval Value
forall a. Text -> Value -> Eval a
throwTypeMismatch Text
"bool" Value
v
  CErr Core
e ->
    ( Core -> Eval Value
eval
        (Core -> Eval Value) -> (Value -> Eval Value) -> Core -> Eval Value
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Value -> Eval Text
toString
        (Value -> Eval Text) -> (Text -> Eval Value) -> Value -> Eval Value
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> EvalError -> Eval Value
forall a. EvalError -> Eval a
throwE (EvalError -> Eval Value)
-> (Text -> EvalError) -> Text -> Eval Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> EvalError
RuntimeError (Doc -> EvalError) -> (Text -> Doc) -> Text -> EvalError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc
forall a. Pretty a => a -> Doc
pretty
    )
      Core
e
  CComp (ArrC Bind (Name Core) (Core, Maybe Core)
bnd) Core
cs -> do
    Core -> Bind (Name Core) (Core, Maybe Core) -> Eval Value
evalArrComp Core
cs Bind (Name Core) (Core, Maybe Core)
bnd
  CComp (ObjC Bind (Name Core) (KeyValue Core, Maybe Core)
bnd) Core
cs -> do
    Core -> Bind (Name Core) (KeyValue Core, Maybe Core) -> Eval Value
evalObjComp Core
cs Bind (Name Core) (KeyValue Core, Maybe Core)
bnd

thunk :: Core -> Eval Thunk
thunk :: Core -> Eval Thunk
thunk Core
e =
  Eval Env
forall r (m :: * -> *). MonadReader r m => m r
ask Eval Env -> (Env -> Eval Thunk) -> Eval Thunk
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Env
rho ->
    Eval Value -> Eval Thunk
forall (m :: * -> *). MonadIO m => Eval Value -> m Thunk
mkThunk (Eval Value -> Eval Thunk) -> Eval Value -> Eval Thunk
forall a b. (a -> b) -> a -> b
$ Ctx -> Eval Value -> Eval Value
forall a. Ctx -> Eval a -> Eval a
withCtx (Env -> Ctx
ctx Env
rho) (Core -> Eval Value
eval Core
e)

extendCtx' :: [(Name Core, Thunk)] -> Eval a -> Eval a
extendCtx' :: forall a. [(Name Core, Thunk)] -> Eval a -> Eval a
extendCtx' = Ctx -> Eval a -> Eval a
forall a. Ctx -> Eval a -> Eval a
extendCtx (Ctx -> Eval a -> Eval a)
-> ([(Name Core, Thunk)] -> Ctx)
-> [(Name Core, Thunk)]
-> Eval a
-> Eval a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Name Core, Thunk)] -> Ctx
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList

evalArgs :: Args Core -> Eval [Arg Thunk]
evalArgs :: Args Core -> Eval [Arg Thunk]
evalArgs = \case
  as :: Args Core
as@(Args [Arg Core]
_ Strictness
Lazy) -> Args Thunk -> [Arg Thunk]
forall a. Args a -> [Arg a]
args (Args Thunk -> [Arg Thunk])
-> Eval (Args Thunk) -> Eval [Arg Thunk]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Core -> Eval Thunk) -> Args Core -> Eval (Args Thunk)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Core -> Eval Thunk
thunk Args Core
as
  as :: Args Core
as@(Args [Arg Core]
_ Strictness
Strict) -> Args Thunk -> [Arg Thunk]
forall a. Args a -> [Arg a]
args (Args Thunk -> [Arg Thunk])
-> Eval (Args Thunk) -> Eval [Arg Thunk]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Core -> Eval Thunk) -> Args Core -> Eval (Args Thunk)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Core -> Eval Thunk
f Args Core
as
    where
      f :: Core -> Eval Thunk
f = Core -> Eval Value
eval (Core -> Eval Value) -> (Value -> Eval Thunk) -> Core -> Eval Thunk
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Thunk -> Eval Thunk
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Thunk -> Eval Thunk) -> (Value -> Thunk) -> Value -> Eval Thunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Thunk
mkThunk'

evalApp :: Core -> [Arg Thunk] -> Eval Value
evalApp :: Core -> [Arg Thunk] -> Eval Value
evalApp Core
e [Arg Thunk]
vs = Core -> Eval Value -> Eval Value
forall a. Core -> Eval a -> Eval a
withStackFrame Core
e (Eval Value -> Eval Value) -> Eval Value -> Eval Value
forall a b. (a -> b) -> a -> b
$ do
  Core -> Eval Value
eval Core
e Eval Value -> (Value -> Eval Value) -> Eval Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    VClos Fun
f Env {[Maybe (Name Core)]
[Maybe SrcSpan]
Ctx
scopes :: Env -> [Maybe (Name Core)]
spans :: Env -> [Maybe SrcSpan]
scopes :: [Maybe (Name Core)]
spans :: [Maybe SrcSpan]
ctx :: Ctx
ctx :: Env -> Ctx
..} -> Ctx -> Fun -> [Arg Thunk] -> Eval Value
evalClos Ctx
ctx Fun
f [Arg Thunk]
vs
    v :: Value
v@(VFun Thunk -> Eval Value
_) -> (Value -> Arg Thunk -> Eval Value)
-> Value -> [Arg Thunk] -> Eval Value
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM Value -> Arg Thunk -> Eval Value
f Value
v [Arg Thunk]
vs
      where
        f :: Value -> Arg Thunk -> Eval Value
f (VFun Thunk -> Eval Value
g) (Pos Thunk
v) = Thunk -> Eval Value
g Thunk
v
        f Value
v Arg Thunk
_ = Text -> Value -> Eval Value
forall a. Text -> Value -> Eval a
throwTypeMismatch Text
"function" Value
v
    Value
v -> Text -> Value -> Eval Value
forall a. Text -> Value -> Eval a
throwTypeMismatch Text
"function" Value
v

withStackFrame :: Core -> Eval a -> Eval a
withStackFrame :: forall a. Core -> Eval a -> Eval a
withStackFrame (CLoc SrcSpan
sp (CVar Name Core
n)) Eval a
e =
  Name Core -> Eval a -> Eval a
forall a. Name Core -> Eval a -> Eval a
pushScope Name Core
n (Maybe SrcSpan -> Eval a -> Eval a
forall a. Maybe SrcSpan -> Eval a -> Eval a
pushSpan (SrcSpan -> Maybe SrcSpan
forall a. a -> Maybe a
Just SrcSpan
sp) Eval a
e)
withStackFrame (CLoc SrcSpan
sp Core
_) Eval a
e =
  Name Core -> Eval a -> Eval a
forall a. Name Core -> Eval a -> Eval a
pushScope (String -> Name Core
forall a. String -> Name a
s2n String
"anonymous") (Maybe SrcSpan -> Eval a -> Eval a
forall a. Maybe SrcSpan -> Eval a -> Eval a
pushSpan (SrcSpan -> Maybe SrcSpan
forall a. a -> Maybe a
Just SrcSpan
sp) Eval a
e)
withStackFrame (CVar Name Core
n) Eval a
e =
  Name Core -> Eval a -> Eval a
forall a. Name Core -> Eval a -> Eval a
pushScope Name Core
n (Maybe SrcSpan -> Eval a -> Eval a
forall a. Maybe SrcSpan -> Eval a -> Eval a
pushSpan Maybe SrcSpan
forall a. Maybe a
Nothing Eval a
e)
withStackFrame Core
_ Eval a
e =
  Name Core -> Eval a -> Eval a
forall a. Name Core -> Eval a -> Eval a
pushScope (String -> Name Core
forall a. String -> Name a
s2n String
"anonymous") (Maybe SrcSpan -> Eval a -> Eval a
forall a. Maybe SrcSpan -> Eval a -> Eval a
pushSpan Maybe SrcSpan
forall a. Maybe a
Nothing Eval a
e)

evalClos :: Ctx -> Fun -> [Arg Thunk] -> Eval Value
evalClos :: Ctx -> Fun -> [Arg Thunk] -> Eval Value
evalClos Ctx
rho (Fun Bind (Rec [Param Core]) Core
f) [Arg Thunk]
vs = do
  (Rec [Param Core]
bnds, Core
e) <- Bind (Rec [Param Core]) Core -> Eval (Rec [Param Core], Core)
forall p t (m :: * -> *).
(Alpha p, Alpha t, Fresh m) =>
Bind p t -> m (p, t)
unbind Bind (Rec [Param Core]) Core
f
  let xs :: [(Name Core, Maybe Core)]
xs = (Embed (Maybe Core) -> Maybe Core)
-> Param Core -> (Name Core, Maybe Core)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Embed (Maybe Core) -> Maybe Core
forall e. IsEmbed e => e -> Embedded e
unembed (Param Core -> (Name Core, Maybe Core))
-> [Param Core] -> [(Name Core, Maybe Core)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rec [Param Core] -> [Param Core]
forall p. Alpha p => Rec p -> p
unrec Rec [Param Core]
bnds
  Ctx -> Eval Value -> Eval Value
forall a. Ctx -> Eval a -> Eval a
withCtx Ctx
rho ([(Name Core, Maybe Core)] -> Core -> [Arg Thunk] -> Eval Value
evalFun [(Name Core, Maybe Core)]
xs Core
e [Arg Thunk]
vs)

appDefaults :: [(Name Core, Maybe Core)] -> Core -> Eval Value
appDefaults :: [(Name Core, Maybe Core)] -> Core -> Eval Value
appDefaults [(Name Core, Maybe Core)]
rs Core
e = do
  case (Maybe Core -> Bool) -> [Maybe Core] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex Maybe Core -> Bool
forall a. Maybe a -> Bool
isNothing [Maybe Core]
ds of
    Just Int
x -> EvalError -> Eval Value
forall a. EvalError -> Eval a
throwE (EvalError -> Eval Value) -> EvalError -> Eval Value
forall a b. (a -> b) -> a -> b
$ Doc -> EvalError
ParamNotBound (Name Core -> Doc
forall a. Pretty a => a -> Doc
pretty (Name Core -> Doc) -> Name Core -> Doc
forall a b. (a -> b) -> a -> b
$ [Name Core]
ns [Name Core] -> Int -> Name Core
forall a. [a] -> Int -> a
!! Int
x)
    Maybe Int
Nothing -> mdo
      [(Name Core, Thunk)]
bnds <-
        ((Name Core, Core) -> Eval (Name Core, Thunk))
-> [(Name Core, Core)] -> Eval [(Name Core, Thunk)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
          ( \(Name Core
v, Core
e) -> do
              Thunk
th <- Eval Value -> Eval Thunk
forall (m :: * -> *). MonadIO m => Eval Value -> m Thunk
mkThunk (Eval Value -> Eval Thunk) -> Eval Value -> Eval Thunk
forall a b. (a -> b) -> a -> b
$ [(Name Core, Thunk)] -> Eval Value -> Eval Value
forall a. [(Name Core, Thunk)] -> Eval a -> Eval a
extendCtx' [(Name Core, Thunk)]
bnds (Eval Value -> Eval Value) -> Eval Value -> Eval Value
forall a b. (a -> b) -> a -> b
$ Core -> Eval Value
eval Core
e
              (Name Core, Thunk) -> Eval (Name Core, Thunk)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name Core
v, Thunk
th)
          )
          ([Name Core] -> [Core] -> [(Name Core, Core)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Name Core]
ns ([Core] -> [(Name Core, Core)]) -> [Core] -> [(Name Core, Core)]
forall a b. (a -> b) -> a -> b
$ [Maybe Core] -> [Core]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Core]
ds)
      [(Name Core, Thunk)] -> Eval Value -> Eval Value
forall a. [(Name Core, Thunk)] -> Eval a -> Eval a
extendCtx' [(Name Core, Thunk)]
bnds (Core -> Eval Value
eval Core
e)
  where
    ([Name Core]
ns, [Maybe Core]
ds) = [(Name Core, Maybe Core)] -> ([Name Core], [Maybe Core])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Name Core, Maybe Core)]
rs

evalFun :: [(Name Core, Maybe Core)] -> Core -> [Arg Thunk] -> Eval Value
evalFun [(Name Core, Maybe Core)]
bnds Core
e [Arg Thunk]
args = do
  if [Arg Thunk] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Arg Thunk]
ps Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> [(Name Core, Maybe Core)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Name Core, Maybe Core)]
bnds
    then EvalError -> Eval Value
forall a. EvalError -> Eval a
throwE (EvalError -> Eval Value) -> EvalError -> Eval Value
forall a b. (a -> b) -> a -> b
$ Int -> EvalError
TooManyArgs ([(Name Core, Maybe Core)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Name Core, Maybe Core)]
bnds)
    else [(Name Core, Thunk)] -> Eval Value -> Eval Value
forall a. [(Name Core, Thunk)] -> Eval a -> Eval a
extendCtx' ([Name Core] -> [Thunk] -> [(Name Core, Thunk)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Name Core]
names [Thunk]
ps') (Eval Value -> Eval Value) -> Eval Value -> Eval Value
forall a b. (a -> b) -> a -> b
$ [Arg Thunk] -> [(Name Core, Maybe Core)] -> Eval Value
evalNamedArgs [Arg Thunk]
ns [(Name Core, Maybe Core)]
bnds'
  where
    isPos :: Arg a -> Bool
isPos = \case
      Pos a
_ -> Bool
True
      Arg a
_ -> Bool
False
    ([Arg Thunk]
ps, [Arg Thunk]
ns) = (Arg Thunk -> Bool) -> [Arg Thunk] -> ([Arg Thunk], [Arg Thunk])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Arg Thunk -> Bool
forall {a}. Arg a -> Bool
isPos [Arg Thunk]
args
    ps' :: [Thunk]
ps' = (Arg Thunk -> Thunk) -> [Arg Thunk] -> [Thunk]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Pos Thunk
a) -> Thunk
a) [Arg Thunk]
ps
    ([Name Core]
names, [Maybe Core]
_) = [(Name Core, Maybe Core)] -> ([Name Core], [Maybe Core])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Name Core, Maybe Core)]
bnds
    bnds' :: [(Name Core, Maybe Core)]
bnds' = Int -> [(Name Core, Maybe Core)] -> [(Name Core, Maybe Core)]
forall a. Int -> [a] -> [a]
drop ([Arg Thunk] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Arg Thunk]
ps) [(Name Core, Maybe Core)]
bnds
    evalNamedArgs :: [Arg Thunk] -> [(Name Core, Maybe Core)] -> Eval Value
evalNamedArgs [Arg Thunk]
ns [(Name Core, Maybe Core)]
bnds = do
      [(String, Thunk)]
ns' <- [Arg Thunk]
-> (Arg Thunk -> Eval (String, Thunk)) -> Eval [(String, Thunk)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Arg Thunk]
ns ((Arg Thunk -> Eval (String, Thunk)) -> Eval [(String, Thunk)])
-> (Arg Thunk -> Eval (String, Thunk)) -> Eval [(String, Thunk)]
forall a b. (a -> b) -> a -> b
$ \case
        Named String
n Thunk
v -> (String, Thunk) -> Eval (String, Thunk)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
n, Thunk
v)
      ([Name Core]
names, [Thunk]
vs) <- [(Name Core, Thunk)] -> ([Name Core], [Thunk])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Name Core, Thunk)] -> ([Name Core], [Thunk]))
-> Eval [(Name Core, Thunk)] -> Eval ([Name Core], [Thunk])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(String, Thunk)]
-> [(Name Core, Maybe Core)] -> Eval [(Name Core, Thunk)]
forall {t :: * -> *} {b} {a} {b}.
Traversable t =>
t (String, b) -> [(Name a, b)] -> Eval (t (Name a, b))
buildParams [(String, Thunk)]
ns' [(Name Core, Maybe Core)]
bnds
      let rs :: [(Name Core, Maybe Core)]
rs = ((Name Core, Maybe Core) -> Bool)
-> [(Name Core, Maybe Core)] -> [(Name Core, Maybe Core)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Name Core -> [Name Core] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Name Core]
names) (Name Core -> Bool)
-> ((Name Core, Maybe Core) -> Name Core)
-> (Name Core, Maybe Core)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name Core, Maybe Core) -> Name Core
forall a b. (a, b) -> a
fst) [(Name Core, Maybe Core)]
bnds
      [(Name Core, Thunk)] -> Eval Value -> Eval Value
forall a. [(Name Core, Thunk)] -> Eval a -> Eval a
extendCtx' ([Name Core] -> [Thunk] -> [(Name Core, Thunk)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Name Core]
names [Thunk]
vs) ([(Name Core, Maybe Core)] -> Core -> Eval Value
appDefaults [(Name Core, Maybe Core)]
rs Core
e)
      where
        buildParams :: t (String, b) -> [(Name a, b)] -> Eval (t (Name a, b))
buildParams t (String, b)
as [(Name a, b)]
bnds = ((String, b) -> Eval (Name a, b))
-> t (String, b) -> Eval (t (Name a, b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (String, b) -> Eval (Name a, b)
forall {b}. (String, b) -> Eval (Name a, b)
f t (String, b)
as
          where
            ns :: [Name a]
ns = ([Name a], [b]) -> [Name a]
forall a b. (a, b) -> a
fst (([Name a], [b]) -> [Name a]) -> ([Name a], [b]) -> [Name a]
forall a b. (a -> b) -> a -> b
$ [(Name a, b)] -> ([Name a], [b])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Name a, b)]
bnds
            f :: (String, b) -> Eval (Name a, b)
f (String
a, b
b) = case String -> Maybe (Name a)
g String
a of
              Maybe (Name a)
Nothing -> EvalError -> Eval (Name a, b)
forall a. EvalError -> Eval a
throwE (EvalError -> Eval (Name a, b)) -> EvalError -> Eval (Name a, b)
forall a b. (a -> b) -> a -> b
$ Doc -> EvalError
BadParam (String -> Doc
forall a. Pretty a => a -> Doc
pretty String
a)
              Just Name a
n -> (Name a, b) -> Eval (Name a, b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name a
n, b
b)
            g :: String -> Maybe (Name a)
g String
a = (Name a -> Bool) -> [Name a] -> Maybe (Name a)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((String
a String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==) (String -> Bool) -> (Name a -> String) -> Name a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name a -> String
forall a. Name a -> String
name2String) [Name a]
ns

-- | right-biased union of two objects, i.e. '{x : 1} + {x : 2} == {x : 2}'
mergeWith :: Object -> Object -> Object
mergeWith :: Object -> Object -> Object
mergeWith Object
xs Object
ys =
  let f :: a -> a -> a
f a
a a
b
        | a -> Bool
forall a. HasVisibility a => a -> Bool
hidden a
a Bool -> Bool -> Bool
&& a -> Bool
forall a. HasVisibility a => a -> Bool
visible a
b = a
a
        | Bool
otherwise = a
b
      g :: Name Core -> Object -> f Thunk -> f Thunk
g Name Core
name Object
xs = (Thunk -> Thunk) -> f Thunk -> f Thunk
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Thunk -> Thunk) -> f Thunk -> f Thunk)
-> (Thunk -> Thunk) -> f Thunk -> f Thunk
forall a b. (a -> b) -> a -> b
$
        \case
          TC Ctx
rho Core
e -> Ctx -> Core -> Thunk
TC (Name Core -> Thunk -> Ctx -> Ctx
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name Core
name (Value -> Thunk
mkThunk' (Value -> Thunk) -> Value -> Thunk
forall a b. (a -> b) -> a -> b
$ Object -> Value
VObj Object
xs) Ctx
rho) Core
e
          v :: Thunk
v@(TV {}) -> Thunk
v
      h :: Name Core -> Object -> f Thunk -> f Thunk
h Name Core
name Object
xs = (Thunk -> Thunk) -> f Thunk -> f Thunk
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Thunk -> Thunk) -> f Thunk -> f Thunk)
-> (Thunk -> Thunk) -> f Thunk -> f Thunk
forall a b. (a -> b) -> a -> b
$
        \case
          TC Ctx
rho Core
e -> Ctx -> Core -> Thunk
TC (Name Core -> Thunk -> Ctx -> Ctx
forall {a}.
Name Core -> a -> Map (Name Core) a -> Map (Name Core) a
insert' Name Core
name (Value -> Thunk
mkThunk' (Value -> Thunk) -> Value -> Thunk
forall a b. (a -> b) -> a -> b
$ Object -> Value
VObj Object
xs) Ctx
rho) Core
e
          v :: Thunk
v@(TV {}) -> Thunk
v
      xs' :: Object
xs' = (Hideable Thunk -> Hideable Thunk) -> Object -> Object
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
H.map (Name Core -> Object -> Hideable Thunk -> Hideable Thunk
forall {f :: * -> *}.
Functor f =>
Name Core -> Object -> f Thunk -> f Thunk
g Name Core
"self" Object
zs') Object
xs
      ys' :: Object
ys' = (Hideable Thunk -> Hideable Thunk) -> Object -> Object
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
H.map (Name Core -> Object -> Hideable Thunk -> Hideable Thunk
forall {f :: * -> *}.
Functor f =>
Name Core -> Object -> f Thunk -> f Thunk
g Name Core
"self" Object
zs' (Hideable Thunk -> Hideable Thunk)
-> (Hideable Thunk -> Hideable Thunk)
-> Hideable Thunk
-> Hideable Thunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name Core -> Object -> Hideable Thunk -> Hideable Thunk
forall {f :: * -> *}.
Functor f =>
Name Core -> Object -> f Thunk -> f Thunk
h Name Core
"super" Object
xs') Object
ys
      zs' :: Object
zs' = (Hideable Thunk -> Hideable Thunk -> Hideable Thunk)
-> Object -> Object -> Object
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
H.unionWith Hideable Thunk -> Hideable Thunk -> Hideable Thunk
forall {a}. HasVisibility a => a -> a -> a
f Object
xs' Object
ys'
      insert' :: Name Core -> a -> Map (Name Core) a -> Map (Name Core) a
insert' = (a -> a -> a)
-> Name Core -> a -> Map (Name Core) a -> Map (Name Core) a
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith (a -> a -> a
forall a b. a -> b -> a
const)
   in Object
zs'

evalObj :: [KeyValue Core] -> Eval Value
evalObj :: [KeyValue Core] -> Eval Value
evalObj [KeyValue Core]
xs = mdo
  Ctx
env <- (Env -> Ctx) -> Eval Ctx
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env -> Ctx
ctx
  [(Text, Hideable Thunk)]
fs <-
    [Maybe (Text, Hideable Thunk)] -> [(Text, Hideable Thunk)]
forall a. [Maybe a] -> [a]
catMaybes
      ([Maybe (Text, Hideable Thunk)] -> [(Text, Hideable Thunk)])
-> Eval [Maybe (Text, Hideable Thunk)]
-> Eval [(Text, Hideable Thunk)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (KeyValue Core -> Eval (Maybe (Text, Hideable Thunk)))
-> [KeyValue Core] -> Eval [Maybe (Text, Hideable Thunk)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
        ( \(KeyValue Core
key Hideable Core
value) -> do
            Maybe Text
k <- Core -> Eval (Maybe Text)
evalKey Core
key
            Hideable Thunk
v <- Hideable Thunk -> Eval (Hideable Thunk)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Hideable Thunk -> Eval (Hideable Thunk))
-> Hideable Thunk -> Eval (Hideable Thunk)
forall a b. (a -> b) -> a -> b
$ Ctx -> Core -> Thunk
TC (Name Core -> Thunk -> Ctx -> Ctx
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name Core
"self" ([(Text, Hideable Thunk)] -> Thunk
self [(Text, Hideable Thunk)]
fs) Ctx
env) (Core -> Thunk) -> Hideable Core -> Hideable Thunk
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Hideable Core
value
            case Maybe Text
k of
              Just Text
k -> Maybe (Text, Hideable Thunk) -> Eval (Maybe (Text, Hideable Thunk))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Text, Hideable Thunk)
 -> Eval (Maybe (Text, Hideable Thunk)))
-> Maybe (Text, Hideable Thunk)
-> Eval (Maybe (Text, Hideable Thunk))
forall a b. (a -> b) -> a -> b
$ (Text, Hideable Thunk) -> Maybe (Text, Hideable Thunk)
forall a. a -> Maybe a
Just (Text
k, Hideable Thunk
v)
              Maybe Text
_ -> Maybe (Text, Hideable Thunk) -> Eval (Maybe (Text, Hideable Thunk))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Text, Hideable Thunk)
forall a. Maybe a
Nothing
        )
        [KeyValue Core]
xs
  Value -> Eval Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Eval Value) -> Value -> Eval Value
forall a b. (a -> b) -> a -> b
$ Object -> Value
VObj (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ [(Text, Hideable Thunk)] -> Object
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
H.fromList ([(Text, Hideable Thunk)] -> Object)
-> [(Text, Hideable Thunk)] -> Object
forall a b. (a -> b) -> a -> b
$ [(Text, Hideable Thunk)]
fs
  where
    self :: [(Text, Hideable Thunk)] -> Thunk
self = Value -> Thunk
mkThunk' (Value -> Thunk)
-> ([(Text, Hideable Thunk)] -> Value)
-> [(Text, Hideable Thunk)]
-> Thunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> Value
VObj (Object -> Value)
-> ([(Text, Hideable Thunk)] -> Object)
-> [(Text, Hideable Thunk)]
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Hideable Thunk)] -> Object
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
H.fromList

evalKey :: Core -> Eval (Maybe Text)
evalKey :: Core -> Eval (Maybe Text)
evalKey Core
key =
  Core -> Eval Value
eval Core
key Eval Value -> (Value -> Eval (Maybe Text)) -> Eval (Maybe Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    VStr Text
k -> Maybe Text -> Eval (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> Eval (Maybe Text))
-> Maybe Text -> Eval (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
k
    Value
VNull -> Maybe Text -> Eval (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing
    Value
v -> Value -> Eval (Maybe Text)
forall a. Value -> Eval a
throwInvalidKey Value
v

evalKeyValue :: KeyValue Core -> Eval (Maybe (Text, Hideable Thunk))
evalKeyValue :: KeyValue Core -> Eval (Maybe (Text, Hideable Thunk))
evalKeyValue (KeyValue Core
key Hideable Core
value) = do
  Maybe Text
a <- Core -> Eval (Maybe Text)
evalKey Core
key
  Hideable Thunk
b <- (Env -> Ctx) -> Eval Ctx
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env -> Ctx
ctx Eval Ctx -> (Ctx -> Eval (Hideable Thunk)) -> Eval (Hideable Thunk)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ctx
rho -> Hideable Thunk -> Eval (Hideable Thunk)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ctx -> Core -> Thunk
TC Ctx
rho (Core -> Thunk) -> Hideable Core -> Hideable Thunk
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Hideable Core
value)
  Maybe (Text, Hideable Thunk) -> Eval (Maybe (Text, Hideable Thunk))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Text, Hideable Thunk)
 -> Eval (Maybe (Text, Hideable Thunk)))
-> Maybe (Text, Hideable Thunk)
-> Eval (Maybe (Text, Hideable Thunk))
forall a b. (a -> b) -> a -> b
$ (,Hideable Thunk
b) (Text -> (Text, Hideable Thunk))
-> Maybe Text -> Maybe (Text, Hideable Thunk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
a

evalArrComp ::
  Core ->
  Bind (Name Core) (Core, Maybe Core) ->
  Eval Value
evalArrComp :: Core -> Bind (Name Core) (Core, Maybe Core) -> Eval Value
evalArrComp Core
cs Bind (Name Core) (Core, Maybe Core)
bnd = do
  Vector (Maybe Thunk)
xs <- Eval (Vector (Maybe Thunk))
comp
  (Vector (Vector Thunk) -> Vector Thunk) -> Value -> Eval Value
forall a b.
(HasValue a, HasValue b) =>
(a -> b) -> Value -> Eval Value
inj' Vector (Vector Thunk) -> Vector Thunk
flattenArrays (Value -> Eval Value) -> Value -> Eval Value
forall a b. (a -> b) -> a -> b
$ Vector Thunk -> Value
VArr (Vector Thunk -> Value) -> Vector Thunk -> Value
forall a b. (a -> b) -> a -> b
$ (Maybe Thunk -> Maybe Thunk)
-> Vector (Maybe Thunk) -> Vector Thunk
forall a b. (a -> Maybe b) -> Vector a -> Vector b
V.mapMaybe Maybe Thunk -> Maybe Thunk
forall a. a -> a
id Vector (Maybe Thunk)
xs
  where
    comp :: Eval (Vector (Maybe Thunk))
comp =
      Core -> Eval Value
eval Core
cs Eval Value
-> (Value -> Eval (Vector (Maybe Thunk)))
-> Eval (Vector (Maybe Thunk))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        VArr Vector Thunk
xs -> Vector Thunk
-> (Thunk -> Eval (Maybe Thunk)) -> Eval (Vector (Maybe Thunk))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Vector Thunk
xs ((Thunk -> Eval (Maybe Thunk)) -> Eval (Vector (Maybe Thunk)))
-> (Thunk -> Eval (Maybe Thunk)) -> Eval (Vector (Maybe Thunk))
forall a b. (a -> b) -> a -> b
$ \Thunk
x -> do
          (Name Core
n, (Core
e, Maybe Core
cond)) <- Bind (Name Core) (Core, Maybe Core)
-> Eval (Name Core, (Core, Maybe Core))
forall p t (m :: * -> *).
(Alpha p, Alpha t, Fresh m) =>
Bind p t -> m (p, t)
unbind Bind (Name Core) (Core, Maybe Core)
bnd
          [(Name Core, Thunk)] -> Eval (Maybe Thunk) -> Eval (Maybe Thunk)
forall a. [(Name Core, Thunk)] -> Eval a -> Eval a
extendCtx' [(Name Core
n, Thunk
x)] (Eval (Maybe Thunk) -> Eval (Maybe Thunk))
-> Eval (Maybe Thunk) -> Eval (Maybe Thunk)
forall a b. (a -> b) -> a -> b
$ do
            Bool
b <- Maybe Core -> Eval Bool
f Maybe Core
cond
            if Bool
b
              then Thunk -> Maybe Thunk
forall a. a -> Maybe a
Just (Thunk -> Maybe Thunk) -> Eval Thunk -> Eval (Maybe Thunk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Core -> Eval Thunk
thunk Core
e
              else Maybe Thunk -> Eval (Maybe Thunk)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Thunk
forall a. Maybe a
Nothing
        Value
v -> Text -> Value -> Eval (Vector (Maybe Thunk))
forall a. Text -> Value -> Eval a
throwTypeMismatch Text
"array" Value
v
      where
        f :: Maybe Core -> Eval Bool
f Maybe Core
Nothing = Bool -> Eval Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
        f (Just Core
c) = do
          Value
vb <- Core -> Eval Value
eval Core
c
          Value -> Eval Bool
forall a. HasValue a => Value -> Eval a
proj Value
vb

evalObjComp ::
  Core ->
  Bind (Name Core) (KeyValue Core, Maybe Core) ->
  Eval Value
evalObjComp :: Core -> Bind (Name Core) (KeyValue Core, Maybe Core) -> Eval Value
evalObjComp Core
cs Bind (Name Core) (KeyValue Core, Maybe Core)
bnd = do
  Vector (Maybe (Text, Hideable Thunk))
xs <- Eval (Vector (Maybe (Text, Hideable Thunk)))
comp
  Value -> Eval Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Eval Value) -> Value -> Eval Value
forall a b. (a -> b) -> a -> b
$ Object -> Value
VObj (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ [(Text, Hideable Thunk)] -> Object
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
H.fromList ([(Text, Hideable Thunk)] -> Object)
-> [(Text, Hideable Thunk)] -> Object
forall a b. (a -> b) -> a -> b
$ [Maybe (Text, Hideable Thunk)] -> [(Text, Hideable Thunk)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Text, Hideable Thunk)] -> [(Text, Hideable Thunk)])
-> [Maybe (Text, Hideable Thunk)] -> [(Text, Hideable Thunk)]
forall a b. (a -> b) -> a -> b
$ Vector (Maybe (Text, Hideable Thunk))
-> [Maybe (Text, Hideable Thunk)]
forall a. Vector a -> [a]
V.toList Vector (Maybe (Text, Hideable Thunk))
xs
  where
    comp :: Eval (Vector (Maybe (Text, Hideable Thunk)))
comp =
      Core -> Eval Value
eval Core
cs Eval Value
-> (Value -> Eval (Vector (Maybe (Text, Hideable Thunk))))
-> Eval (Vector (Maybe (Text, Hideable Thunk)))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        VArr Vector Thunk
xs -> Vector Thunk
-> (Thunk -> Eval (Maybe (Text, Hideable Thunk)))
-> Eval (Vector (Maybe (Text, Hideable Thunk)))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Vector Thunk
xs ((Thunk -> Eval (Maybe (Text, Hideable Thunk)))
 -> Eval (Vector (Maybe (Text, Hideable Thunk))))
-> (Thunk -> Eval (Maybe (Text, Hideable Thunk)))
-> Eval (Vector (Maybe (Text, Hideable Thunk)))
forall a b. (a -> b) -> a -> b
$ \Thunk
x -> do
          (Name Core
n, (KeyValue Core
e, Maybe Core
cond)) <- Bind (Name Core) (KeyValue Core, Maybe Core)
-> Eval (Name Core, (KeyValue Core, Maybe Core))
forall p t (m :: * -> *).
(Alpha p, Alpha t, Fresh m) =>
Bind p t -> m (p, t)
unbind Bind (Name Core) (KeyValue Core, Maybe Core)
bnd
          [(Name Core, Thunk)]
-> Eval (Maybe (Text, Hideable Thunk))
-> Eval (Maybe (Text, Hideable Thunk))
forall a. [(Name Core, Thunk)] -> Eval a -> Eval a
extendCtx' [(Name Core
n, Thunk
x)] (Eval (Maybe (Text, Hideable Thunk))
 -> Eval (Maybe (Text, Hideable Thunk)))
-> Eval (Maybe (Text, Hideable Thunk))
-> Eval (Maybe (Text, Hideable Thunk))
forall a b. (a -> b) -> a -> b
$ do
            Bool
b <- Maybe Core -> Eval Bool
f Maybe Core
cond
            if Bool
b
              then KeyValue Core -> Eval (Maybe (Text, Hideable Thunk))
evalKeyValue KeyValue Core
e
              else Maybe (Text, Hideable Thunk) -> Eval (Maybe (Text, Hideable Thunk))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Text, Hideable Thunk)
forall a. Maybe a
Nothing
        Value
v -> Text -> Value -> Eval (Vector (Maybe (Text, Hideable Thunk)))
forall a. Text -> Value -> Eval a
throwTypeMismatch Text
"array" Value
v
    f :: Maybe Core -> Eval Bool
f Maybe Core
Nothing = Bool -> Eval Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
    f (Just Core
c) = do
      Value
vb <- Core -> Eval Value
eval Core
c
      Value -> Eval Bool
forall a. HasValue a => Value -> Eval a
proj Value
vb

evalUnyOp :: UnyOp -> Value -> Eval Value
evalUnyOp :: UnyOp -> Value -> Eval Value
evalUnyOp UnyOp
Compl Value
x = Int64 -> Value
forall a. HasValue a => a -> Value
inj (Int64 -> Value) -> Eval Int64 -> Eval Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int64 -> Int64) -> Eval Int64 -> Eval Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Bits a => a -> a
complement @Int64) (Value -> Eval Int64
forall a. HasValue a => Value -> Eval a
proj Value
x)
evalUnyOp UnyOp
LNot Value
x = Bool -> Value
forall a. HasValue a => a -> Value
inj (Bool -> Value) -> Eval Bool -> Eval Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool -> Bool) -> Eval Bool -> Eval Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (Value -> Eval Bool
forall a. HasValue a => Value -> Eval a
proj Value
x)
evalUnyOp UnyOp
Minus Value
x = Double -> Value
forall a. HasValue a => a -> Value
inj (Double -> Value) -> Eval Double -> Eval Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Double -> Double) -> Eval Double -> Eval Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Num a => a -> a
negate @Double) (Value -> Eval Double
forall a. HasValue a => Value -> Eval a
proj Value
x)
evalUnyOp UnyOp
Plus Value
x = Double -> Value
forall a. HasValue a => a -> Value
inj (Double -> Value) -> Eval Double -> Eval Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Double -> Double) -> Eval Double -> Eval Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> a
id @Double) (Value -> Eval Double
forall a. HasValue a => Value -> Eval a
proj Value
x)

evalBinOp :: BinOp -> Value -> Value -> Eval Value
evalBinOp :: BinOp -> Value -> Value -> Eval Value
evalBinOp BinOp
In Value
s Value
o = (Object -> Text -> Bool) -> Value -> Value -> Eval Value
forall a b c.
(HasValue a, HasValue b, HasValue c) =>
(a -> b -> c) -> Value -> Value -> Eval Value
evalBin (\Object
o Text
s -> Object -> Text -> Bool -> Bool
Std.objectHasEx Object
o Text
s Bool
True) Value
o Value
s
evalBinOp (Arith ArithOp
Add) x :: Value
x@(VStr Text
_) Value
y = Text -> Value
forall a. HasValue a => a -> Value
inj (Text -> Value) -> Eval Text -> Eval Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Value -> Eval Text
append Value
x Value
y
evalBinOp (Arith ArithOp
Add) Value
x y :: Value
y@(VStr Text
_) = Text -> Value
forall a. HasValue a => a -> Value
inj (Text -> Value) -> Eval Text -> Eval Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Value -> Eval Text
append Value
x Value
y
evalBinOp (Arith ArithOp
Add) x :: Value
x@(VArr Vector Thunk
_) y :: Value
y@(VArr Vector Thunk
_) = (Vector Thunk -> Vector Thunk -> Vector Thunk)
-> Value -> Value -> Eval Value
forall a b c.
(HasValue a, HasValue b, HasValue c) =>
(a -> b -> c) -> Value -> Value -> Eval Value
evalBin (forall a. Vector a -> Vector a -> Vector a
(V.++) @Thunk) Value
x Value
y
evalBinOp (Arith ArithOp
Add) (VObj Object
x) (VObj Object
y) = Value -> Eval Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Eval Value) -> Value -> Eval Value
forall a b. (a -> b) -> a -> b
$ Object -> Value
VObj (Object
x Object -> Object -> Object
`mergeWith` Object
y)
evalBinOp (Arith ArithOp
op) Value
x Value
y = ArithOp -> Value -> Value -> Eval Value
evalArith ArithOp
op Value
x Value
y
evalBinOp (Comp CompOp
op) Value
x Value
y = CompOp -> Value -> Value -> Eval Value
evalComp CompOp
op Value
x Value
y
evalBinOp (Bitwise BitwiseOp
op) Value
x Value
y = BitwiseOp -> Value -> Value -> Eval Value
evalBitwise BitwiseOp
op Value
x Value
y

evalArith :: ArithOp -> Value -> Value -> Eval Value
evalArith :: ArithOp -> Value -> Value -> Eval Value
evalArith ArithOp
Add Value
n1 Value
n2 = (Double -> Double -> Double) -> Value -> Value -> Eval Value
forall a b c.
(HasValue a, HasValue b, HasValue c) =>
(a -> b -> c) -> Value -> Value -> Eval Value
evalBin (forall a. Num a => a -> a -> a
(+) @Double) Value
n1 Value
n2
evalArith ArithOp
Sub Value
n1 Value
n2 = (Double -> Double -> Double) -> Value -> Value -> Eval Value
forall a b c.
(HasValue a, HasValue b, HasValue c) =>
(a -> b -> c) -> Value -> Value -> Eval Value
evalBin ((-) @Double) Value
n1 Value
n2
evalArith ArithOp
Mul Value
n1 Value
n2 = (Double -> Double -> Double) -> Value -> Value -> Eval Value
forall a b c.
(HasValue a, HasValue b, HasValue c) =>
(a -> b -> c) -> Value -> Value -> Eval Value
evalBin (forall a. Num a => a -> a -> a
(*) @Double) Value
n1 Value
n2
evalArith ArithOp
Div (VNum Scientific
_) (VNum Scientific
0) = EvalError -> Eval Value
forall a. EvalError -> Eval a
throwE EvalError
DivByZero
evalArith ArithOp
Div Value
n1 Value
n2 = (Double -> Double -> Double) -> Value -> Value -> Eval Value
forall a b c.
(HasValue a, HasValue b, HasValue c) =>
(a -> b -> c) -> Value -> Value -> Eval Value
evalBin (forall a. Fractional a => a -> a -> a
(/) @Double) Value
n1 Value
n2
evalArith ArithOp
Mod (VNum Scientific
_) (VNum Scientific
0) = EvalError -> Eval Value
forall a. EvalError -> Eval a
throwE EvalError
DivByZero
evalArith ArithOp
Mod Value
n1 Value
n2 = (Int64 -> Int64 -> Int64) -> Value -> Value -> Eval Value
forall a b c.
(HasValue a, HasValue b, HasValue c) =>
(a -> b -> c) -> Value -> Value -> Eval Value
evalBin (forall a. Integral a => a -> a -> a
mod @Int64) Value
n1 Value
n2

evalComp :: CompOp -> Value -> Value -> Eval Value
evalComp :: CompOp -> Value -> Value -> Eval Value
evalComp CompOp
Lt Value
n1 Value
n2 = (Double -> Double -> Bool) -> Value -> Value -> Eval Value
forall a b c.
(HasValue a, HasValue b, HasValue c) =>
(a -> b -> c) -> Value -> Value -> Eval Value
evalBin (forall a. Ord a => a -> a -> Bool
(<) @Double) Value
n1 Value
n2
evalComp CompOp
Gt Value
n1 Value
n2 = (Double -> Double -> Bool) -> Value -> Value -> Eval Value
forall a b c.
(HasValue a, HasValue b, HasValue c) =>
(a -> b -> c) -> Value -> Value -> Eval Value
evalBin (forall a. Ord a => a -> a -> Bool
(>) @Double) Value
n1 Value
n2
evalComp CompOp
Le Value
n1 Value
n2 = (Double -> Double -> Bool) -> Value -> Value -> Eval Value
forall a b c.
(HasValue a, HasValue b, HasValue c) =>
(a -> b -> c) -> Value -> Value -> Eval Value
evalBin (forall a. Ord a => a -> a -> Bool
(<=) @Double) Value
n1 Value
n2
evalComp CompOp
Ge Value
n1 Value
n2 = (Double -> Double -> Bool) -> Value -> Value -> Eval Value
forall a b c.
(HasValue a, HasValue b, HasValue c) =>
(a -> b -> c) -> Value -> Value -> Eval Value
evalBin (forall a. Ord a => a -> a -> Bool
(>=) @Double) Value
n1 Value
n2

evalLogical :: LogicalOp -> Thunk -> Thunk -> Eval Value
evalLogical :: LogicalOp -> Thunk -> Thunk -> Eval Value
evalLogical LogicalOp
LAnd Thunk
e1 Thunk
e2 = do
  Thunk -> Eval Value
force Thunk
e1 Eval Value -> (Value -> Eval Value) -> Eval Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    VBool Bool
True -> Thunk -> Eval Value
force Thunk
e2 Eval Value -> (Value -> Eval Value) -> Eval Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Value
x -> Bool -> Value
forall a. HasValue a => a -> Value
inj (Bool -> Value) -> Eval Bool -> Eval Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool -> Bool) -> Eval Bool -> Eval Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> a
id @Bool) (Value -> Eval Bool
forall a. HasValue a => Value -> Eval a
proj Value
x)
    VBool Bool
False -> Value -> Eval Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Value
VBool Bool
False)
    Value
v -> Text -> Value -> Eval Value
forall a. Text -> Value -> Eval a
throwTypeMismatch Text
"boolean" Value
v
evalLogical LogicalOp
LOr Thunk
e1 Thunk
e2 = do
  Thunk -> Eval Value
force Thunk
e1 Eval Value -> (Value -> Eval Value) -> Eval Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    VBool Bool
False -> Thunk -> Eval Value
force Thunk
e2 Eval Value -> (Value -> Eval Value) -> Eval Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Value
x -> Bool -> Value
forall a. HasValue a => a -> Value
inj (Bool -> Value) -> Eval Bool -> Eval Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool -> Bool) -> Eval Bool -> Eval Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> a
id @Bool) (Value -> Eval Bool
forall a. HasValue a => Value -> Eval a
proj Value
x)
    VBool Bool
True -> Value -> Eval Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Value
VBool Bool
True)
    Value
v -> Text -> Value -> Eval Value
forall a. Text -> Value -> Eval a
throwTypeMismatch Text
"boolean" Value
v

evalBitwise :: BitwiseOp -> Value -> Value -> Eval Value
evalBitwise :: BitwiseOp -> Value -> Value -> Eval Value
evalBitwise BitwiseOp
And = (Int64 -> Int64 -> Int64) -> Value -> Value -> Eval Value
forall a b c.
(HasValue a, HasValue b, HasValue c) =>
(a -> b -> c) -> Value -> Value -> Eval Value
evalBin (forall a. Bits a => a -> a -> a
(.&.) @Int64)
evalBitwise BitwiseOp
Or = (Int64 -> Int64 -> Int64) -> Value -> Value -> Eval Value
forall a b c.
(HasValue a, HasValue b, HasValue c) =>
(a -> b -> c) -> Value -> Value -> Eval Value
evalBin (forall a. Bits a => a -> a -> a
(.|.) @Int64)
evalBitwise BitwiseOp
Xor = (Int64 -> Int64 -> Int64) -> Value -> Value -> Eval Value
forall a b c.
(HasValue a, HasValue b, HasValue c) =>
(a -> b -> c) -> Value -> Value -> Eval Value
evalBin (forall a. Bits a => a -> a -> a
xor @Int64)
evalBitwise BitwiseOp
ShiftL = (Int64 -> Int -> Int64) -> Value -> Value -> Eval Value
forall a b c.
(HasValue a, HasValue b, HasValue c) =>
(a -> b -> c) -> Value -> Value -> Eval Value
evalBin (forall a. Bits a => a -> Int -> a
shiftL @Int64)
evalBitwise BitwiseOp
ShiftR = (Int64 -> Int -> Int64) -> Value -> Value -> Eval Value
forall a b c.
(HasValue a, HasValue b, HasValue c) =>
(a -> b -> c) -> Value -> Value -> Eval Value
evalBin (forall a. Bits a => a -> Int -> a
shiftR @Int64)

evalLookup :: Value -> Value -> Eval Value
evalLookup :: Value -> Value -> Eval Value
evalLookup (VArr Vector Thunk
a) (VNum Scientific
i)
  | Scientific -> Bool
isInteger Scientific
i =
    EvalError -> Maybe Thunk -> Eval Thunk
forall a. EvalError -> Maybe a -> Eval a
liftMaybe (Scientific -> EvalError
IndexOutOfBounds Scientific
i) ((Vector Thunk
a Vector Thunk -> Int -> Maybe Thunk
forall a. Vector a -> Int -> Maybe a
!?) (Int -> Maybe Thunk) -> Maybe Int -> Maybe Thunk
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Scientific -> Maybe Int
forall i. (Integral i, Bounded i) => Scientific -> Maybe i
toBoundedInteger Scientific
i) Eval Thunk -> (Thunk -> Eval Value) -> Eval Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Thunk -> Eval Value
force
evalLookup (VArr Vector Thunk
_) Value
_ =
  EvalError -> Eval Value
forall a. EvalError -> Eval a
throwE (Doc -> EvalError
InvalidIndex (Doc -> EvalError) -> Doc -> EvalError
forall a b. (a -> b) -> a -> b
$ Doc
"array index was not integer")
evalLookup (VObj Object
o) (VStr Text
s) =
  EvalError -> Maybe (Hideable Thunk) -> Eval (Hideable Thunk)
forall a. EvalError -> Maybe a -> Eval a
liftMaybe (Doc -> EvalError
NoSuchKey (Text -> Doc
forall a. Pretty a => a -> Doc
pretty Text
s)) (Text -> Object -> Maybe (Hideable Thunk)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
s Object
o)
    Eval (Hideable Thunk)
-> (Hideable Thunk -> Eval Value) -> Eval Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Hideable Thunk
v Visibility
_) -> Thunk -> Eval Value
force Thunk
v
evalLookup (VStr Text
s) (VNum Scientific
i) | Scientific -> Bool
isInteger Scientific
i = do
  EvalError -> Maybe Value -> Eval Value
forall a. EvalError -> Maybe a -> Eval a
liftMaybe (Scientific -> EvalError
IndexOutOfBounds Scientific
i) (Int -> Maybe Value
f (Int -> Maybe Value) -> Maybe Int -> Maybe Value
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Int
bounded)
  where
    f :: Int -> Maybe Value
f = Value -> Maybe Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Maybe Value) -> (Int -> Value) -> Int -> Maybe Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value
VStr (Text -> Value) -> (Int -> Text) -> Int -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton (Char -> Text) -> (Int -> Char) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int -> Char
T.index Text
s
    bounded :: Maybe Int
bounded =
      Scientific -> Maybe Int
forall i. (Integral i, Bounded i) => Scientific -> Maybe i
toBoundedInteger Scientific
i Maybe Int -> (Int -> Maybe Int) -> Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
i' ->
        if Text -> Int
T.length Text
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
i' Bool -> Bool -> Bool
&& Int
i' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
          then Maybe Int
forall a. Maybe a
Nothing
          else Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i'
evalLookup (VStr Text
_) Value
_ =
  EvalError -> Eval Value
forall a. EvalError -> Eval a
throwE (Doc -> EvalError
InvalidIndex (Doc -> EvalError) -> Doc -> EvalError
forall a b. (a -> b) -> a -> b
$ Doc
"string index was not integer")
evalLookup Value
v Value
_ = Text -> Value -> Eval Value
forall a. Text -> Value -> Eval a
throwTypeMismatch Text
"array/object/string" Value
v

evalLiteral :: Literal -> Eval Value
evalLiteral :: Literal -> Eval Value
evalLiteral = \case
  Literal
Null -> Value -> Eval Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
VNull
  Bool Bool
b -> Value -> Eval Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Eval Value) -> Value -> Eval Value
forall a b. (a -> b) -> a -> b
$ Bool -> Value
VBool Bool
b
  String Text
s -> Value -> Eval Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Eval Value) -> Value -> Eval Value
forall a b. (a -> b) -> a -> b
$ Text -> Value
VStr Text
s
  Number Scientific
n -> Value -> Eval Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Eval Value) -> Value -> Eval Value
forall a b. (a -> b) -> a -> b
$ Scientific -> Value
VNum Scientific
n

evalBin ::
  (HasValue a, HasValue b, HasValue c) =>
  (a -> b -> c) ->
  Value ->
  Value ->
  Eval Value
evalBin :: forall a b c.
(HasValue a, HasValue b, HasValue c) =>
(a -> b -> c) -> Value -> Value -> Eval Value
evalBin = (a -> b -> c) -> Value -> Value -> Eval Value
forall a b c.
(HasValue a, HasValue b, HasValue c) =>
(a -> b -> c) -> Value -> Value -> Eval Value
inj''

append :: Value -> Value -> Eval Text
append :: Value -> Value -> Eval Text
append Value
v1 Value
v2 = Text -> Text -> Text
T.append (Text -> Text -> Text) -> Eval Text -> Eval (Text -> Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Eval Text
toString Value
v1 Eval (Text -> Text) -> Eval Text -> Eval Text
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Eval Text
toString Value
v2

throwInvalidKey :: Value -> Eval a
throwInvalidKey :: forall a. Value -> Eval a
throwInvalidKey = EvalError -> Eval a
forall a. EvalError -> Eval a
throwE (EvalError -> Eval a) -> (Value -> EvalError) -> Value -> Eval a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> EvalError
InvalidKey (Doc -> EvalError) -> (Value -> Doc) -> Value -> EvalError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc
forall a. Pretty a => a -> Doc
pretty (Text -> Doc) -> (Value -> Text) -> Value -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Text
valueType

updateSpan :: Maybe SrcSpan -> Eval ()
updateSpan :: Maybe SrcSpan -> Eval ()
updateSpan Maybe SrcSpan
sp = (EvalState -> EvalState) -> Eval ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((EvalState -> EvalState) -> Eval ())
-> (EvalState -> EvalState) -> Eval ()
forall a b. (a -> b) -> a -> b
$ \EvalState
st -> EvalState
st {currentPos :: Maybe SrcSpan
currentPos = Maybe SrcSpan
sp}

toString :: Value -> Eval Text
toString :: Value -> Eval Text
toString (VStr Text
s) = Text -> Eval Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
s
toString Value
v = Text -> Text
toStrict (Text -> Text) -> (Value -> Text) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Text
forall a. ToJSON a => a -> Text
encodeToLazyText (Value -> Text) -> Eval Value -> Eval Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Eval Value
manifest Value
v

flattenArrays :: Vector (Vector Thunk) -> Vector Thunk
flattenArrays :: Vector (Vector Thunk) -> Vector Thunk
flattenArrays = Vector (Vector Thunk) -> Vector Thunk
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join

liftMaybe :: EvalError -> Maybe a -> Eval a
liftMaybe :: forall a. EvalError -> Maybe a -> Eval a
liftMaybe EvalError
e =
  \case
    Maybe a
Nothing -> EvalError -> Eval a
forall a. EvalError -> Eval a
throwE EvalError
e
    Just a
a -> a -> Eval a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a