{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE LambdaCase #-}

module Language.Ginger.Interpret.Eval
( Eval (..)
, EvalState (..)
, evalE
, evalS
, evalSs
, evalT
, stringify
, valuesEqual
, asBool
, asTruth
, getAttr
, getAttrRaw
, getItem
, getItemRaw
, loadTemplate
)
where

import Language.Ginger.AST
import Language.Ginger.Interpret.Builtins
import Language.Ginger.Interpret.Type
import Language.Ginger.Parse (parseGinger)
import qualified Language.Ginger.Parse as Parse
import Language.Ginger.RuntimeError
import Language.Ginger.SourcePosition
import Language.Ginger.Value

import Control.Monad (foldM, forM, void)
import Control.Monad.Except
  ( MonadError (..)
  , throwError
  )
import Control.Monad.Random (MonadRandom)
import Control.Monad.Reader (ask , asks, local, MonadReader (..))
import Control.Monad.State (gets)
import Control.Monad.Trans (lift, MonadTrans (..))
import Data.ByteString (ByteString)
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Lazy as LBS
import Data.Digest.Pure.SHA (sha256, showDigest)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe (catMaybes, fromMaybe)
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Text.Encoding (encodeUtf8)
import Data.Vector (Vector)
import qualified Data.Vector as V

hashShow :: Show a => a -> Text
hashShow :: forall a. Show a => a -> Text
hashShow = String -> Text
Text.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest SHA256State -> String
forall t. Digest t -> String
showDigest (Digest SHA256State -> String)
-> (a -> Digest SHA256State) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Digest SHA256State
sha256 (ByteString -> Digest SHA256State)
-> (a -> ByteString) -> a -> Digest SHA256State
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictByteString -> ByteString
LBS.fromStrict (StrictByteString -> ByteString)
-> (a -> StrictByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> StrictByteString
encodeUtf8 (Text -> StrictByteString) -> (a -> Text) -> a -> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. Show a => a -> Text
Text.show

loadTemplate :: Monad m => Text -> GingerT m LoadedTemplate
loadTemplate :: forall (m :: * -> *). Monad m => Text -> GingerT m LoadedTemplate
loadTemplate Text
name = do
  sMay <- Text -> GingerT m (Maybe LoadedTemplate)
forall (m :: * -> *).
Monad m =>
Text -> GingerT m (Maybe LoadedTemplate)
loadTemplateMaybe Text
name
  case sMay of
    Maybe LoadedTemplate
Nothing -> RuntimeError -> GingerT m LoadedTemplate
forall a. RuntimeError -> GingerT m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (RuntimeError -> GingerT m LoadedTemplate)
-> RuntimeError -> GingerT m LoadedTemplate
forall a b. (a -> b) -> a -> b
$ Text -> RuntimeError
TemplateFileNotFoundError Text
name
    Just LoadedTemplate
s -> LoadedTemplate -> GingerT m LoadedTemplate
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LoadedTemplate
s

loadTemplateMaybe :: Monad m => Text -> GingerT m (Maybe LoadedTemplate)
loadTemplateMaybe :: forall (m :: * -> *).
Monad m =>
Text -> GingerT m (Maybe LoadedTemplate)
loadTemplateMaybe Text
name = do
  loader <- (Context m -> TemplateLoader m) -> GingerT m (TemplateLoader m)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Context m -> TemplateLoader m
forall (m :: * -> *). Context m -> TemplateLoader m
contextLoadTemplateFile
  srcMay <- lift (loader name)
  case srcMay of
    Maybe Text
Nothing -> Maybe LoadedTemplate -> GingerT m (Maybe LoadedTemplate)
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe LoadedTemplate
forall a. Maybe a
Nothing
    Just Text
src -> do
      let result :: Either String Template
result = P Template -> String -> Text -> Either String Template
forall a. P a -> String -> Text -> Either String a
parseGinger P Template
Parse.template (Text -> String
Text.unpack Text
name) Text
src
      case Either String Template
result of
        Left String
err ->
          RuntimeError -> GingerT m (Maybe LoadedTemplate)
forall a. RuntimeError -> GingerT m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (RuntimeError -> GingerT m (Maybe LoadedTemplate))
-> RuntimeError -> GingerT m (Maybe LoadedTemplate)
forall a b. (a -> b) -> a -> b
$ Text -> Text -> RuntimeError
TemplateParseError Text
name (String -> Text
Text.pack String
err)
        Right Template
t -> do
          parent <- Maybe Text
-> (Text -> GingerT m LoadedTemplate)
-> GingerT m (Maybe LoadedTemplate)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Template -> Maybe Text
templateParent Template
t) Text -> GingerT m LoadedTemplate
forall (m :: * -> *). Monad m => Text -> GingerT m LoadedTemplate
loadTemplate
          let body = Template -> Statement
templateBody Template
t
          pure . Just $ LoadedTemplate parent body

mapArgs :: forall m. MonadRandom m
        => Text
        -> [(Identifier, Maybe (Value m))]
        -> [(Maybe Identifier, Value m)]
        -> GingerT m (Map Identifier (Value m))
mapArgs :: forall (m :: * -> *).
MonadRandom m =>
Text
-> [(Identifier, Maybe (Value m))]
-> [(Maybe Identifier, Value m)]
-> GingerT m (Map Identifier (Value m))
mapArgs Text
context [(Identifier, Maybe (Value m))]
spec [(Maybe Identifier, Value m)]
args =
  [(Identifier, Maybe (Value m))]
-> [Value m]
-> Map Identifier (Value m)
-> GingerT m (Map Identifier (Value m))
go [(Identifier, Maybe (Value m))]
spec [Value m]
posArgs Map Identifier (Value m)
kwArgs
  where
    posArgs :: [Value m]
posArgs = [ Value m
v | (Maybe Identifier
Nothing, Value m
v) <- [(Maybe Identifier, Value m)]
args ]
    kwArgs :: Map Identifier (Value m)
kwArgs = [(Identifier, Value m)] -> Map Identifier (Value m)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (Identifier
k, Value m
v) | (Just Identifier
k, Value m
v) <- [(Maybe Identifier, Value m)]
args ]

    go :: [(Identifier, Maybe (Value m))]
       -> [Value m]
       -> Map Identifier (Value m)
       -> GingerT m (Map Identifier (Value m))
    go :: [(Identifier, Maybe (Value m))]
-> [Value m]
-> Map Identifier (Value m)
-> GingerT m (Map Identifier (Value m))
go ((Identifier
name, Maybe (Value m)
defEMay):[(Identifier, Maybe (Value m))]
specs) [Value m]
ps Map Identifier (Value m)
kw = do
      case Identifier -> Map Identifier (Value m) -> Maybe (Value m)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Identifier
name Map Identifier (Value m)
kw of
        Just Value m
val -> do
          -- Found keyword argument
          let cur :: Map Identifier (Value m)
cur = Identifier -> Value m -> Map Identifier (Value m)
forall k a. k -> a -> Map k a
Map.singleton Identifier
name Value m
val
          rest <- [(Identifier, Maybe (Value m))]
-> [Value m]
-> Map Identifier (Value m)
-> GingerT m (Map Identifier (Value m))
go [(Identifier, Maybe (Value m))]
specs [Value m]
ps (Identifier -> Map Identifier (Value m) -> Map Identifier (Value m)
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Identifier
name Map Identifier (Value m)
kw)
          pure $ cur <> rest
        Maybe (Value m)
Nothing ->
          -- No keyword argument found, look for positional argument
          case [Value m]
ps of
            (Value m
val:[Value m]
ps') -> do
              let cur :: Map Identifier (Value m)
cur = Identifier -> Value m -> Map Identifier (Value m)
forall k a. k -> a -> Map k a
Map.singleton Identifier
name Value m
val
              rest <- [(Identifier, Maybe (Value m))]
-> [Value m]
-> Map Identifier (Value m)
-> GingerT m (Map Identifier (Value m))
go [(Identifier, Maybe (Value m))]
specs [Value m]
ps' Map Identifier (Value m)
kw
              pure $ cur <> rest
            [] -> do
              -- No positional argument found, see if we have a default
              case Maybe (Value m)
defEMay of
                Just Value m
defE -> do
                  let cur :: Map Identifier (Value m)
cur = Identifier -> Value m -> Map Identifier (Value m)
forall k a. k -> a -> Map k a
Map.singleton Identifier
name Value m
defE
                  rest <- [(Identifier, Maybe (Value m))]
-> [Value m]
-> Map Identifier (Value m)
-> GingerT m (Map Identifier (Value m))
go [(Identifier, Maybe (Value m))]
specs [Value m]
ps Map Identifier (Value m)
kw
                  pure $ cur <> rest
                Maybe (Value m)
Nothing ->
                  RuntimeError -> GingerT m (Map Identifier (Value m))
forall a. RuntimeError -> GingerT m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (RuntimeError -> GingerT m (Map Identifier (Value m)))
-> RuntimeError -> GingerT m (Map Identifier (Value m))
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Text -> RuntimeError
ArgumentError Text
context (Identifier -> Text
identifierName Identifier
name) Text
"argument" Text
"end of arguments"
    go [] [Value m]
_ Map Identifier (Value m)
_ =
      Map Identifier (Value m) -> GingerT m (Map Identifier (Value m))
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map Identifier (Value m)
forall a. Monoid a => a
mempty
  
evalCallArgs :: MonadRandom m => [Expr] -> [(Identifier, Expr)] -> GingerT m [(Maybe Identifier, Value m)]
evalCallArgs :: forall (m :: * -> *).
MonadRandom m =>
[Expr]
-> [(Identifier, Expr)] -> GingerT m [(Maybe Identifier, Value m)]
evalCallArgs [Expr]
posArgsExpr [(Identifier, Expr)]
namedArgsExpr = do
  posArgs <- (Expr -> GingerT m (Value m)) -> [Expr] -> GingerT m [Value m]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Expr -> GingerT m (Value m)
forall (m :: * -> *). MonadRandom m => Expr -> GingerT m (Value m)
evalE [Expr]
posArgsExpr
  namedArgs <- mapM evalNamedArg namedArgsExpr
  pure $ zip (repeat Nothing) posArgs ++ namedArgs

callTest :: MonadRandom m => Value m -> Expr -> [Expr] -> [(Identifier, Expr)] -> GingerT m (Value m)
callTest :: forall (m :: * -> *).
MonadRandom m =>
Value m
-> Expr -> [Expr] -> [(Identifier, Expr)] -> GingerT m (Value m)
callTest Value m
testV Expr
scrutinee [Expr]
posArgsExpr [(Identifier, Expr)]
namedArgsExpr = do
  case Value m
testV of
    TestV Test m
t -> do
      args <- [Expr]
-> [(Identifier, Expr)] -> GingerT m [(Maybe Identifier, Value m)]
forall (m :: * -> *).
MonadRandom m =>
[Expr]
-> [(Identifier, Expr)] -> GingerT m [(Maybe Identifier, Value m)]
evalCallArgs [Expr]
posArgsExpr [(Identifier, Expr)]
namedArgsExpr
      ctx <- ask
      env <- gets evalEnv
      BoolV <$> native (runTest t scrutinee args ctx env)

    ScalarV {} -> do
      Bool -> Value m
forall (m :: * -> *). Bool -> Value m
BoolV (Bool -> Value m) -> GingerT m Bool -> GingerT m (Value m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value m -> Value m -> GingerT m Bool
forall (m :: * -> *).
Monad m =>
Value m -> Value m -> GingerT m Bool
valuesEqual Value m
testV (Value m -> GingerT m Bool)
-> GingerT m (Value m) -> GingerT m Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Expr -> GingerT m (Value m)
forall (m :: * -> *). MonadRandom m => Expr -> GingerT m (Value m)
evalE Expr
scrutinee)
      GingerT m (Value m)
-> (RuntimeError -> GingerT m (Value m)) -> GingerT m (Value m)
forall a.
GingerT m a -> (RuntimeError -> GingerT m a) -> GingerT m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` \RuntimeError
err -> case RuntimeError
err of
        NotInScopeError {} -> Value m -> GingerT m (Value m)
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value m
forall (m :: * -> *). Value m
FalseV
        RuntimeError
_ -> RuntimeError -> GingerT m (Value m)
forall a. RuntimeError -> GingerT m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError RuntimeError
err
      
    Value m
x -> do
      Maybe (Value m)
-> Value m -> [Expr] -> [(Identifier, Expr)] -> GingerT m (Value m)
forall (m :: * -> *).
MonadRandom m =>
Maybe (Value m)
-> Value m -> [Expr] -> [(Identifier, Expr)] -> GingerT m (Value m)
call Maybe (Value m)
forall a. Maybe a
Nothing Value m
x (Expr
scrutinee Expr -> [Expr] -> [Expr]
forall a. a -> [a] -> [a]
: [Expr]
posArgsExpr) [(Identifier, Expr)]
namedArgsExpr

callFilter :: MonadRandom m => Value m -> Expr -> [Expr] -> [(Identifier, Expr)] -> GingerT m (Value m)
callFilter :: forall (m :: * -> *).
MonadRandom m =>
Value m
-> Expr -> [Expr] -> [(Identifier, Expr)] -> GingerT m (Value m)
callFilter Value m
filterV Expr
scrutinee [Expr]
posArgsExpr [(Identifier, Expr)]
namedArgsExpr = do
  case Value m
filterV of
    FilterV Filter m
f -> do
      args <- [Expr]
-> [(Identifier, Expr)] -> GingerT m [(Maybe Identifier, Value m)]
forall (m :: * -> *).
MonadRandom m =>
[Expr]
-> [(Identifier, Expr)] -> GingerT m [(Maybe Identifier, Value m)]
evalCallArgs [Expr]
posArgsExpr [(Identifier, Expr)]
namedArgsExpr
      ctx <- ask
      env <- gets evalEnv
      native (runFilter f scrutinee args ctx env)

    ScalarV {} -> do
      Bool -> Value m
forall (m :: * -> *). Bool -> Value m
BoolV (Bool -> Value m) -> GingerT m Bool -> GingerT m (Value m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value m -> Value m -> GingerT m Bool
forall (m :: * -> *).
Monad m =>
Value m -> Value m -> GingerT m Bool
valuesEqual Value m
filterV (Value m -> GingerT m Bool)
-> GingerT m (Value m) -> GingerT m Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Expr -> GingerT m (Value m)
forall (m :: * -> *). MonadRandom m => Expr -> GingerT m (Value m)
evalE Expr
scrutinee)
      GingerT m (Value m)
-> (RuntimeError -> GingerT m (Value m)) -> GingerT m (Value m)
forall a.
GingerT m a -> (RuntimeError -> GingerT m a) -> GingerT m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` \RuntimeError
err -> case RuntimeError
err of
        NotInScopeError {} -> Value m -> GingerT m (Value m)
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value m
forall (m :: * -> *). Value m
FalseV
        RuntimeError
_ -> RuntimeError -> GingerT m (Value m)
forall a. RuntimeError -> GingerT m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError RuntimeError
err
      
    Value m
x -> do
      Maybe (Value m)
-> Value m -> [Expr] -> [(Identifier, Expr)] -> GingerT m (Value m)
forall (m :: * -> *).
MonadRandom m =>
Maybe (Value m)
-> Value m -> [Expr] -> [(Identifier, Expr)] -> GingerT m (Value m)
call Maybe (Value m)
forall a. Maybe a
Nothing Value m
x (Expr
scrutinee Expr -> [Expr] -> [Expr]
forall a. a -> [a] -> [a]
: [Expr]
posArgsExpr) [(Identifier, Expr)]
namedArgsExpr


call :: MonadRandom m => Maybe (Value m) -> Value m -> [Expr] -> [(Identifier, Expr)] -> GingerT m (Value m)
call :: forall (m :: * -> *).
MonadRandom m =>
Maybe (Value m)
-> Value m -> [Expr] -> [(Identifier, Expr)] -> GingerT m (Value m)
call Maybe (Value m)
callerMay Value m
callable [Expr]
posArgsExpr [(Identifier, Expr)]
namedArgsExpr = do
  args <- [Expr]
-> [(Identifier, Expr)] -> GingerT m [(Maybe Identifier, Value m)]
forall (m :: * -> *).
MonadRandom m =>
[Expr]
-> [(Identifier, Expr)] -> GingerT m [(Maybe Identifier, Value m)]
evalCallArgs [Expr]
posArgsExpr [(Identifier, Expr)]
namedArgsExpr
  case callable of
    ProcedureV (NativeProcedure ObjectID
_ Maybe ProcedureDoc
_ [(Maybe Identifier, Value m)]
-> Context m -> m (Either RuntimeError (Value m))
f) ->
      Env m -> GingerT m (Value m) -> GingerT m (Value m)
forall (m :: * -> *) a.
Monad m =>
Env m -> GingerT m a -> GingerT m a
withEnv Env m
forall a. Monoid a => a
mempty (GingerT m (Value m) -> GingerT m (Value m))
-> GingerT m (Value m) -> GingerT m (Value m)
forall a b. (a -> b) -> a -> b
$ do
        ctx <- GingerT m (Context m)
forall r (m :: * -> *). MonadReader r m => m r
ask
        native $ f args ctx
    ProcedureV (GingerProcedure Env m
env [(Identifier, Maybe (Value m))]
argsSig Expr
f) -> do
      Env m -> GingerT m (Value m) -> GingerT m (Value m)
forall (m :: * -> *) a.
Monad m =>
Env m -> GingerT m a -> GingerT m a
withEnv Env m
env (GingerT m (Value m) -> GingerT m (Value m))
-> GingerT m (Value m) -> GingerT m (Value m)
forall a b. (a -> b) -> a -> b
$ do
        GingerT m ()
-> (Value m -> GingerT m ()) -> Maybe (Value m) -> GingerT m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> GingerT m ()
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (Identifier -> Value m -> GingerT m ()
forall (m :: * -> *).
Monad m =>
Identifier -> Value m -> GingerT m ()
setVar Identifier
"caller") Maybe (Value m)
callerMay
        argDict <- Text
-> [(Identifier, Maybe (Value m))]
-> [(Maybe Identifier, Value m)]
-> GingerT m (Map Identifier (Value m))
forall (m :: * -> *).
MonadRandom m =>
Text
-> [(Identifier, Maybe (Value m))]
-> [(Maybe Identifier, Value m)]
-> GingerT m (Map Identifier (Value m))
mapArgs Text
"macro" [(Identifier, Maybe (Value m))]
argsSig [(Maybe Identifier, Value m)]
args
        scoped $ do
          setVars argDict
          evalE f
    ProcedureV Procedure m
NamespaceProcedure -> do
      refID <- Value m -> GingerT m RefID
forall (m :: * -> *) (t :: (* -> *) -> * -> *).
(Monad m, MonadTrans t, MonadState (EvalState m) (t m)) =>
Value m -> t m RefID
allocMutable (Map Scalar (Value m) -> Value m
forall (m :: * -> *). Map Scalar (Value m) -> Value m
DictV Map Scalar (Value m)
forall a. Monoid a => a
mempty)
      pure $ MutableRefV refID
    DictV Map Scalar (Value m)
m -> do
      let callable' :: Maybe (Value m)
callable' = Scalar -> Map Scalar (Value m) -> Maybe (Value m)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Scalar
"__call__" Map Scalar (Value m)
m
      case Maybe (Value m)
callable' of
        Maybe (Value m)
Nothing -> RuntimeError -> GingerT m (Value m)
forall a. RuntimeError -> GingerT m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (RuntimeError -> GingerT m (Value m))
-> RuntimeError -> GingerT m (Value m)
forall a b. (a -> b) -> a -> b
$ Text -> RuntimeError
NonCallableObjectError Text
"dict"
        Just Value m
c -> Maybe (Value m)
-> Value m -> [Expr] -> [(Identifier, Expr)] -> GingerT m (Value m)
forall (m :: * -> *).
MonadRandom m =>
Maybe (Value m)
-> Value m -> [Expr] -> [(Identifier, Expr)] -> GingerT m (Value m)
call Maybe (Value m)
callerMay Value m
c [Expr]
posArgsExpr [(Identifier, Expr)]
namedArgsExpr
    NativeV NativeObject m
obj -> do
      case NativeObject m
-> Maybe
     (NativeObject m
      -> [(Maybe Identifier, Value m)]
      -> m (Either RuntimeError (Value m)))
forall (m :: * -> *).
NativeObject m
-> Maybe
     (NativeObject m
      -> [(Maybe Identifier, Value m)]
      -> m (Either RuntimeError (Value m)))
nativeObjectCall NativeObject m
obj of
        Just NativeObject m
-> [(Maybe Identifier, Value m)]
-> m (Either RuntimeError (Value m))
f -> m (Either RuntimeError (Value m)) -> GingerT m (Value m)
forall (m :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad m, MonadTrans t, MonadError RuntimeError (t m)) =>
m (Either RuntimeError a) -> t m a
native (m (Either RuntimeError (Value m)) -> GingerT m (Value m))
-> m (Either RuntimeError (Value m)) -> GingerT m (Value m)
forall a b. (a -> b) -> a -> b
$ NativeObject m
-> [(Maybe Identifier, Value m)]
-> m (Either RuntimeError (Value m))
f NativeObject m
obj [(Maybe Identifier, Value m)]
args
        Maybe
  (NativeObject m
   -> [(Maybe Identifier, Value m)]
   -> m (Either RuntimeError (Value m)))
Nothing -> RuntimeError -> GingerT m (Value m)
forall a. RuntimeError -> GingerT m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (RuntimeError -> GingerT m (Value m))
-> RuntimeError -> GingerT m (Value m)
forall a b. (a -> b) -> a -> b
$ Text -> RuntimeError
NonCallableObjectError Text
"native object"
    Value m
x ->
      RuntimeError -> GingerT m (Value m)
forall a. RuntimeError -> GingerT m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (RuntimeError -> GingerT m (Value m))
-> RuntimeError -> GingerT m (Value m)
forall a b. (a -> b) -> a -> b
$ Text -> RuntimeError
NonCallableObjectError (Value m -> Text
forall (m :: * -> *). Value m -> Text
tagNameOf Value m
x)

-- | 'Eval' represents types that can be evaluated in some 'GingerT m' monadic
-- context.
class Eval m a where
  eval :: a -> GingerT m (Value m)

instance MonadRandom m => Eval m Expr where
  eval :: Expr -> GingerT m (Value m)
eval = Expr -> GingerT m (Value m)
forall (m :: * -> *). MonadRandom m => Expr -> GingerT m (Value m)
evalE

instance MonadRandom m => Eval m Statement where
  eval :: Statement -> GingerT m (Value m)
eval = Statement -> GingerT m (Value m)
forall (m :: * -> *).
MonadRandom m =>
Statement -> GingerT m (Value m)
evalS

instance MonadRandom m => Eval m Template where
  eval :: Template -> GingerT m (Value m)
eval = Template -> GingerT m (Value m)
forall (m :: * -> *).
MonadRandom m =>
Template -> GingerT m (Value m)
evalT

-- | Evaluate an expression, dereferencing mutable refs.
evalE :: MonadRandom m => Expr -> GingerT m (Value m)
evalE :: forall (m :: * -> *). MonadRandom m => Expr -> GingerT m (Value m)
evalE Expr
expr =
  Expr -> GingerT m (Value m)
forall (m :: * -> *). MonadRandom m => Expr -> GingerT m (Value m)
evalE' Expr
expr GingerT m (Value m)
-> (Value m -> GingerT m (Value m)) -> GingerT m (Value m)
forall a b. GingerT m a -> (a -> GingerT m b) -> GingerT m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    MutableRefV RefID
refID -> RefID -> GingerT m (Value m)
forall (m :: * -> *). Monad m => RefID -> GingerT m (Value m)
derefMutable RefID
refID
    Value m
v -> Value m -> GingerT m (Value m)
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value m
v

-- | Evaluate an expression without dereferencing mutable refs.
evalE' :: MonadRandom m => Expr -> GingerT m (Value m)
evalE' :: forall (m :: * -> *). MonadRandom m => Expr -> GingerT m (Value m)
evalE' (PositionedE SourcePosition
pos Expr
e) = do
  Expr -> GingerT m (Value m)
forall (m :: * -> *). MonadRandom m => Expr -> GingerT m (Value m)
evalE Expr
e GingerT m (Value m)
-> (RuntimeError -> GingerT m (Value m)) -> GingerT m (Value m)
forall a.
GingerT m a -> (RuntimeError -> GingerT m a) -> GingerT m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` SourcePosition -> RuntimeError -> GingerT m (Value m)
forall (m :: * -> *) a.
Monad m =>
SourcePosition -> RuntimeError -> GingerT m a
decorateError SourcePosition
pos
evalE' Expr
NoneE = Value m -> GingerT m (Value m)
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value m
forall (m :: * -> *). Value m
NoneV
evalE' (BoolE Bool
b) = Value m -> GingerT m (Value m)
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Value m
forall (m :: * -> *). Bool -> Value m
BoolV Bool
b)
evalE' (StringLitE Text
s) = Value m -> GingerT m (Value m)
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Value m
forall (m :: * -> *). Text -> Value m
StringV Text
s)
evalE' (IntLitE Integer
i) = Value m -> GingerT m (Value m)
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Value m
forall (m :: * -> *). Integer -> Value m
IntV Integer
i)
evalE' (FloatLitE Double
d) = Value m -> GingerT m (Value m)
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> Value m
forall (m :: * -> *). Double -> Value m
FloatV Double
d)
evalE' (ListE Vector Expr
xs) = Vector (Value m) -> Value m
forall (m :: * -> *). Vector (Value m) -> Value m
ListV (Vector (Value m) -> Value m)
-> GingerT m (Vector (Value m)) -> GingerT m (Value m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Expr -> GingerT m (Value m))
-> Vector Expr -> GingerT m (Vector (Value m))
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
V.mapM Expr -> GingerT m (Value m)
forall (m :: * -> *). MonadRandom m => Expr -> GingerT m (Value m)
evalE Vector Expr
xs
evalE' (DictE [(Expr, Expr)]
xs) =
  Map Scalar (Value m) -> Value m
forall (m :: * -> *). Map Scalar (Value m) -> Value m
DictV (Map Scalar (Value m) -> Value m)
-> ([(Scalar, Value m)] -> Map Scalar (Value m))
-> [(Scalar, Value m)]
-> Value m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Scalar, Value m)] -> Map Scalar (Value m)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Scalar, Value m)] -> Value m)
-> GingerT m [(Scalar, Value m)] -> GingerT m (Value m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Expr, Expr) -> GingerT m (Scalar, Value m))
-> [(Expr, Expr)] -> GingerT m [(Scalar, Value m)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Expr, Expr) -> GingerT m (Scalar, Value m)
forall (m :: * -> *).
MonadRandom m =>
(Expr, Expr) -> GingerT m (Scalar, Value m)
evalKV [(Expr, Expr)]
xs
evalE' (UnaryE UnaryOperator
op Expr
expr) = do
  v <- Expr -> GingerT m (Value m)
forall (m :: * -> *). MonadRandom m => Expr -> GingerT m (Value m)
evalE Expr
expr
  evalUnary op v
evalE' (BinaryE BinaryOperator
op Expr
aExpr Expr
bExpr) = do
  a <- Expr -> GingerT m (Value m)
forall (m :: * -> *). MonadRandom m => Expr -> GingerT m (Value m)
evalE Expr
aExpr
  b <- evalE bExpr
  evalBinary op a b
evalE' (DotE Expr
aExpr Identifier
b) = do
  a <- Expr -> GingerT m (Value m)
forall (m :: * -> *). MonadRandom m => Expr -> GingerT m (Value m)
evalE Expr
aExpr
  attrMay <- getAttr a b
  case attrMay of
    Just Value m
attr -> Value m -> GingerT m (Value m)
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value m
attr
    Maybe (Value m)
Nothing -> do
      itemMay <- Value m -> Value m -> GingerT m (Maybe (Value m))
forall (m :: * -> *).
Monad m =>
Value m -> Value m -> GingerT m (Maybe (Value m))
getItem Value m
a (Text -> Value m
forall (m :: * -> *). Text -> Value m
StringV (Text -> Value m) -> (Identifier -> Text) -> Identifier -> Value m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Text
identifierName (Identifier -> Value m) -> Identifier -> Value m
forall a b. (a -> b) -> a -> b
$ Identifier
b)
      case itemMay of
        Just Value m
item -> Value m -> GingerT m (Value m)
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value m
item
        Maybe (Value m)
Nothing -> RuntimeError -> GingerT m (Value m)
forall a. RuntimeError -> GingerT m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (RuntimeError -> GingerT m (Value m))
-> RuntimeError -> GingerT m (Value m)
forall a b. (a -> b) -> a -> b
$ Text -> RuntimeError
NotInScopeError (Value m -> Text
forall a. Show a => a -> Text
Text.show Value m
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Identifier -> Text
forall a. Show a => a -> Text
Text.show Identifier
b)
evalE' (SliceE Expr
sliceeE Maybe Expr
beginEMay Maybe Expr
endEMay) = do
  slicee <- Expr -> GingerT m (Value m)
forall (m :: * -> *). MonadRandom m => Expr -> GingerT m (Value m)
evalE Expr
sliceeE
  beginMay <- mapM evalE beginEMay
  endMay <- mapM evalE endEMay
  sliceValue slicee beginMay endMay
evalE' (CallE Expr
callableExpr [Expr]
posArgsExpr [(Identifier, Expr)]
namedArgsExpr) = do
  callable <- Expr -> GingerT m (Value m)
forall (m :: * -> *). MonadRandom m => Expr -> GingerT m (Value m)
evalE Expr
callableExpr
  call Nothing callable posArgsExpr namedArgsExpr
evalE' (FilterE Expr
scrutinee Expr
filterE [Expr]
args [(Identifier, Expr)]
kwargs) = do
  f <- GingerT m (Value m) -> GingerT m (Value m)
forall (m :: * -> *) a. Monad m => GingerT m a -> GingerT m a
withJinjaFilters (Expr -> GingerT m (Value m)
forall (m :: * -> *) a. Eval m a => a -> GingerT m (Value m)
eval Expr
filterE)
  callFilter f scrutinee args kwargs
evalE' (TernaryE Expr
condExpr Expr
yesExpr Expr
noExpr) = do
  cond <- Expr -> GingerT m (Value m)
forall (m :: * -> *). MonadRandom m => Expr -> GingerT m (Value m)
evalE Expr
condExpr GingerT m (Value m)
-> (Value m -> GingerT m Bool) -> GingerT m Bool
forall a b. GingerT m a -> (a -> GingerT m b) -> GingerT m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Value m -> GingerT m Bool
forall (m :: * -> *). Monad m => Text -> Value m -> GingerT m Bool
asTruth Text
"condition"
  evalE (if cond then yesExpr else noExpr)
evalE' (VarE Identifier
name) =
  Identifier -> GingerT m (Value m)
forall (m :: * -> *). Monad m => Identifier -> GingerT m (Value m)
lookupVar Identifier
name
evalE' (StatementE Statement
statement) = do
  Statement -> GingerT m (Value m)
forall (m :: * -> *).
MonadRandom m =>
Statement -> GingerT m (Value m)
evalS Statement
statement
evalE' (IsE Expr
scrutinee Expr
testE [Expr]
args [(Identifier, Expr)]
kwargs) = do
  t <- GingerT m (Value m) -> GingerT m (Value m)
forall (m :: * -> *) a. Monad m => GingerT m a -> GingerT m a
withJinjaTests (Expr -> GingerT m (Value m)
forall (m :: * -> *). MonadRandom m => Expr -> GingerT m (Value m)
evalE Expr
testE)
  callTest t scrutinee args kwargs

evalKV :: MonadRandom m => (Expr, Expr) -> GingerT m (Scalar, Value m)
evalKV :: forall (m :: * -> *).
MonadRandom m =>
(Expr, Expr) -> GingerT m (Scalar, Value m)
evalKV (Expr
kExpr, Expr
vExpr) = do
  kVal <- Expr -> GingerT m (Value m)
forall (m :: * -> *). MonadRandom m => Expr -> GingerT m (Value m)
evalE Expr
kExpr
  kScalar <- case kVal of
    ScalarV Scalar
s -> Scalar -> GingerT m Scalar
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Scalar
s
    Value m
x -> RuntimeError -> GingerT m Scalar
forall a. RuntimeError -> GingerT m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (RuntimeError -> GingerT m Scalar)
-> RuntimeError -> GingerT m Scalar
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> RuntimeError
TagError Text
"dict key" Text
"scalar" (Value m -> Text
forall (m :: * -> *). Value m -> Text
tagNameOf Value m
x)
  vVal <- evalE vExpr
  return (kScalar, vVal)

evalNamedArg :: MonadRandom m => (Identifier, Expr) -> GingerT m (Maybe Identifier, Value m)
evalNamedArg :: forall (m :: * -> *).
MonadRandom m =>
(Identifier, Expr) -> GingerT m (Maybe Identifier, Value m)
evalNamedArg (Identifier
kIdent, Expr
vExpr) = do
  vVal <- Expr -> GingerT m (Value m)
forall (m :: * -> *). MonadRandom m => Expr -> GingerT m (Value m)
evalE Expr
vExpr
  return (Just kIdent, vVal)

sliceVector :: Vector a -> Maybe Int -> Maybe Int -> Vector a
sliceVector :: forall a. Vector a -> Maybe Int -> Maybe Int -> Vector a
sliceVector Vector a
xs Maybe Int
startMay Maybe Int
endMay =
  let start :: Int
start = case Maybe Int
startMay of
                Maybe Int
Nothing -> Int
0
                Just Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 -> Vector a -> Int
forall a. Vector a -> Int
V.length Vector a
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n
                Just Int
n -> Int
n
      end :: Int
end = case Maybe Int
endMay of
                Maybe Int
Nothing -> Vector a -> Int
forall a. Vector a -> Int
V.length Vector a
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start
                Just Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 -> Vector a -> Int
forall a. Vector a -> Int
V.length Vector a
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n
                Just Int
n -> Int
n
  in Int -> Vector a -> Vector a
forall a. Int -> Vector a -> Vector a
V.take Int
end (Vector a -> Vector a)
-> (Vector a -> Vector a) -> Vector a -> Vector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Vector a -> Vector a
forall a. Int -> Vector a -> Vector a
V.drop Int
start (Vector a -> Vector a) -> Vector a -> Vector a
forall a b. (a -> b) -> a -> b
$ Vector a
xs

sliceText :: Text -> Maybe Int -> Maybe Int -> Text
sliceText :: Text -> Maybe Int -> Maybe Int -> Text
sliceText Text
xs Maybe Int
startMay Maybe Int
endMay =
  let start :: Int
start = case Maybe Int
startMay of
                Maybe Int
Nothing -> Int
0
                Just Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 -> Text -> Int
Text.length Text
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n
                Just Int
n -> Int
n
      end :: Int
end = case Maybe Int
endMay of
                Maybe Int
Nothing -> Text -> Int
Text.length Text
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start
                Just Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 -> Text -> Int
Text.length Text
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n
                Just Int
n -> Int
n
  in Int -> Text -> Text
Text.take Int
end (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
Text.drop Int
start (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
xs

sliceByteString :: ByteString -> Maybe Int -> Maybe Int -> ByteString
sliceByteString :: StrictByteString -> Maybe Int -> Maybe Int -> StrictByteString
sliceByteString StrictByteString
xs Maybe Int
startMay Maybe Int
endMay =
  let start :: Int
start = case Maybe Int
startMay of
                Maybe Int
Nothing -> Int
0
                Just Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 -> StrictByteString -> Int
ByteString.length StrictByteString
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n
                Just Int
n -> Int
n
      end :: Int
end = case Maybe Int
endMay of
                Maybe Int
Nothing -> StrictByteString -> Int
ByteString.length StrictByteString
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start
                Just Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 -> StrictByteString -> Int
ByteString.length StrictByteString
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n
                Just Int
n -> Int
n
  in Int -> StrictByteString -> StrictByteString
ByteString.take Int
end (StrictByteString -> StrictByteString)
-> (StrictByteString -> StrictByteString)
-> StrictByteString
-> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> StrictByteString -> StrictByteString
ByteString.drop Int
start (StrictByteString -> StrictByteString)
-> StrictByteString -> StrictByteString
forall a b. (a -> b) -> a -> b
$ StrictByteString
xs

sliceValue :: Monad m
           => Value m
           -> Maybe (Value m)
           -> Maybe (Value m)
           -> GingerT m (Value m)
sliceValue :: forall (m :: * -> *).
Monad m =>
Value m
-> Maybe (Value m) -> Maybe (Value m) -> GingerT m (Value m)
sliceValue (ListV Vector (Value m)
xs) Maybe (Value m)
startValMay Maybe (Value m)
endValMay = do
  startMay <- (Value m -> GingerT m Integer)
-> Maybe (Value m) -> GingerT m (Maybe Integer)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM (m (Either RuntimeError Integer) -> GingerT m Integer
forall (m :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad m, MonadTrans t, MonadError RuntimeError (t m)) =>
m (Either RuntimeError a) -> t m a
native (m (Either RuntimeError Integer) -> GingerT m Integer)
-> (Value m -> m (Either RuntimeError Integer))
-> Value m
-> GingerT m Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either RuntimeError Integer -> m (Either RuntimeError Integer)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError Integer -> m (Either RuntimeError Integer))
-> (Value m -> Either RuntimeError Integer)
-> Value m
-> m (Either RuntimeError Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value m -> Either RuntimeError Integer
forall (m :: * -> *).
Text -> Value m -> Either RuntimeError Integer
asIntVal Text
"slice start") Maybe (Value m)
startValMay
  endMay <- mapM (native . pure . asIntVal "slice end") endValMay
  pure . ListV $ sliceVector xs (fromIntegral <$> startMay) (fromIntegral <$> endMay)
sliceValue (StringV Text
xs) Maybe (Value m)
startValMay Maybe (Value m)
endValMay = do
  startMay <- (Value m -> GingerT m Integer)
-> Maybe (Value m) -> GingerT m (Maybe Integer)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM (m (Either RuntimeError Integer) -> GingerT m Integer
forall (m :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad m, MonadTrans t, MonadError RuntimeError (t m)) =>
m (Either RuntimeError a) -> t m a
native (m (Either RuntimeError Integer) -> GingerT m Integer)
-> (Value m -> m (Either RuntimeError Integer))
-> Value m
-> GingerT m Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either RuntimeError Integer -> m (Either RuntimeError Integer)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError Integer -> m (Either RuntimeError Integer))
-> (Value m -> Either RuntimeError Integer)
-> Value m
-> m (Either RuntimeError Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value m -> Either RuntimeError Integer
forall (m :: * -> *).
Text -> Value m -> Either RuntimeError Integer
asIntVal Text
"slice start") Maybe (Value m)
startValMay
  endMay <- mapM (native . pure . asIntVal "slice end") endValMay
  pure . StringV $ sliceText xs (fromIntegral <$> startMay) (fromIntegral <$> endMay)
sliceValue (BytesV StrictByteString
xs) Maybe (Value m)
startValMay Maybe (Value m)
endValMay = do
  startMay <- (Value m -> GingerT m Integer)
-> Maybe (Value m) -> GingerT m (Maybe Integer)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM (m (Either RuntimeError Integer) -> GingerT m Integer
forall (m :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad m, MonadTrans t, MonadError RuntimeError (t m)) =>
m (Either RuntimeError a) -> t m a
native (m (Either RuntimeError Integer) -> GingerT m Integer)
-> (Value m -> m (Either RuntimeError Integer))
-> Value m
-> GingerT m Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either RuntimeError Integer -> m (Either RuntimeError Integer)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError Integer -> m (Either RuntimeError Integer))
-> (Value m -> Either RuntimeError Integer)
-> Value m
-> m (Either RuntimeError Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value m -> Either RuntimeError Integer
forall (m :: * -> *).
Text -> Value m -> Either RuntimeError Integer
asIntVal Text
"slice start") Maybe (Value m)
startValMay
  endMay <- mapM (native . pure . asIntVal "slice end") endValMay
  pure . BytesV $ sliceByteString xs (fromIntegral <$> startMay) (fromIntegral <$> endMay)
sliceValue (EncodedV (Encoded Text
xs)) Maybe (Value m)
startValMay Maybe (Value m)
endValMay = do
  startMay <- (Value m -> GingerT m Integer)
-> Maybe (Value m) -> GingerT m (Maybe Integer)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM (m (Either RuntimeError Integer) -> GingerT m Integer
forall (m :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad m, MonadTrans t, MonadError RuntimeError (t m)) =>
m (Either RuntimeError a) -> t m a
native (m (Either RuntimeError Integer) -> GingerT m Integer)
-> (Value m -> m (Either RuntimeError Integer))
-> Value m
-> GingerT m Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either RuntimeError Integer -> m (Either RuntimeError Integer)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError Integer -> m (Either RuntimeError Integer))
-> (Value m -> Either RuntimeError Integer)
-> Value m
-> m (Either RuntimeError Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value m -> Either RuntimeError Integer
forall (m :: * -> *).
Text -> Value m -> Either RuntimeError Integer
asIntVal Text
"slice start") Maybe (Value m)
startValMay
  endMay <- mapM (native . pure . asIntVal "slice end") endValMay
  pure . EncodedV . Encoded $ sliceText xs (fromIntegral <$> startMay) (fromIntegral <$> endMay)
sliceValue Value m
x Maybe (Value m)
_ Maybe (Value m)
_ =
  RuntimeError -> GingerT m (Value m)
forall a. RuntimeError -> GingerT m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (RuntimeError -> GingerT m (Value m))
-> RuntimeError -> GingerT m (Value m)
forall a b. (a -> b) -> a -> b
$
    Text -> Text -> Text -> RuntimeError
TagError Text
"slicee" Text
"list or string" (Value m -> Text
forall (m :: * -> *). Value m -> Text
tagNameOf Value m
x)

numericBinop :: Monad m
             => (Integer -> Integer -> Integer)
             -> (Double -> Double -> Double)
             -> Value m
             -> Value m
             -> GingerT m (Value m)
numericBinop :: forall (m :: * -> *).
Monad m =>
(Integer -> Integer -> Integer)
-> (Double -> Double -> Double)
-> Value m
-> Value m
-> GingerT m (Value m)
numericBinop Integer -> Integer -> Integer
f Double -> Double -> Double
g Value m
a Value m
b = m (Either RuntimeError (Value m)) -> GingerT m (Value m)
forall (m :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad m, MonadTrans t, MonadError RuntimeError (t m)) =>
m (Either RuntimeError a) -> t m a
native (m (Either RuntimeError (Value m)) -> GingerT m (Value m))
-> (Either RuntimeError (Value m)
    -> m (Either RuntimeError (Value m)))
-> Either RuntimeError (Value m)
-> GingerT m (Value m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either RuntimeError (Value m) -> m (Either RuntimeError (Value m))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError (Value m) -> GingerT m (Value m))
-> Either RuntimeError (Value m) -> GingerT m (Value m)
forall a b. (a -> b) -> a -> b
$ (Integer -> Integer -> Integer)
-> (Double -> Double -> Double)
-> Value m
-> Value m
-> Either RuntimeError (Value m)
forall (m :: * -> *).
Monad m =>
(Integer -> Integer -> Integer)
-> (Double -> Double -> Double)
-> Value m
-> Value m
-> Either RuntimeError (Value m)
numericFunc2 Integer -> Integer -> Integer
f Double -> Double -> Double
g Value m
a Value m
b

numericBinopCatch :: Monad m
                  => (Integer -> Integer -> Either RuntimeError Integer)
                  -> (Double -> Double -> Either RuntimeError Double)
                  -> Value m
                  -> Value m
                  -> GingerT m (Value m)
numericBinopCatch :: forall (m :: * -> *).
Monad m =>
(Integer -> Integer -> Either RuntimeError Integer)
-> (Double -> Double -> Either RuntimeError Double)
-> Value m
-> Value m
-> GingerT m (Value m)
numericBinopCatch Integer -> Integer -> Either RuntimeError Integer
f Double -> Double -> Either RuntimeError Double
g Value m
a Value m
b = m (Either RuntimeError (Value m)) -> GingerT m (Value m)
forall (m :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad m, MonadTrans t, MonadError RuntimeError (t m)) =>
m (Either RuntimeError a) -> t m a
native (m (Either RuntimeError (Value m)) -> GingerT m (Value m))
-> (Either RuntimeError (Value m)
    -> m (Either RuntimeError (Value m)))
-> Either RuntimeError (Value m)
-> GingerT m (Value m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either RuntimeError (Value m) -> m (Either RuntimeError (Value m))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError (Value m) -> GingerT m (Value m))
-> Either RuntimeError (Value m) -> GingerT m (Value m)
forall a b. (a -> b) -> a -> b
$ (Integer -> Integer -> Either RuntimeError Integer)
-> (Double -> Double -> Either RuntimeError Double)
-> Value m
-> Value m
-> Either RuntimeError (Value m)
forall (m :: * -> *).
Monad m =>
(Integer -> Integer -> Either RuntimeError Integer)
-> (Double -> Double -> Either RuntimeError Double)
-> Value m
-> Value m
-> Either RuntimeError (Value m)
numericFunc2Catch Integer -> Integer -> Either RuntimeError Integer
f Double -> Double -> Either RuntimeError Double
g Value m
a Value m
b

intBinop :: Monad m
         => (Integer -> Integer -> Either RuntimeError Integer)
         -> Value m
         -> Value m
         -> GingerT m (Value m)
intBinop :: forall (m :: * -> *).
Monad m =>
(Integer -> Integer -> Either RuntimeError Integer)
-> Value m -> Value m -> GingerT m (Value m)
intBinop Integer -> Integer -> Either RuntimeError Integer
f Value m
a Value m
b = m (Either RuntimeError (Value m)) -> GingerT m (Value m)
forall (m :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad m, MonadTrans t, MonadError RuntimeError (t m)) =>
m (Either RuntimeError a) -> t m a
native (m (Either RuntimeError (Value m)) -> GingerT m (Value m))
-> (Either RuntimeError (Value m)
    -> m (Either RuntimeError (Value m)))
-> Either RuntimeError (Value m)
-> GingerT m (Value m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either RuntimeError (Value m) -> m (Either RuntimeError (Value m))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError (Value m) -> GingerT m (Value m))
-> Either RuntimeError (Value m) -> GingerT m (Value m)
forall a b. (a -> b) -> a -> b
$ (Integer -> Integer -> Either RuntimeError Integer)
-> Value m -> Value m -> Either RuntimeError (Value m)
forall (m :: * -> *).
Monad m =>
(Integer -> Integer -> Either RuntimeError Integer)
-> Value m -> Value m -> Either RuntimeError (Value m)
intFunc2 Integer -> Integer -> Either RuntimeError Integer
f Value m
a Value m
b

floatBinop :: Monad m
         => (Double -> Double -> Either RuntimeError Double)
         -> Value m
         -> Value m
         -> GingerT m (Value m)
floatBinop :: forall (m :: * -> *).
Monad m =>
(Double -> Double -> Either RuntimeError Double)
-> Value m -> Value m -> GingerT m (Value m)
floatBinop Double -> Double -> Either RuntimeError Double
f Value m
a Value m
b = m (Either RuntimeError (Value m)) -> GingerT m (Value m)
forall (m :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad m, MonadTrans t, MonadError RuntimeError (t m)) =>
m (Either RuntimeError a) -> t m a
native (m (Either RuntimeError (Value m)) -> GingerT m (Value m))
-> (Either RuntimeError (Value m)
    -> m (Either RuntimeError (Value m)))
-> Either RuntimeError (Value m)
-> GingerT m (Value m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either RuntimeError (Value m) -> m (Either RuntimeError (Value m))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError (Value m) -> GingerT m (Value m))
-> Either RuntimeError (Value m) -> GingerT m (Value m)
forall a b. (a -> b) -> a -> b
$ (Double -> Double -> Either RuntimeError Double)
-> Value m -> Value m -> Either RuntimeError (Value m)
forall (m :: * -> *).
Monad m =>
(Double -> Double -> Either RuntimeError Double)
-> Value m -> Value m -> Either RuntimeError (Value m)
floatFunc2 Double -> Double -> Either RuntimeError Double
f Value m
a Value m
b

boolBinop :: Monad m
         => (Bool -> Bool -> Bool)
         -> Value m
         -> Value m
         -> GingerT m (Value m)
boolBinop :: forall (m :: * -> *).
Monad m =>
(Bool -> Bool -> Bool) -> Value m -> Value m -> GingerT m (Value m)
boolBinop Bool -> Bool -> Bool
f Value m
a Value m
b = m (Either RuntimeError (Value m)) -> GingerT m (Value m)
forall (m :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad m, MonadTrans t, MonadError RuntimeError (t m)) =>
m (Either RuntimeError a) -> t m a
native (m (Either RuntimeError (Value m)) -> GingerT m (Value m))
-> (Either RuntimeError (Value m)
    -> m (Either RuntimeError (Value m)))
-> Either RuntimeError (Value m)
-> GingerT m (Value m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either RuntimeError (Value m) -> m (Either RuntimeError (Value m))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError (Value m) -> GingerT m (Value m))
-> Either RuntimeError (Value m) -> GingerT m (Value m)
forall a b. (a -> b) -> a -> b
$ (Bool -> Bool -> Bool)
-> Value m -> Value m -> Either RuntimeError (Value m)
forall (m :: * -> *).
Monad m =>
(Bool -> Bool -> Bool)
-> Value m -> Value m -> Either RuntimeError (Value m)
boolFunc2 Bool -> Bool -> Bool
f Value m
a Value m
b

valuesEqual :: Monad m
            => Value m
            -> Value m
            -> GingerT m Bool
valuesEqual :: forall (m :: * -> *).
Monad m =>
Value m -> Value m -> GingerT m Bool
valuesEqual Value m
NoneV Value m
NoneV = Bool -> GingerT m Bool
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
valuesEqual (IntV Integer
a) (IntV Integer
b) = Bool -> GingerT m Bool
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer
a Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
b)
valuesEqual (FloatV Double
a) (FloatV Double
b) = Bool -> GingerT m Bool
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double
a Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
b)
valuesEqual (StringV Text
a) (StringV Text
b) = Bool -> GingerT m Bool
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
a Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
b)
valuesEqual (BoolV Bool
a) (BoolV Bool
b) = Bool -> GingerT m Bool
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
a Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
b)
valuesEqual (BytesV StrictByteString
a) (BytesV StrictByteString
b) = Bool -> GingerT m Bool
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StrictByteString
a StrictByteString -> StrictByteString -> Bool
forall a. Eq a => a -> a -> Bool
== StrictByteString
b)
valuesEqual (EncodedV Encoded
a) (EncodedV Encoded
b) = Bool -> GingerT m Bool
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoded
a Encoded -> Encoded -> Bool
forall a. Eq a => a -> a -> Bool
== Encoded
b)
valuesEqual (ListV Vector (Value m)
a) (ListV Vector (Value m)
b)
  | Vector (Value m) -> Int
forall a. Vector a -> Int
V.length Vector (Value m)
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Vector (Value m) -> Int
forall a. Vector a -> Int
V.length Vector (Value m)
b
  = Bool -> GingerT m Bool
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
  | Bool
otherwise
  = Vector Bool -> Bool
V.and (Vector Bool -> Bool) -> GingerT m (Vector Bool) -> GingerT m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value m -> Value m -> GingerT m Bool)
-> Vector (Value m) -> Vector (Value m) -> GingerT m (Vector Bool)
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> m c) -> Vector a -> Vector b -> m (Vector c)
V.zipWithM Value m -> Value m -> GingerT m Bool
forall (m :: * -> *).
Monad m =>
Value m -> Value m -> GingerT m Bool
valuesEqual Vector (Value m)
a Vector (Value m)
b
valuesEqual (DictV Map Scalar (Value m)
a) (DictV Map Scalar (Value m)
b) = Map Scalar (Value m) -> Map Scalar (Value m) -> GingerT m Bool
forall (m :: * -> *).
Monad m =>
Map Scalar (Value m) -> Map Scalar (Value m) -> GingerT m Bool
dictsEqual Map Scalar (Value m)
a Map Scalar (Value m)
b
valuesEqual (NativeV NativeObject m
a) (NativeV NativeObject m
b) =
  m (Either RuntimeError Bool) -> GingerT m Bool
forall (m :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad m, MonadTrans t, MonadError RuntimeError (t m)) =>
m (Either RuntimeError a) -> t m a
native (m (Either RuntimeError Bool) -> GingerT m Bool)
-> m (Either RuntimeError Bool) -> GingerT m Bool
forall a b. (a -> b) -> a -> b
$ NativeObject m
a NativeObject m
-> (NativeObject m
    -> NativeObject m -> m (Either RuntimeError Bool))
-> m (Either RuntimeError Bool)
forall obj a. obj -> (obj -> obj -> a) -> a
--> NativeObject m
-> NativeObject m -> NativeObject m -> m (Either RuntimeError Bool)
forall (m :: * -> *).
NativeObject m
-> NativeObject m -> NativeObject m -> m (Either RuntimeError Bool)
nativeObjectEq NativeObject m
b
valuesEqual Value m
a Value m
b = Bool -> GingerT m Bool
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value m
a Value m -> Value m -> Bool
forall a. Eq a => a -> a -> Bool
== Value m
b)

compareValues :: Monad m => Value m -> Value m -> GingerT m Ordering
compareValues :: forall (m :: * -> *).
Monad m =>
Value m -> Value m -> GingerT m Ordering
compareValues Value m
NoneV Value m
NoneV = Ordering -> GingerT m Ordering
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ordering -> GingerT m Ordering) -> Ordering -> GingerT m Ordering
forall a b. (a -> b) -> a -> b
$ Ordering
EQ
compareValues (BoolV Bool
a) (BoolV Bool
b) = Ordering -> GingerT m Ordering
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ordering -> GingerT m Ordering) -> Ordering -> GingerT m Ordering
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Bool
a Bool
b
compareValues (IntV Integer
a) (IntV Integer
b) = Ordering -> GingerT m Ordering
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ordering -> GingerT m Ordering) -> Ordering -> GingerT m Ordering
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Integer
a Integer
b
compareValues (FloatV Double
a) (FloatV Double
b) = Ordering -> GingerT m Ordering
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ordering -> GingerT m Ordering) -> Ordering -> GingerT m Ordering
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Double
a Double
b
compareValues (IntV Integer
a) (FloatV Double
b) = Ordering -> GingerT m Ordering
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ordering -> GingerT m Ordering) -> Ordering -> GingerT m Ordering
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Integer -> Double
forall a. Num a => Integer -> a
fromInteger Integer
a) Double
b
compareValues (FloatV Double
a) (IntV Integer
b) = Ordering -> GingerT m Ordering
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ordering -> GingerT m Ordering) -> Ordering -> GingerT m Ordering
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Double
a (Integer -> Double
forall a. Num a => Integer -> a
fromInteger Integer
b)
compareValues (StringV Text
a) (StringV Text
b) = Ordering -> GingerT m Ordering
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ordering -> GingerT m Ordering) -> Ordering -> GingerT m Ordering
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Text
a Text
b
compareValues (EncodedV Encoded
a) (EncodedV Encoded
b) = Ordering -> GingerT m Ordering
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ordering -> GingerT m Ordering) -> Ordering -> GingerT m Ordering
forall a b. (a -> b) -> a -> b
$ Encoded -> Encoded -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Encoded
a Encoded
b
compareValues Value m
a Value m
b = RuntimeError -> GingerT m Ordering
forall a. RuntimeError -> GingerT m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (RuntimeError -> GingerT m Ordering)
-> RuntimeError -> GingerT m Ordering
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> RuntimeError
TagError Text
"comparison" Text
"comparable types" (Value m -> Text
forall (m :: * -> *). Value m -> Text
tagNameOf Value m
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Value m -> Text
forall (m :: * -> *). Value m -> Text
tagNameOf Value m
b)

valueComparison :: Monad m => (Ordering -> Bool) -> Value m -> Value m -> GingerT m (Value m)
valueComparison :: forall (m :: * -> *).
Monad m =>
(Ordering -> Bool) -> Value m -> Value m -> GingerT m (Value m)
valueComparison Ordering -> Bool
f Value m
a Value m
b = do
  ordering <- Value m -> Value m -> GingerT m Ordering
forall (m :: * -> *).
Monad m =>
Value m -> Value m -> GingerT m Ordering
compareValues Value m
a Value m
b
  pure $ BoolV (f ordering)

dictsEqual :: forall m. Monad m
           => Map Scalar (Value m)
           -> Map Scalar (Value m)
           -> GingerT m Bool
dictsEqual :: forall (m :: * -> *).
Monad m =>
Map Scalar (Value m) -> Map Scalar (Value m) -> GingerT m Bool
dictsEqual Map Scalar (Value m)
m1 Map Scalar (Value m)
m2 =
  [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> GingerT m [Bool] -> GingerT m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Scalar -> GingerT m Bool) -> [Scalar] -> GingerT m [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\Scalar
k -> (Value m -> Value m -> GingerT m Bool
forall (m :: * -> *).
Monad m =>
Value m -> Value m -> GingerT m Bool
valuesEqual (Maybe (Value m) -> Value m
forall a (m :: * -> *). ToValue a m => a -> Value m
toValue (Maybe (Value m) -> Value m) -> Maybe (Value m) -> Value m
forall a b. (a -> b) -> a -> b
$ Scalar -> Map Scalar (Value m) -> Maybe (Value m)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Scalar
k Map Scalar (Value m)
m1) (Maybe (Value m) -> Value m
forall a (m :: * -> *). ToValue a m => a -> Value m
toValue (Maybe (Value m) -> Value m) -> Maybe (Value m) -> Value m
forall a b. (a -> b) -> a -> b
$ Scalar -> Map Scalar (Value m) -> Maybe (Value m)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Scalar
k Map Scalar (Value m)
m2))) [Scalar]
keys
  where
    keys :: [Scalar]
keys = Set Scalar -> [Scalar]
forall a. Set a -> [a]
Set.toList (Map Scalar (Value m) -> Set Scalar
forall k a. Map k a -> Set k
Map.keysSet Map Scalar (Value m)
m1 Set Scalar -> Set Scalar -> Set Scalar
forall a. Semigroup a => a -> a -> a
<> Map Scalar (Value m) -> Set Scalar
forall k a. Map k a -> Set k
Map.keysSet Map Scalar (Value m)
m2)

evalUnary :: Monad m => UnaryOperator -> Value m -> GingerT m (Value m)
evalUnary :: forall (m :: * -> *).
Monad m =>
UnaryOperator -> Value m -> GingerT m (Value m)
evalUnary UnaryOperator
UnopNot (BoolV Bool
b) = Value m -> GingerT m (Value m)
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Value m
forall (m :: * -> *). Bool -> Value m
BoolV (Bool -> Value m) -> Bool -> Value m
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
b)
evalUnary UnaryOperator
UnopNot Value m
x = RuntimeError -> GingerT m (Value m)
forall a. RuntimeError -> GingerT m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (RuntimeError -> GingerT m (Value m))
-> RuntimeError -> GingerT m (Value m)
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> RuntimeError
TagError Text
"not" Text
"boolean" (Value m -> Text
forall (m :: * -> *). Value m -> Text
tagNameOf Value m
x)
evalUnary UnaryOperator
UnopNegate (IntV Integer
x) = Value m -> GingerT m (Value m)
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Value m
forall (m :: * -> *). Integer -> Value m
IntV (Integer -> Value m) -> Integer -> Value m
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
forall a. Num a => a -> a
negate Integer
x)
evalUnary UnaryOperator
UnopNegate (FloatV Double
x) = Value m -> GingerT m (Value m)
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> Value m
forall (m :: * -> *). Double -> Value m
FloatV (Double -> Value m) -> Double -> Value m
forall a b. (a -> b) -> a -> b
$ Double -> Double
forall a. Num a => a -> a
negate Double
x)
evalUnary UnaryOperator
UnopNegate Value m
x = RuntimeError -> GingerT m (Value m)
forall a. RuntimeError -> GingerT m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (RuntimeError -> GingerT m (Value m))
-> RuntimeError -> GingerT m (Value m)
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> RuntimeError
TagError Text
"unary -" Text
"number" (Value m -> Text
forall (m :: * -> *). Value m -> Text
tagNameOf Value m
x)

evalBinary :: Monad m => BinaryOperator -> Value m -> Value m -> GingerT m (Value m)
evalBinary :: forall (m :: * -> *).
Monad m =>
BinaryOperator -> Value m -> Value m -> GingerT m (Value m)
evalBinary BinaryOperator
BinopPlus Value m
a Value m
b = (Integer -> Integer -> Integer)
-> (Double -> Double -> Double)
-> Value m
-> Value m
-> GingerT m (Value m)
forall (m :: * -> *).
Monad m =>
(Integer -> Integer -> Integer)
-> (Double -> Double -> Double)
-> Value m
-> Value m
-> GingerT m (Value m)
numericBinop Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+) Double -> Double -> Double
forall a. Num a => a -> a -> a
(+) Value m
a Value m
b
evalBinary BinaryOperator
BinopMinus Value m
a Value m
b = (Integer -> Integer -> Integer)
-> (Double -> Double -> Double)
-> Value m
-> Value m
-> GingerT m (Value m)
forall (m :: * -> *).
Monad m =>
(Integer -> Integer -> Integer)
-> (Double -> Double -> Double)
-> Value m
-> Value m
-> GingerT m (Value m)
numericBinop (-) (-) Value m
a Value m
b
evalBinary BinaryOperator
BinopDiv Value m
a Value m
b = (Double -> Double -> Either RuntimeError Double)
-> Value m -> Value m -> GingerT m (Value m)
forall (m :: * -> *).
Monad m =>
(Double -> Double -> Either RuntimeError Double)
-> Value m -> Value m -> GingerT m (Value m)
floatBinop Double -> Double -> Either RuntimeError Double
safeDiv Value m
a Value m
b
evalBinary BinaryOperator
BinopIntDiv Value m
a Value m
b = (Integer -> Integer -> Either RuntimeError Integer)
-> Value m -> Value m -> GingerT m (Value m)
forall (m :: * -> *).
Monad m =>
(Integer -> Integer -> Either RuntimeError Integer)
-> Value m -> Value m -> GingerT m (Value m)
intBinop Integer -> Integer -> Either RuntimeError Integer
safeIntDiv Value m
a Value m
b
evalBinary BinaryOperator
BinopMod (StringV Text
a) Value m
b = Text -> Value m -> GingerT m (Value m)
forall (m :: * -> *) (t :: (* -> *) -> * -> *).
(Monad m, MonadTrans t) =>
Text -> Value m -> t m (Value m)
printfValues Text
a Value m
b
evalBinary BinaryOperator
BinopMod Value m
a Value m
b = (Integer -> Integer -> Either RuntimeError Integer)
-> Value m -> Value m -> GingerT m (Value m)
forall (m :: * -> *).
Monad m =>
(Integer -> Integer -> Either RuntimeError Integer)
-> Value m -> Value m -> GingerT m (Value m)
intBinop Integer -> Integer -> Either RuntimeError Integer
safeIntMod Value m
a Value m
b
evalBinary BinaryOperator
BinopMul Value m
a Value m
b = (Integer -> Integer -> Integer)
-> (Double -> Double -> Double)
-> Value m
-> Value m
-> GingerT m (Value m)
forall (m :: * -> *).
Monad m =>
(Integer -> Integer -> Integer)
-> (Double -> Double -> Double)
-> Value m
-> Value m
-> GingerT m (Value m)
numericBinop Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(*) Double -> Double -> Double
forall a. Num a => a -> a -> a
(*) Value m
a Value m
b
evalBinary BinaryOperator
BinopPower Value m
a Value m
b = (Integer -> Integer -> Either RuntimeError Integer)
-> (Double -> Double -> Either RuntimeError Double)
-> Value m
-> Value m
-> GingerT m (Value m)
forall (m :: * -> *).
Monad m =>
(Integer -> Integer -> Either RuntimeError Integer)
-> (Double -> Double -> Either RuntimeError Double)
-> Value m
-> Value m
-> GingerT m (Value m)
numericBinopCatch Integer -> Integer -> Either RuntimeError Integer
safeIntPow (\Double
x Double
y -> Double -> Either RuntimeError Double
forall a b. b -> Either a b
Right (Double
x Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Double
y)) Value m
a Value m
b
evalBinary BinaryOperator
BinopEqual Value m
a Value m
b = Bool -> Value m
forall (m :: * -> *). Bool -> Value m
BoolV (Bool -> Value m) -> GingerT m Bool -> GingerT m (Value m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value m -> Value m -> GingerT m Bool
forall (m :: * -> *).
Monad m =>
Value m -> Value m -> GingerT m Bool
valuesEqual Value m
a Value m
b
evalBinary BinaryOperator
BinopNotEqual Value m
a Value m
b = Bool -> Value m
forall (m :: * -> *). Bool -> Value m
BoolV (Bool -> Value m) -> (Bool -> Bool) -> Bool -> Value m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not (Bool -> Value m) -> GingerT m Bool -> GingerT m (Value m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value m -> Value m -> GingerT m Bool
forall (m :: * -> *).
Monad m =>
Value m -> Value m -> GingerT m Bool
valuesEqual Value m
a Value m
b
evalBinary BinaryOperator
BinopGT Value m
a Value m
b = (Ordering -> Bool) -> Value m -> Value m -> GingerT m (Value m)
forall (m :: * -> *).
Monad m =>
(Ordering -> Bool) -> Value m -> Value m -> GingerT m (Value m)
valueComparison (Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT) Value m
a Value m
b
evalBinary BinaryOperator
BinopGTE Value m
a Value m
b = (Ordering -> Bool) -> Value m -> Value m -> GingerT m (Value m)
forall (m :: * -> *).
Monad m =>
(Ordering -> Bool) -> Value m -> Value m -> GingerT m (Value m)
valueComparison (Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT) Value m
a Value m
b
evalBinary BinaryOperator
BinopLT Value m
a Value m
b = (Ordering -> Bool) -> Value m -> Value m -> GingerT m (Value m)
forall (m :: * -> *).
Monad m =>
(Ordering -> Bool) -> Value m -> Value m -> GingerT m (Value m)
valueComparison (Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT) Value m
a Value m
b
evalBinary BinaryOperator
BinopLTE Value m
a Value m
b = (Ordering -> Bool) -> Value m -> Value m -> GingerT m (Value m)
forall (m :: * -> *).
Monad m =>
(Ordering -> Bool) -> Value m -> Value m -> GingerT m (Value m)
valueComparison (Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT) Value m
a Value m
b

evalBinary BinaryOperator
BinopAnd Value m
a Value m
b = (Bool -> Bool -> Bool) -> Value m -> Value m -> GingerT m (Value m)
forall (m :: * -> *).
Monad m =>
(Bool -> Bool -> Bool) -> Value m -> Value m -> GingerT m (Value m)
boolBinop Bool -> Bool -> Bool
(&&) Value m
a Value m
b
evalBinary BinaryOperator
BinopOr Value m
a Value m
b = (Bool -> Bool -> Bool) -> Value m -> Value m -> GingerT m (Value m)
forall (m :: * -> *).
Monad m =>
(Bool -> Bool -> Bool) -> Value m -> Value m -> GingerT m (Value m)
boolBinop Bool -> Bool -> Bool
(||) Value m
a Value m
b
evalBinary BinaryOperator
BinopIn Value m
a Value m
b = case Value m
b of
  DictV Map Scalar (Value m)
m -> case Value m
a of
    ScalarV Scalar
k -> Value m -> GingerT m (Value m)
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value m -> GingerT m (Value m))
-> (Bool -> Value m) -> Bool -> GingerT m (Value m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Value m
forall (m :: * -> *). Bool -> Value m
BoolV (Bool -> GingerT m (Value m)) -> Bool -> GingerT m (Value m)
forall a b. (a -> b) -> a -> b
$ Scalar
k Scalar -> Map Scalar (Value m) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map Scalar (Value m)
m
    Value m
x -> RuntimeError -> GingerT m (Value m)
forall a. RuntimeError -> GingerT m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (RuntimeError -> GingerT m (Value m))
-> RuntimeError -> GingerT m (Value m)
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> RuntimeError
TagError Text
"in" Text
"scalar" (Value m -> Text
forall (m :: * -> *). Value m -> Text
tagNameOf Value m
x)
  ListV Vector (Value m)
v -> case Vector (Value m) -> Maybe (Value m, Vector (Value m))
forall a. Vector a -> Maybe (a, Vector a)
V.uncons Vector (Value m)
v of
    Maybe (Value m, Vector (Value m))
Nothing ->
      Value m -> GingerT m (Value m)
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value m
forall (m :: * -> *). Value m
FalseV
    Just (Value m
x, Vector (Value m)
xs) -> do
      found <- Value m -> Value m -> GingerT m Bool
forall (m :: * -> *).
Monad m =>
Value m -> Value m -> GingerT m Bool
valuesEqual Value m
a Value m
x
      if found then
        pure . BoolV $ True
      else
        evalBinary BinopIn a (ListV xs)
  Value m
x -> RuntimeError -> GingerT m (Value m)
forall a. RuntimeError -> GingerT m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (RuntimeError -> GingerT m (Value m))
-> RuntimeError -> GingerT m (Value m)
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> RuntimeError
TagError Text
"in" Text
"list or dict" (Value m -> Text
forall (m :: * -> *). Value m -> Text
tagNameOf Value m
x)
evalBinary BinaryOperator
BinopIndex Value m
a Value m
b = do
  itemMay <- Value m -> Value m -> GingerT m (Maybe (Value m))
forall (m :: * -> *).
Monad m =>
Value m -> Value m -> GingerT m (Maybe (Value m))
getItem Value m
a Value m
b
  case itemMay of
    Just Value m
item -> Value m -> GingerT m (Value m)
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value m
item
    Maybe (Value m)
Nothing -> do
      attrMay <- case Value m
b of
        StringV Text
s -> Value m -> Identifier -> GingerT m (Maybe (Value m))
forall (m :: * -> *).
Monad m =>
Value m -> Identifier -> GingerT m (Maybe (Value m))
getAttr Value m
a (Text -> Identifier
Identifier Text
s)
        Value m
_ -> Maybe (Value m) -> GingerT m (Maybe (Value m))
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Value m)
forall a. Maybe a
Nothing
      case attrMay of
        Just Value m
attr -> Value m -> GingerT m (Value m)
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value m
attr
        Maybe (Value m)
Nothing -> Value m -> GingerT m (Value m)
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value m
forall (m :: * -> *). Value m
NoneV
evalBinary BinaryOperator
BinopConcat Value m
a Value m
b = Value m -> Value m -> GingerT m (Value m)
forall (m :: * -> *).
Monad m =>
Value m -> Value m -> GingerT m (Value m)
concatValues Value m
a Value m
b

getItem :: Monad m
        => Value m
        -> Value m
        -> GingerT m (Maybe (Value m))
getItem :: forall (m :: * -> *).
Monad m =>
Value m -> Value m -> GingerT m (Maybe (Value m))
getItem Value m
a Value m
b = m (Maybe (Value m)) -> GingerT m (Maybe (Value m))
forall (m :: * -> *) a. Monad m => m a -> GingerT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe (Value m)) -> GingerT m (Maybe (Value m)))
-> m (Maybe (Value m)) -> GingerT m (Maybe (Value m))
forall a b. (a -> b) -> a -> b
$ Value m -> Value m -> m (Maybe (Value m))
forall (m :: * -> *).
Monad m =>
Value m -> Value m -> m (Maybe (Value m))
getItemRaw Value m
a Value m
b


getAttr :: Monad m
        => Value m
        -> Identifier
        -> GingerT m (Maybe (Value m))
getAttr :: forall (m :: * -> *).
Monad m =>
Value m -> Identifier -> GingerT m (Maybe (Value m))
getAttr Value m
a Identifier
b = m (Either RuntimeError (Maybe (Value m)))
-> GingerT m (Maybe (Value m))
forall (m :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad m, MonadTrans t, MonadError RuntimeError (t m)) =>
m (Either RuntimeError a) -> t m a
native (m (Either RuntimeError (Maybe (Value m)))
 -> GingerT m (Maybe (Value m)))
-> m (Either RuntimeError (Maybe (Value m)))
-> GingerT m (Maybe (Value m))
forall a b. (a -> b) -> a -> b
$ Value m -> Identifier -> m (Either RuntimeError (Maybe (Value m)))
forall (m :: * -> *).
Monad m =>
Value m -> Identifier -> m (Either RuntimeError (Maybe (Value m)))
getAttrRaw Value m
a Identifier
b

safeIntPow :: Integer -> Integer -> Either RuntimeError Integer
safeIntPow :: Integer -> Integer -> Either RuntimeError Integer
safeIntPow Integer
_ Integer
b | Integer
b Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 = RuntimeError -> Either RuntimeError Integer
forall a b. a -> Either a b
Left (Text -> Text -> RuntimeError
NumericError Text
"**" Text
"negative exponent")
safeIntPow Integer
a Integer
b = Integer -> Either RuntimeError Integer
forall a b. b -> Either a b
Right (Integer
a Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
b)

safeIntDiv :: Integer -> Integer -> Either RuntimeError Integer
safeIntDiv :: Integer -> Integer -> Either RuntimeError Integer
safeIntDiv Integer
_ Integer
0 = RuntimeError -> Either RuntimeError Integer
forall a b. a -> Either a b
Left (Text -> Text -> RuntimeError
NumericError Text
"//" Text
"division by zero")
safeIntDiv Integer
a Integer
b = Integer -> Either RuntimeError Integer
forall a b. b -> Either a b
Right (Integer
a Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
b)

safeIntMod :: Integer -> Integer -> Either RuntimeError Integer
safeIntMod :: Integer -> Integer -> Either RuntimeError Integer
safeIntMod Integer
_ Integer
0 = RuntimeError -> Either RuntimeError Integer
forall a b. a -> Either a b
Left (Text -> Text -> RuntimeError
NumericError Text
"%" Text
"modulo by zero")
safeIntMod Integer
a Integer
b = Integer -> Either RuntimeError Integer
forall a b. b -> Either a b
Right (Integer
a Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
b)

safeDiv :: Double -> Double -> Either RuntimeError Double
safeDiv :: Double -> Double -> Either RuntimeError Double
safeDiv Double
a Double
b =
  case Double
a Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
b of
    Double
c | Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
c -> RuntimeError -> Either RuntimeError Double
forall a b. a -> Either a b
Left (Text -> Text -> RuntimeError
NumericError Text
"/" Text
"not a number")
    Double
c | Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Double
c -> RuntimeError -> Either RuntimeError Double
forall a b. a -> Either a b
Left (Text -> Text -> RuntimeError
NumericError Text
"/" (Text
"division by zero"))
    Double
c -> Double -> Either RuntimeError Double
forall a b. b -> Either a b
Right Double
c

concatValues :: Monad m => (Value m) -> (Value m) -> GingerT m (Value m)
concatValues :: forall (m :: * -> *).
Monad m =>
Value m -> Value m -> GingerT m (Value m)
concatValues Value m
a Value m
b = case (Value m
a, Value m
b) of
  -- Strings, blobs and encoded values concatenate directly
  (StringV Text
x, StringV Text
y) -> Value m -> GingerT m (Value m)
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value m -> GingerT m (Value m)) -> Value m -> GingerT m (Value m)
forall a b. (a -> b) -> a -> b
$ Text -> Value m
forall (m :: * -> *). Text -> Value m
StringV (Text -> Value m) -> Text -> Value m
forall a b. (a -> b) -> a -> b
$ Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
y
  (BytesV StrictByteString
x, BytesV StrictByteString
y) -> Value m -> GingerT m (Value m)
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value m -> GingerT m (Value m)) -> Value m -> GingerT m (Value m)
forall a b. (a -> b) -> a -> b
$ StrictByteString -> Value m
forall (m :: * -> *). StrictByteString -> Value m
BytesV (StrictByteString -> Value m) -> StrictByteString -> Value m
forall a b. (a -> b) -> a -> b
$ StrictByteString
x StrictByteString -> StrictByteString -> StrictByteString
forall a. Semigroup a => a -> a -> a
<> StrictByteString
y
  (EncodedV (Encoded Text
x), EncodedV (Encoded Text
y)) -> Value m -> GingerT m (Value m)
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value m -> GingerT m (Value m))
-> (Text -> Value m) -> Text -> GingerT m (Value m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoded -> Value m
forall (m :: * -> *). Encoded -> Value m
EncodedV (Encoded -> Value m) -> (Text -> Encoded) -> Text -> Value m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Encoded
Encoded (Text -> GingerT m (Value m)) -> Text -> GingerT m (Value m)
forall a b. (a -> b) -> a -> b
$ Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
y

  -- None is a neutral element
  (Value m
NoneV, Value m
y) -> Value m -> GingerT m (Value m)
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value m -> GingerT m (Value m)) -> Value m -> GingerT m (Value m)
forall a b. (a -> b) -> a -> b
$ Value m
y
  (Value m
x, Value m
NoneV) -> Value m -> GingerT m (Value m)
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value m -> GingerT m (Value m)) -> Value m -> GingerT m (Value m)
forall a b. (a -> b) -> a -> b
$ Value m
x

  -- Anything involving encoded values yields encoded results
  (EncodedV Encoded
x, Value m
y) -> do
    yEnc <- Value m -> GingerT m Encoded
forall (m :: * -> *) (t :: (* -> *) -> * -> *).
(Monad m, MonadError RuntimeError (t m), MonadTrans t,
 MonadReader (Context m) (t m)) =>
Value m -> t m Encoded
encode Value m
y
    pure $ EncodedV (x <> yEnc)
  (Value m
x, EncodedV Encoded
y) -> do
    xEnc <- Value m -> GingerT m Encoded
forall (m :: * -> *) (t :: (* -> *) -> * -> *).
(Monad m, MonadError RuntimeError (t m), MonadTrans t,
 MonadReader (Context m) (t m)) =>
Value m -> t m Encoded
encode Value m
x
    pure $ EncodedV (xEnc <> y)

  -- Anything else is cast to and concatenated as strings
  (Value m
x, Value m
y) -> do
    xStr <- Value m -> GingerT m Text
forall (m :: * -> *) (t :: (* -> *) -> * -> *).
(Monad m, MonadError RuntimeError (t m), MonadTrans t) =>
Value m -> t m Text
stringify Value m
x
    yStr <- stringify y
    pure . StringV $ xStr <> yStr

evalT :: MonadRandom m => Template -> GingerT m (Value m)
evalT :: forall (m :: * -> *).
MonadRandom m =>
Template -> GingerT m (Value m)
evalT Template
t = do
  case Template -> Maybe Text
templateParent Template
t of
    Maybe Text
Nothing ->
      Statement -> GingerT m (Value m)
forall (m :: * -> *).
MonadRandom m =>
Statement -> GingerT m (Value m)
evalS (Template -> Statement
templateBody Template
t)
    Just Text
parentName -> do
      parent <- Text -> GingerT m LoadedTemplate
forall (m :: * -> *). Monad m => Text -> GingerT m LoadedTemplate
loadTemplate Text
parentName
      hush_ $ evalS (templateBody t)
      evalLT parent

evalLT :: MonadRandom m => LoadedTemplate -> GingerT m (Value m)
evalLT :: forall (m :: * -> *).
MonadRandom m =>
LoadedTemplate -> GingerT m (Value m)
evalLT LoadedTemplate
t = do
  case LoadedTemplate -> Maybe LoadedTemplate
loadedTemplateParent LoadedTemplate
t of
    Maybe LoadedTemplate
Nothing ->
      Statement -> GingerT m (Value m)
forall (m :: * -> *).
MonadRandom m =>
Statement -> GingerT m (Value m)
evalS (LoadedTemplate -> Statement
loadedTemplateBody LoadedTemplate
t)
    Just LoadedTemplate
parent -> do
      GingerT m (Value m) -> GingerT m ()
forall (m :: * -> *) a. Monad m => GingerT m a -> GingerT m ()
hush_ (GingerT m (Value m) -> GingerT m ())
-> GingerT m (Value m) -> GingerT m ()
forall a b. (a -> b) -> a -> b
$ Statement -> GingerT m (Value m)
forall (m :: * -> *).
MonadRandom m =>
Statement -> GingerT m (Value m)
evalS (LoadedTemplate -> Statement
loadedTemplateBody LoadedTemplate
t)
      LoadedTemplate -> GingerT m (Value m)
forall (m :: * -> *).
MonadRandom m =>
LoadedTemplate -> GingerT m (Value m)
evalLT LoadedTemplate
parent

evalS :: MonadRandom m => Statement -> GingerT m (Value m)
evalS :: forall (m :: * -> *).
MonadRandom m =>
Statement -> GingerT m (Value m)
evalS (PositionedS SourcePosition
pos Statement
s) = do
  Statement -> GingerT m (Value m)
forall (m :: * -> *).
MonadRandom m =>
Statement -> GingerT m (Value m)
evalS Statement
s GingerT m (Value m)
-> (RuntimeError -> GingerT m (Value m)) -> GingerT m (Value m)
forall a.
GingerT m a -> (RuntimeError -> GingerT m a) -> GingerT m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` SourcePosition -> RuntimeError -> GingerT m (Value m)
forall (m :: * -> *) a.
Monad m =>
SourcePosition -> RuntimeError -> GingerT m a
decorateError SourcePosition
pos
evalS (ImmediateS Encoded
enc) = Value m -> GingerT m (Value m)
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoded -> Value m
forall (m :: * -> *). Encoded -> Value m
EncodedV Encoded
enc)
evalS (InterpolationS Expr
expr) = GingerT m (Value m) -> GingerT m (Value m)
forall (m :: * -> *).
Monad m =>
GingerT m (Value m) -> GingerT m (Value m)
whenOutputPolicy (GingerT m (Value m) -> GingerT m (Value m))
-> GingerT m (Value m) -> GingerT m (Value m)
forall a b. (a -> b) -> a -> b
$ do
  Expr -> GingerT m (Value m)
forall (m :: * -> *). MonadRandom m => Expr -> GingerT m (Value m)
evalE Expr
expr
evalS (CommentS Text
_) = Value m -> GingerT m (Value m)
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value m
forall (m :: * -> *). Value m
NoneV
evalS (ForS Maybe Identifier
loopKeyMay Identifier
loopName Expr
itereeE Maybe Expr
loopCondMay Recursivity
recursivity Statement
bodyS Maybe Statement
elseSMay) = do
  iteree <- Expr -> GingerT m (Value m)
forall (m :: * -> *). MonadRandom m => Expr -> GingerT m (Value m)
evalE Expr
itereeE
  evalLoop loopKeyMay loopName iteree loopCondMay recursivity bodyS elseSMay 0
evalS (IfS Expr
condE Statement
yesS Maybe Statement
noSMay) = do
  cond <- Expr -> GingerT m (Value m)
forall (m :: * -> *). MonadRandom m => Expr -> GingerT m (Value m)
evalE Expr
condE GingerT m (Value m)
-> (Value m -> GingerT m Bool) -> GingerT m Bool
forall a b. GingerT m a -> (a -> GingerT m b) -> GingerT m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Value m -> GingerT m Bool
forall (m :: * -> *). Monad m => Text -> Value m -> GingerT m Bool
asTruth Text
"condition"
  if cond then evalS yesS else maybe (pure NoneV) evalS noSMay
evalS (MacroS Identifier
name [MacroArg]
argsSig Statement
body) = do
  env <- (EvalState m -> Env m) -> GingerT m (Env m)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EvalState m -> Env m
forall (m :: * -> *). EvalState m -> Env m
evalEnv
  argsSig' <- mapM (\(Identifier
argname, Maybe Expr
defEMay) -> do
                  defMay <- GingerT m (Maybe (Value m))
-> (Expr -> GingerT m (Maybe (Value m)))
-> Maybe Expr
-> GingerT m (Maybe (Value m))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe (Value m) -> GingerT m (Maybe (Value m))
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Value m)
forall a. Maybe a
Nothing) ((Value m -> Maybe (Value m))
-> GingerT m (Value m) -> GingerT m (Maybe (Value m))
forall a b. (a -> b) -> GingerT m a -> GingerT m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value m -> Maybe (Value m)
forall a. a -> Maybe a
Just (GingerT m (Value m) -> GingerT m (Maybe (Value m)))
-> (Expr -> GingerT m (Value m))
-> Expr
-> GingerT m (Maybe (Value m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> GingerT m (Value m)
forall (m :: * -> *). MonadRandom m => Expr -> GingerT m (Value m)
evalE) Maybe Expr
defEMay
                  pure (argname, defMay)
                )
                argsSig
  setVar name . ProcedureV $ GingerProcedure env argsSig' (StatementE body)
  pure NoneV

evalS (CallS Identifier
name [Expr]
posArgsExpr [(Identifier, Expr)]
namedArgsExpr Statement
bodyS) = GingerT m (Value m) -> GingerT m (Value m)
forall (m :: * -> *).
Monad m =>
GingerT m (Value m) -> GingerT m (Value m)
whenOutputPolicy (GingerT m (Value m) -> GingerT m (Value m))
-> GingerT m (Value m) -> GingerT m (Value m)
forall a b. (a -> b) -> a -> b
$ do
  callee <- Identifier -> GingerT m (Value m)
forall (m :: * -> *). Monad m => Identifier -> GingerT m (Value m)
lookupVar Identifier
name
  callerVal <- eval bodyS
  srcPosMay <- gets evalSourcePosition
  let callerID =
        Text -> Value m -> Maybe SourcePosition -> ObjectID
forall a. Show a => Text -> a -> Maybe SourcePosition -> ObjectID
objectIDFromContext Text
"caller" Value m
callerVal Maybe SourcePosition
srcPosMay
  let caller =
        Procedure m -> Value m
forall (m :: * -> *). Procedure m -> Value m
ProcedureV (Procedure m -> Value m) -> Procedure m -> Value m
forall a b. (a -> b) -> a -> b
$
          ObjectID
-> Maybe ProcedureDoc
-> ([(Maybe Identifier, Value m)]
    -> Context m -> m (Either RuntimeError (Value m)))
-> Procedure m
forall (m :: * -> *).
ObjectID
-> Maybe ProcedureDoc
-> ([(Maybe Identifier, Value m)]
    -> Context m -> m (Either RuntimeError (Value m)))
-> Procedure m
NativeProcedure
            ObjectID
callerID
            (ProcedureDoc -> Maybe ProcedureDoc
forall a. a -> Maybe a
Just ProcedureDoc
              { procedureDocName :: Text
procedureDocName = Text
"caller"
              , procedureDocArgs :: Vector ArgumentDoc
procedureDocArgs = Vector ArgumentDoc
forall a. Monoid a => a
mempty
              , procedureDocReturnType :: Maybe TypeDoc
procedureDocReturnType = TypeDoc -> Maybe TypeDoc
forall a. a -> Maybe a
Just (TypeDoc -> Maybe TypeDoc) -> TypeDoc -> Maybe TypeDoc
forall a b. (a -> b) -> a -> b
$ Text -> TypeDoc
TypeDocSingle Text
"markup"
              , procedureDocDescription :: Text
procedureDocDescription =
                  Text
"Runs the body of the {% call %} statement that called the " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                  Text
"current macro."
              }
            )
            ((Context m -> m (Either RuntimeError (Value m)))
-> [(Maybe Identifier, Value m)]
-> Context m
-> m (Either RuntimeError (Value m))
forall a b. a -> b -> a
const ((Context m -> m (Either RuntimeError (Value m)))
 -> [(Maybe Identifier, Value m)]
 -> Context m
 -> m (Either RuntimeError (Value m)))
-> (Value m -> Context m -> m (Either RuntimeError (Value m)))
-> Value m
-> [(Maybe Identifier, Value m)]
-> Context m
-> m (Either RuntimeError (Value m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Either RuntimeError (Value m))
-> Context m -> m (Either RuntimeError (Value m))
forall a b. a -> b -> a
const (m (Either RuntimeError (Value m))
 -> Context m -> m (Either RuntimeError (Value m)))
-> (Value m -> m (Either RuntimeError (Value m)))
-> Value m
-> Context m
-> m (Either RuntimeError (Value m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either RuntimeError (Value m) -> m (Either RuntimeError (Value m))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError (Value m)
 -> m (Either RuntimeError (Value m)))
-> (Value m -> Either RuntimeError (Value m))
-> Value m
-> m (Either RuntimeError (Value m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value m -> Either RuntimeError (Value m)
forall a b. b -> Either a b
Right (Value m
 -> [(Maybe Identifier, Value m)]
 -> Context m
 -> m (Either RuntimeError (Value m)))
-> Value m
-> [(Maybe Identifier, Value m)]
-> Context m
-> m (Either RuntimeError (Value m))
forall a b. (a -> b) -> a -> b
$ Value m
callerVal)
  call (Just caller) callee posArgsExpr namedArgsExpr
evalS (FilterS Identifier
name [Expr]
posArgsExpr [(Identifier, Expr)]
namedArgsExpr Statement
bodyS) = GingerT m (Value m) -> GingerT m (Value m)
forall (m :: * -> *).
Monad m =>
GingerT m (Value m) -> GingerT m (Value m)
whenOutputPolicy (GingerT m (Value m) -> GingerT m (Value m))
-> GingerT m (Value m) -> GingerT m (Value m)
forall a b. (a -> b) -> a -> b
$ do
  callee <- Identifier -> GingerT m (Value m)
forall (m :: * -> *). Monad m => Identifier -> GingerT m (Value m)
lookupVar Identifier
name
  let posArgsExpr' = Statement -> Expr
StatementE Statement
bodyS Expr -> [Expr] -> [Expr]
forall a. a -> [a] -> [a]
: [Expr]
posArgsExpr
  call Nothing callee posArgsExpr' namedArgsExpr

evalS (SetS SetTarget
target Expr
valE) = do
  val <- Expr -> GingerT m (Value m)
forall (m :: * -> *). MonadRandom m => Expr -> GingerT m (Value m)
evalE' Expr
valE
  case target of
    SetVar Identifier
name -> Identifier -> Value m -> GingerT m ()
forall (m :: * -> *).
Monad m =>
Identifier -> Value m -> GingerT m ()
setVar Identifier
name Value m
val
    SetMutable Identifier
name Identifier
attr -> Identifier -> Identifier -> Value m -> GingerT m ()
forall (m :: * -> *).
Monad m =>
Identifier -> Identifier -> Value m -> GingerT m ()
setMutable Identifier
name Identifier
attr Value m
val
  pure NoneV
evalS (SetBlockS SetTarget
target Statement
bodyS Maybe Expr
filterEMaybe) = do
  body <- case Maybe Expr
filterEMaybe of
            Maybe Expr
Nothing ->
              Statement -> GingerT m (Value m)
forall (m :: * -> *).
MonadRandom m =>
Statement -> GingerT m (Value m)
evalS Statement
bodyS
            Just Expr
filterE -> case Expr
filterE of
              CallE Expr
callee [Expr]
posArgs [(Identifier, Expr)]
kwArgs ->
                Expr -> GingerT m (Value m)
forall (m :: * -> *). MonadRandom m => Expr -> GingerT m (Value m)
evalE (Expr -> [Expr] -> [(Identifier, Expr)] -> Expr
CallE Expr
callee (Statement -> Expr
StatementE Statement
bodyS Expr -> [Expr] -> [Expr]
forall a. a -> [a] -> [a]
: [Expr]
posArgs) [(Identifier, Expr)]
kwArgs)
              Expr
callee ->
                Expr -> GingerT m (Value m)
forall (m :: * -> *). MonadRandom m => Expr -> GingerT m (Value m)
evalE (Expr -> [Expr] -> [(Identifier, Expr)] -> Expr
CallE Expr
callee [Statement -> Expr
StatementE Statement
bodyS] [(Identifier, Expr)]
forall a. Monoid a => a
mempty)
  case target of
    SetVar Identifier
name -> Identifier -> Value m -> GingerT m ()
forall (m :: * -> *).
Monad m =>
Identifier -> Value m -> GingerT m ()
setVar Identifier
name Value m
body
    SetMutable Identifier
name Identifier
path -> Identifier -> Identifier -> Value m -> GingerT m ()
forall (m :: * -> *).
Monad m =>
Identifier -> Identifier -> Value m -> GingerT m ()
setMutable Identifier
name Identifier
path Value m
body
  pure NoneV
evalS (IncludeS Expr
nameE IncludeMissingPolicy
missingPolicy IncludeContextPolicy
contextPolicy) = do
  name <- Expr -> GingerT m (Value m)
forall (m :: * -> *) a. Eval m a => a -> GingerT m (Value m)
eval Expr
nameE GingerT m (Value m)
-> (Value m -> GingerT m Text) -> GingerT m Text
forall a b. GingerT m a -> (a -> GingerT m b) -> GingerT m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Either RuntimeError Text -> GingerT m Text
forall (m :: * -> *) e (t :: (* -> *) -> * -> *) a.
(Monad m, MonadError e (t m)) =>
Either e a -> t m a
eitherExcept (Either RuntimeError Text -> GingerT m Text)
-> (Value m -> Either RuntimeError Text)
-> Value m
-> GingerT m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value m -> Either RuntimeError Text
forall (m :: * -> *). Value m -> Either RuntimeError Text
asTextVal)
  templateMay <- case missingPolicy of
    IncludeMissingPolicy
RequireMissing -> LoadedTemplate -> Maybe LoadedTemplate
forall a. a -> Maybe a
Just (LoadedTemplate -> Maybe LoadedTemplate)
-> GingerT m LoadedTemplate -> GingerT m (Maybe LoadedTemplate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> GingerT m LoadedTemplate
forall (m :: * -> *). Monad m => Text -> GingerT m LoadedTemplate
loadTemplate Text
name
    IncludeMissingPolicy
IgnoreMissing -> Text -> GingerT m (Maybe LoadedTemplate)
forall (m :: * -> *).
Monad m =>
Text -> GingerT m (Maybe LoadedTemplate)
loadTemplateMaybe Text
name
  case templateMay of
    Maybe LoadedTemplate
Nothing ->
      Value m -> GingerT m (Value m)
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value m
forall (m :: * -> *). Value m
NoneV
    Just LoadedTemplate
template -> do
      Bool -> GingerT m (Value m) -> GingerT m (Value m)
forall (m :: * -> *) a.
Monad m =>
Bool -> GingerT m a -> GingerT m a
withScopeModifier (IncludeContextPolicy
contextPolicy IncludeContextPolicy -> IncludeContextPolicy -> Bool
forall a. Eq a => a -> a -> Bool
== IncludeContextPolicy
WithContext) (GingerT m (Value m) -> GingerT m (Value m))
-> GingerT m (Value m) -> GingerT m (Value m)
forall a b. (a -> b) -> a -> b
$ LoadedTemplate -> GingerT m (Value m)
forall (m :: * -> *).
MonadRandom m =>
LoadedTemplate -> GingerT m (Value m)
evalLT LoadedTemplate
template
evalS (ImportS Expr
srcE Maybe Identifier
nameMay Maybe [(Identifier, Maybe Identifier)]
identifiers IncludeMissingPolicy
missingPolicy IncludeContextPolicy
contextPolicy) = GingerT m (Value m) -> GingerT m (Value m)
forall (m :: * -> *) a. Monad m => GingerT m a -> GingerT m a
hush (GingerT m (Value m) -> GingerT m (Value m))
-> GingerT m (Value m) -> GingerT m (Value m)
forall a b. (a -> b) -> a -> b
$ do
  src <- Expr -> GingerT m (Value m)
forall (m :: * -> *) a. Eval m a => a -> GingerT m (Value m)
eval Expr
srcE GingerT m (Value m)
-> (Value m -> GingerT m Text) -> GingerT m Text
forall a b. GingerT m a -> (a -> GingerT m b) -> GingerT m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Either RuntimeError Text -> GingerT m Text
forall (m :: * -> *) e (t :: (* -> *) -> * -> *) a.
(Monad m, MonadError e (t m)) =>
Either e a -> t m a
eitherExcept (Either RuntimeError Text -> GingerT m Text)
-> (Value m -> Either RuntimeError Text)
-> Value m
-> GingerT m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value m -> Either RuntimeError Text
forall (m :: * -> *). Value m -> Either RuntimeError Text
asTextVal)
  templateMay <- case missingPolicy of
    IncludeMissingPolicy
RequireMissing -> LoadedTemplate -> Maybe LoadedTemplate
forall a. a -> Maybe a
Just (LoadedTemplate -> Maybe LoadedTemplate)
-> GingerT m LoadedTemplate -> GingerT m (Maybe LoadedTemplate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> GingerT m LoadedTemplate
forall (m :: * -> *). Monad m => Text -> GingerT m LoadedTemplate
loadTemplate Text
src
    IncludeMissingPolicy
IgnoreMissing -> Text -> GingerT m (Maybe LoadedTemplate)
forall (m :: * -> *).
Monad m =>
Text -> GingerT m (Maybe LoadedTemplate)
loadTemplateMaybe Text
src
  case templateMay of
    Maybe LoadedTemplate
Nothing ->
      Value m -> GingerT m (Value m)
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value m
forall (m :: * -> *). Value m
NoneV
    Just LoadedTemplate
template -> do
      e' <- GingerT m (Env m) -> GingerT m (Env m)
forall (m :: * -> *) a. Monad m => GingerT m a -> GingerT m a
scoped (GingerT m (Env m) -> GingerT m (Env m))
-> (GingerT m (Env m) -> GingerT m (Env m))
-> GingerT m (Env m)
-> GingerT m (Env m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> GingerT m (Env m) -> GingerT m (Env m)
forall (m :: * -> *) a.
Monad m =>
Bool -> GingerT m a -> GingerT m a
withScopeModifier (IncludeContextPolicy
contextPolicy IncludeContextPolicy -> IncludeContextPolicy -> Bool
forall a. Eq a => a -> a -> Bool
== IncludeContextPolicy
WithContext) (GingerT m (Env m) -> GingerT m (Env m))
-> GingerT m (Env m) -> GingerT m (Env m)
forall a b. (a -> b) -> a -> b
$ do
              GingerT m (Value m) -> GingerT m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (GingerT m (Value m) -> GingerT m ())
-> GingerT m (Value m) -> GingerT m ()
forall a b. (a -> b) -> a -> b
$ LoadedTemplate -> GingerT m (Value m)
forall (m :: * -> *).
MonadRandom m =>
LoadedTemplate -> GingerT m (Value m)
evalLT LoadedTemplate
template
              (EvalState m -> Env m) -> GingerT m (Env m)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EvalState m -> Env m
forall (m :: * -> *). EvalState m -> Env m
evalEnv
      let vars = case Maybe [(Identifier, Maybe Identifier)]
identifiers of
            Maybe [(Identifier, Maybe Identifier)]
Nothing ->
              case Maybe Identifier
nameMay of
                Maybe Identifier
Nothing -> Env m -> Map Identifier (Value m)
forall (m :: * -> *). Env m -> Map Identifier (Value m)
envVars Env m
e'
                Just Identifier
name -> Identifier -> Value m -> Map Identifier (Value m)
forall k a. k -> a -> Map k a
Map.singleton Identifier
name (Map Scalar (Value m) -> Value m
forall (m :: * -> *). Map Scalar (Value m) -> Value m
DictV (Map Scalar (Value m) -> Value m)
-> (Map Identifier (Value m) -> Map Scalar (Value m))
-> Map Identifier (Value m)
-> Value m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Identifier -> Scalar)
-> Map Identifier (Value m) -> Map Scalar (Value m)
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys Identifier -> Scalar
forall a. ToScalar a => a -> Scalar
toScalar (Map Identifier (Value m) -> Value m)
-> Map Identifier (Value m) -> Value m
forall a b. (a -> b) -> a -> b
$ Env m -> Map Identifier (Value m)
forall (m :: * -> *). Env m -> Map Identifier (Value m)
envVars Env m
e')
            Just [(Identifier, Maybe Identifier)]
importees -> [(Identifier, Value m)] -> Map Identifier (Value m)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Identifier, Value m)] -> Map Identifier (Value m))
-> ([Maybe (Identifier, Value m)] -> [(Identifier, Value m)])
-> [Maybe (Identifier, Value m)]
-> Map Identifier (Value m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Identifier, Value m)] -> [(Identifier, Value m)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Identifier, Value m)] -> Map Identifier (Value m))
-> [Maybe (Identifier, Value m)] -> Map Identifier (Value m)
forall a b. (a -> b) -> a -> b
$
              [ (Identifier -> Maybe Identifier -> Identifier
forall a. a -> Maybe a -> a
fromMaybe Identifier
varName Maybe Identifier
alias,) (Value m -> (Identifier, Value m))
-> Maybe (Value m) -> Maybe (Identifier, Value m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Identifier -> Map Identifier (Value m) -> Maybe (Value m)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Identifier
varName (Env m -> Map Identifier (Value m)
forall (m :: * -> *). Env m -> Map Identifier (Value m)
envVars Env m
e')
              | (Identifier
varName, Maybe Identifier
alias) <- [(Identifier, Maybe Identifier)]
importees
              ]
      setVars vars
      pure NoneV
evalS (BlockS Identifier
name Block
block) =
  Identifier -> Block -> GingerT m (Value m)
forall (m :: * -> *).
MonadRandom m =>
Identifier -> Block -> GingerT m (Value m)
evalBlock Identifier
name Block
block
evalS (WithS [(Identifier, Expr)]
varEs Statement
bodyS) = do
  vars <- [(Identifier, Value m)] -> Map Identifier (Value m)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Identifier, Value m)] -> Map Identifier (Value m))
-> GingerT m [(Identifier, Value m)]
-> GingerT m (Map Identifier (Value m))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Identifier, Expr) -> GingerT m (Identifier, Value m))
-> [(Identifier, Expr)] -> GingerT m [(Identifier, Value m)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\(Identifier
k, Expr
valE) -> (Identifier
k,) (Value m -> (Identifier, Value m))
-> GingerT m (Value m) -> GingerT m (Identifier, Value m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> GingerT m (Value m)
forall (m :: * -> *). MonadRandom m => Expr -> GingerT m (Value m)
evalE Expr
valE) [(Identifier, Expr)]
varEs
  scoped $ do
    setVars vars
    evalS bodyS
evalS (GroupS [Statement]
xs) = [Statement] -> GingerT m (Value m)
forall (m :: * -> *).
MonadRandom m =>
[Statement] -> GingerT m (Value m)
evalSs [Statement]
xs

objectIDFromContext :: Show a
                    => Text
                    -> a
                    -> Maybe SourcePosition
                    -> ObjectID
objectIDFromContext :: forall a. Show a => Text -> a -> Maybe SourcePosition -> ObjectID
objectIDFromContext Text
prefix a
x Maybe SourcePosition
posMay =
  Text -> ObjectID
ObjectID (Text -> ObjectID) -> Text -> ObjectID
forall a b. (a -> b) -> a -> b
$
    Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> (SourcePosition -> Text) -> Maybe SourcePosition -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (a -> Text
forall a. Show a => a -> Text
hashShow a
x) SourcePosition -> Text
forall a. Show a => a -> Text
hashShow Maybe SourcePosition
posMay

hush :: Monad m => GingerT m a -> GingerT m a
hush :: forall (m :: * -> *) a. Monad m => GingerT m a -> GingerT m a
hush = (Context m -> Context m) -> GingerT m a -> GingerT m a
forall a. (Context m -> Context m) -> GingerT m a -> GingerT m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\Context m
c -> Context m
c { contextOutput = Quiet })

hush_ :: Monad m => GingerT m a -> GingerT m ()
hush_ :: forall (m :: * -> *) a. Monad m => GingerT m a -> GingerT m ()
hush_ = GingerT m a -> GingerT m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (GingerT m a -> GingerT m ())
-> (GingerT m a -> GingerT m a) -> GingerT m a -> GingerT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GingerT m a -> GingerT m a
forall (m :: * -> *) a. Monad m => GingerT m a -> GingerT m a
hush

whenOutputPolicy :: Monad m => GingerT m (Value m) -> GingerT m (Value m)
whenOutputPolicy :: forall (m :: * -> *).
Monad m =>
GingerT m (Value m) -> GingerT m (Value m)
whenOutputPolicy GingerT m (Value m)
action = do
  outputPolicy <- (Context m -> OutputPolicy) -> GingerT m OutputPolicy
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Context m -> OutputPolicy
forall (m :: * -> *). Context m -> OutputPolicy
contextOutput
  if outputPolicy == Output then
    action
  else
    pure NoneV

withScopeModifier :: Monad m => Bool -> GingerT m a -> GingerT m a
withScopeModifier :: forall (m :: * -> *) a.
Monad m =>
Bool -> GingerT m a -> GingerT m a
withScopeModifier Bool
policy GingerT m a
inner = do
  let scopeModifier :: GingerT m a -> GingerT m a
scopeModifier = if Bool
policy then GingerT m a -> GingerT m a
forall a. a -> a
id else GingerT m a -> GingerT m a
forall (m :: * -> *) a. Monad m => GingerT m a -> GingerT m a
withoutContext
  GingerT m a -> GingerT m a
forall {a}. GingerT m a -> GingerT m a
scopeModifier GingerT m a
inner

evalBlock :: MonadRandom m => Identifier -> Block -> GingerT m (Value m)
evalBlock :: forall (m :: * -> *).
MonadRandom m =>
Identifier -> Block -> GingerT m (Value m)
evalBlock Identifier
name Block
block = do
  lblock <- Identifier -> Block -> GingerT m LoadedBlock
forall (m :: * -> *).
Monad m =>
Identifier -> Block -> GingerT m LoadedBlock
setBlock Identifier
name Block
block
  super <- makeSuper (loadedBlockParent lblock)
  whenOutputPolicy .
    withScopeModifier (is $ lblockScoped lblock) .
      scoped $ do
        setVar "super" super
        evalS (blockBody . loadedBlock $ lblock)

lblockScoped :: LoadedBlock -> Scoped
lblockScoped :: LoadedBlock -> Scoped
lblockScoped LoadedBlock
lb =
  case LoadedBlock -> Maybe LoadedBlock
loadedBlockParent LoadedBlock
lb of
    Maybe LoadedBlock
Nothing -> Block -> Scoped
blockScoped (LoadedBlock -> Block
loadedBlock LoadedBlock
lb)
    Just LoadedBlock
parent -> LoadedBlock -> Scoped
lblockScoped LoadedBlock
parent

makeSuper :: MonadRandom m => Maybe LoadedBlock -> GingerT m (Value m)
makeSuper :: forall (m :: * -> *).
MonadRandom m =>
Maybe LoadedBlock -> GingerT m (Value m)
makeSuper Maybe LoadedBlock
Nothing = Value m -> GingerT m (Value m)
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value m
forall (m :: * -> *). Value m
NoneV
makeSuper (Just LoadedBlock
lblock) = do
  ctx <- GingerT m (Context m)
forall r (m :: * -> *). MonadReader r m => m r
ask
  env <- gets evalEnv
  parent <- makeSuper (loadedBlockParent lblock)
  pure $ dictV
    [ "__call__" .=
        ProcedureV
          (mkFn0 "super()"
              "Evaluate the parent template"
              Nothing $
              eitherExceptM $
                runGingerT
                  (evalS . blockBody . loadedBlock $ lblock)
                  ctx
                  env
          )
    , "super" .= parent
    ]

asBool :: Monad m => Text -> Value m -> GingerT m Bool
asBool :: forall (m :: * -> *). Monad m => Text -> Value m -> GingerT m Bool
asBool Text
context Value m
x = (RuntimeError -> GingerT m Bool)
-> (Bool -> GingerT m Bool)
-> Either RuntimeError Bool
-> GingerT m Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either RuntimeError -> GingerT m Bool
forall a. RuntimeError -> GingerT m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Bool -> GingerT m Bool
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError Bool -> GingerT m Bool)
-> Either RuntimeError Bool -> GingerT m Bool
forall a b. (a -> b) -> a -> b
$ Text -> Value m -> Either RuntimeError Bool
forall (m :: * -> *). Text -> Value m -> Either RuntimeError Bool
asBoolVal Text
context Value m
x

asTruth :: Monad m => Text -> Value m -> GingerT m Bool
asTruth :: forall (m :: * -> *). Monad m => Text -> Value m -> GingerT m Bool
asTruth Text
context Value m
x = (RuntimeError -> GingerT m Bool)
-> (Bool -> GingerT m Bool)
-> Either RuntimeError Bool
-> GingerT m Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either RuntimeError -> GingerT m Bool
forall a. RuntimeError -> GingerT m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Bool -> GingerT m Bool
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError Bool -> GingerT m Bool)
-> Either RuntimeError Bool -> GingerT m Bool
forall a b. (a -> b) -> a -> b
$ Text -> Value m -> Either RuntimeError Bool
forall (m :: * -> *). Text -> Value m -> Either RuntimeError Bool
asTruthVal Text
context Value m
x

evalLoop :: forall m. MonadRandom m
         => Maybe Identifier
         -> Identifier
         -> Value m
         -> Maybe Expr
         -> Recursivity
         -> Statement
         -> Maybe Statement
         -> Int
         -> GingerT m (Value m)
evalLoop :: forall (m :: * -> *).
MonadRandom m =>
Maybe Identifier
-> Identifier
-> Value m
-> Maybe Expr
-> Recursivity
-> Statement
-> Maybe Statement
-> Int
-> GingerT m (Value m)
evalLoop Maybe Identifier
loopKeyMay Identifier
loopName Value m
iteree Maybe Expr
loopCondMay Recursivity
recursivity Statement
bodyS Maybe Statement
elseSMay Int
recursionLevel = do
  -- First, convert the iteree into a plain list.

  itemPairs <- case Value m
iteree of
    ListV Vector (Value m)
items -> Vector (Value m, Value m) -> GingerT m (Vector (Value m, Value m))
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Vector (Value m) -> Vector (Value m) -> Vector (Value m, Value m)
forall a b. Vector a -> Vector b -> Vector (a, b)
V.zip ((Integer -> Value m) -> Vector Integer -> Vector (Value m)
forall a b. (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Value m
forall (m :: * -> *). Integer -> Value m
IntV [Integer
Item (Vector Integer)
0..]) Vector (Value m)
items)
    DictV Map Scalar (Value m)
dict -> (Vector (Value m, Value m) -> GingerT m (Vector (Value m, Value m))
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Vector (Value m, Value m)
 -> GingerT m (Vector (Value m, Value m)))
-> ([(Value m, Value m)] -> Vector (Value m, Value m))
-> [(Value m, Value m)]
-> GingerT m (Vector (Value m, Value m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Value m, Value m)] -> Vector (Value m, Value m)
forall a. [a] -> Vector a
V.fromList) [ (Scalar -> Value m
forall (m :: * -> *). Scalar -> Value m
ScalarV Scalar
k, Value m
v) | (Scalar
k, Value m
v) <- Map Scalar (Value m) -> [(Scalar, Value m)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Scalar (Value m)
dict ]
    Value m
NoneV -> Vector (Value m, Value m) -> GingerT m (Vector (Value m, Value m))
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Vector (Value m, Value m)
forall a. Monoid a => a
mempty
    Value m
x -> RuntimeError -> GingerT m (Vector (Value m, Value m))
forall a. RuntimeError -> GingerT m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (RuntimeError -> GingerT m (Vector (Value m, Value m)))
-> RuntimeError -> GingerT m (Vector (Value m, Value m))
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> RuntimeError
TagError Text
"iteree" Text
"list or dict" (Value m -> Text
forall (m :: * -> *). Value m -> Text
tagNameOf Value m
x)

  filtered <- maybe (pure itemPairs) (goFilter itemPairs) loopCondMay

  if null filtered then
    case elseSMay of
      Maybe Statement
Nothing -> Value m -> GingerT m (Value m)
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value m
forall (m :: * -> *). Value m
NoneV
      Just Statement
elseS -> Statement -> GingerT m (Value m)
forall (m :: * -> *).
MonadRandom m =>
Statement -> GingerT m (Value m)
evalS Statement
elseS
  else
    go 0 (length filtered) Nothing filtered
  where
    goFilter :: Vector (Value m, Value m) -> Expr -> GingerT m (Vector (Value m, Value m))
    goFilter :: Vector (Value m, Value m)
-> Expr -> GingerT m (Vector (Value m, Value m))
goFilter Vector (Value m, Value m)
pairs Expr
condE =
      case Vector (Value m, Value m)
-> Maybe ((Value m, Value m), Vector (Value m, Value m))
forall a. Vector a -> Maybe (a, Vector a)
V.uncons Vector (Value m, Value m)
pairs of
        Maybe ((Value m, Value m), Vector (Value m, Value m))
Nothing ->
          Vector (Value m, Value m) -> GingerT m (Vector (Value m, Value m))
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Vector (Value m, Value m)
forall a. Monoid a => a
mempty
        Just ((Value m
k, Value m
v), Vector (Value m, Value m)
xs) -> do
          keep <- GingerT m Bool -> GingerT m Bool
forall (m :: * -> *) a. Monad m => GingerT m a -> GingerT m a
scoped (GingerT m Bool -> GingerT m Bool)
-> GingerT m Bool -> GingerT m Bool
forall a b. (a -> b) -> a -> b
$ do
            -- Bind key and value
            GingerT m ()
-> (Identifier -> GingerT m ()) -> Maybe Identifier -> GingerT m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> GingerT m ()
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (\Identifier
loopKey -> Identifier -> Value m -> GingerT m ()
forall (m :: * -> *).
Monad m =>
Identifier -> Value m -> GingerT m ()
setVar Identifier
loopKey Value m
k) Maybe Identifier
loopKeyMay
            Identifier -> Value m -> GingerT m ()
forall (m :: * -> *).
Monad m =>
Identifier -> Value m -> GingerT m ()
setVar Identifier
loopName Value m
v
            Text -> Value m -> GingerT m Bool
forall (m :: * -> *). Monad m => Text -> Value m -> GingerT m Bool
asTruth Text
"loop condition" (Value m -> GingerT m Bool)
-> GingerT m (Value m) -> GingerT m Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Expr -> GingerT m (Value m)
forall (m :: * -> *). MonadRandom m => Expr -> GingerT m (Value m)
evalE Expr
condE
          rest <- goFilter xs condE
          if keep then
            pure $ V.cons (k, v) rest
          else
            pure rest

    go :: Int -> Int -> Maybe (Value m) -> Vector (Value m, Value m) -> GingerT m (Value m)
    go :: Int
-> Int
-> Maybe (Value m)
-> Vector (Value m, Value m)
-> GingerT m (Value m)
go Int
n Int
num Maybe (Value m)
prevVal Vector (Value m, Value m)
pairs = do
      case Vector (Value m, Value m)
-> Maybe ((Value m, Value m), Vector (Value m, Value m))
forall a. Vector a -> Maybe (a, Vector a)
V.uncons Vector (Value m, Value m)
pairs of
        Maybe ((Value m, Value m), Vector (Value m, Value m))
Nothing -> Value m -> GingerT m (Value m)
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value m
forall (m :: * -> *). Value m
NoneV
        Just ((Value m
k, Value m
v), Vector (Value m, Value m)
xs) -> do
          (prevVal', body) <- GingerT m (Maybe (Value m), Value m)
-> GingerT m (Maybe (Value m), Value m)
forall (m :: * -> *) a. Monad m => GingerT m a -> GingerT m a
scoped (GingerT m (Maybe (Value m), Value m)
 -> GingerT m (Maybe (Value m), Value m))
-> GingerT m (Maybe (Value m), Value m)
-> GingerT m (Maybe (Value m), Value m)
forall a b. (a -> b) -> a -> b
$ do
            -- Bind key and value
            GingerT m ()
-> (Identifier -> GingerT m ()) -> Maybe Identifier -> GingerT m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> GingerT m ()
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (\Identifier
loopKey -> Identifier -> Value m -> GingerT m ()
forall (m :: * -> *).
Monad m =>
Identifier -> Value m -> GingerT m ()
setVar Identifier
loopKey Value m
k) Maybe Identifier
loopKeyMay
            Identifier -> Value m -> GingerT m ()
forall (m :: * -> *).
Monad m =>
Identifier -> Value m -> GingerT m ()
setVar Identifier
loopName Value m
v
            env <- (EvalState m -> Env m) -> GingerT m (Env m)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EvalState m -> Env m
forall (m :: * -> *). EvalState m -> Env m
evalEnv
            srcPosMay <- gets evalSourcePosition
            let recurFuncID =
                  Text -> Statement -> Maybe SourcePosition -> ObjectID
forall a. Show a => Text -> a -> Maybe SourcePosition -> ObjectID
objectIDFromContext
                    Text
"loop.recur" Statement
bodyS Maybe SourcePosition
srcPosMay
            let cycleFuncID =
                  Text -> Statement -> Maybe SourcePosition -> ObjectID
forall a. Show a => Text -> a -> Maybe SourcePosition -> ObjectID
objectIDFromContext
                    Text
"loop.cycle" Statement
bodyS Maybe SourcePosition
srcPosMay
            setVar "loop" $
              dictV
                [ "index" .= (n + 1)
                , "index0" .= n
                , "revindex" .= (num - n)
                , "revindex0" .= (num - n - 1)
                , "first" .= (n == 0)
                , "last" .= (n == num - 1)
                , "length" .= num
                , "cycle" .= cycleFunc cycleFuncID n
                , "depth" .= (recursionLevel + 1)
                , "depth0" .= recursionLevel
                , "previtem" .= prevVal
                , "nextitem" .= (snd <$> xs V.!? 0)
                , "changed" .= changedFunc env v
                , "__call__" .= if is recursivity then Just (recurFunc recurFuncID env) else Nothing
                ]
            body <- evalS bodyS
            pure (Just v, body)

          rest <- go (succ n) num prevVal' xs
          concatValues body rest

    changedFunc :: Env m -> Value m -> Value m
    changedFunc :: Env m -> Value m -> Value m
changedFunc Env m
env Value m
v = Procedure m -> Value m
forall (m :: * -> *). Procedure m -> Value m
ProcedureV (Procedure m -> Value m) -> Procedure m -> Value m
forall a b. (a -> b) -> a -> b
$ Env m -> [(Identifier, Maybe (Value m))] -> Expr -> Procedure m
forall (m :: * -> *).
Env m -> [(Identifier, Maybe (Value m))] -> Expr -> Procedure m
GingerProcedure Env m
env [(Identifier
"val", Value m -> Maybe (Value m)
forall a. a -> Maybe a
Just Value m
v)] (Expr -> Procedure m) -> Expr -> Procedure m
forall a b. (a -> b) -> a -> b
$
      Expr -> Expr -> Expr
EqualE (Expr -> Expr -> Expr
IndexE (Identifier -> Expr
VarE Identifier
"loop") (Text -> Expr
StringLitE Text
"previtem")) (Identifier -> Expr
VarE Identifier
"val")

    recurFunc :: ObjectID -> Env m -> Value m
    recurFunc :: ObjectID -> Env m -> Value m
recurFunc ObjectID
oid Env m
env =
      Procedure m -> Value m
forall (m :: * -> *). Procedure m -> Value m
ProcedureV (Procedure m -> Value m)
-> (([(Maybe Identifier, Value m)]
     -> Context m -> m (Either RuntimeError (Value m)))
    -> Procedure m)
-> ([(Maybe Identifier, Value m)]
    -> Context m -> m (Either RuntimeError (Value m)))
-> Value m
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        ObjectID
-> Maybe ProcedureDoc
-> ([(Maybe Identifier, Value m)]
    -> Context m -> m (Either RuntimeError (Value m)))
-> Procedure m
forall (m :: * -> *).
ObjectID
-> Maybe ProcedureDoc
-> ([(Maybe Identifier, Value m)]
    -> Context m -> m (Either RuntimeError (Value m)))
-> Procedure m
NativeProcedure
          ObjectID
oid
          (ProcedureDoc -> Maybe ProcedureDoc
forall a. a -> Maybe a
Just ProcedureDoc
            { procedureDocName :: Text
procedureDocName = Text
"loop.recur"
            , procedureDocArgs :: Vector ArgumentDoc
procedureDocArgs = Vector ArgumentDoc
forall a. Monoid a => a
mempty
            , procedureDocReturnType :: Maybe TypeDoc
procedureDocReturnType = TypeDoc -> Maybe TypeDoc
forall a. a -> Maybe a
Just (TypeDoc -> Maybe TypeDoc) -> TypeDoc -> Maybe TypeDoc
forall a b. (a -> b) -> a -> b
$ Text -> TypeDoc
TypeDocSingle Text
"markup"
            , procedureDocDescription :: Text
procedureDocDescription =
                Text
"Recurse one level deeper into the iteree"
            }
          )
          (([(Maybe Identifier, Value m)]
  -> Context m -> m (Either RuntimeError (Value m)))
 -> Value m)
-> ([(Maybe Identifier, Value m)]
    -> Context m -> m (Either RuntimeError (Value m)))
-> Value m
forall a b. (a -> b) -> a -> b
$ \[(Maybe Identifier, Value m)]
args Context m
ctx -> do
                case [(Maybe Identifier, Value m)]
args of
                  [(Maybe Identifier
_, Value m
iteree')] ->
                    GingerT m (Value m)
-> Context m -> Env m -> m (Either RuntimeError (Value m))
forall (m :: * -> *) a.
MonadRandom m =>
GingerT m a -> Context m -> Env m -> m (Either RuntimeError a)
runGingerT
                      (Maybe Identifier
-> Identifier
-> Value m
-> Maybe Expr
-> Recursivity
-> Statement
-> Maybe Statement
-> Int
-> GingerT m (Value m)
forall (m :: * -> *).
MonadRandom m =>
Maybe Identifier
-> Identifier
-> Value m
-> Maybe Expr
-> Recursivity
-> Statement
-> Maybe Statement
-> Int
-> GingerT m (Value m)
evalLoop
                        Maybe Identifier
loopKeyMay
                        Identifier
loopName
                        Value m
iteree'
                        Maybe Expr
loopCondMay
                        Recursivity
recursivity
                        Statement
bodyS
                        Maybe Statement
elseSMay
                        (Int -> Int
forall a. Enum a => a -> a
succ Int
recursionLevel))
                      Context m
ctx
                      Env m
env
                  [] -> Either RuntimeError (Value m) -> m (Either RuntimeError (Value m))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError (Value m)
 -> m (Either RuntimeError (Value m)))
-> (RuntimeError -> Either RuntimeError (Value m))
-> RuntimeError
-> m (Either RuntimeError (Value m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuntimeError -> Either RuntimeError (Value m)
forall a b. a -> Either a b
Left (RuntimeError -> m (Either RuntimeError (Value m)))
-> RuntimeError -> m (Either RuntimeError (Value m))
forall a b. (a -> b) -> a -> b
$
                          Text -> Text -> Text -> Text -> RuntimeError
ArgumentError Text
"loop()" Text
"1" Text
"argument" Text
"end of arguments"
                  [(Maybe Identifier, Value m)]
_ -> Either RuntimeError (Value m) -> m (Either RuntimeError (Value m))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError (Value m)
 -> m (Either RuntimeError (Value m)))
-> (RuntimeError -> Either RuntimeError (Value m))
-> RuntimeError
-> m (Either RuntimeError (Value m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuntimeError -> Either RuntimeError (Value m)
forall a b. a -> Either a b
Left (RuntimeError -> m (Either RuntimeError (Value m)))
-> RuntimeError -> m (Either RuntimeError (Value m))
forall a b. (a -> b) -> a -> b
$
                          Text -> Text -> Text -> Text -> RuntimeError
ArgumentError Text
"loop()" Text
"2" Text
"end of arguments" Text
"argument"
      

    cycleFunc :: ObjectID -> Int -> Value m
    cycleFunc :: ObjectID -> Int -> Value m
cycleFunc ObjectID
oid Int
n =
      Procedure m -> Value m
forall (m :: * -> *). Procedure m -> Value m
ProcedureV (Procedure m -> Value m)
-> (([(Maybe Identifier, Value m)]
     -> Context m -> m (Either RuntimeError (Value m)))
    -> Procedure m)
-> ([(Maybe Identifier, Value m)]
    -> Context m -> m (Either RuntimeError (Value m)))
-> Value m
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        ObjectID
-> Maybe ProcedureDoc
-> ([(Maybe Identifier, Value m)]
    -> Context m -> m (Either RuntimeError (Value m)))
-> Procedure m
forall (m :: * -> *).
ObjectID
-> Maybe ProcedureDoc
-> ([(Maybe Identifier, Value m)]
    -> Context m -> m (Either RuntimeError (Value m)))
-> Procedure m
NativeProcedure
          ObjectID
oid
          (ProcedureDoc -> Maybe ProcedureDoc
forall a. a -> Maybe a
Just ProcedureDoc
            { procedureDocName :: Text
procedureDocName = Text
"loop.cycle"
            , procedureDocArgs :: Vector ArgumentDoc
procedureDocArgs =
                [ Text -> Maybe TypeDoc -> Maybe Text -> Text -> ArgumentDoc
ArgumentDoc
                    Text
"items"
                    (TypeDoc -> Maybe TypeDoc
forall a. a -> Maybe a
Just (TypeDoc -> Maybe TypeDoc) -> TypeDoc -> Maybe TypeDoc
forall a b. (a -> b) -> a -> b
$ Text -> TypeDoc
TypeDocSingle Text
"list<any>")
                    Maybe Text
forall a. Maybe a
Nothing
                    Text
""
                ]
            , procedureDocReturnType :: Maybe TypeDoc
procedureDocReturnType = TypeDoc -> Maybe TypeDoc
forall a. a -> Maybe a
Just TypeDoc
TypeDocAny
            , procedureDocDescription :: Text
procedureDocDescription =
                Text
"Cycle through 'items': on the n-th iteration of the loop, " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                Text
"cycle(items) will return items[n % length(items)]."
            }
          )
          (([(Maybe Identifier, Value m)]
  -> Context m -> m (Either RuntimeError (Value m)))
 -> Value m)
-> ([(Maybe Identifier, Value m)]
    -> Context m -> m (Either RuntimeError (Value m)))
-> Value m
forall a b. (a -> b) -> a -> b
$ \[(Maybe Identifier, Value m)]
args Context m
_ctx -> do
              case [(Maybe Identifier, Value m)]
args of
                [(Maybe Identifier
_, Value m
items)] ->
                  case Value m
items of
                    ListV [] ->
                      Either RuntimeError (Value m) -> m (Either RuntimeError (Value m))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError (Value m)
 -> m (Either RuntimeError (Value m)))
-> (Value m -> Either RuntimeError (Value m))
-> Value m
-> m (Either RuntimeError (Value m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value m -> Either RuntimeError (Value m)
forall a b. b -> Either a b
Right (Value m -> m (Either RuntimeError (Value m)))
-> Value m -> m (Either RuntimeError (Value m))
forall a b. (a -> b) -> a -> b
$ Value m
forall (m :: * -> *). Value m
NoneV
                    ListV Vector (Value m)
xs -> do
                      let n' :: Int
n' = Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Vector (Value m) -> Int
forall a. Vector a -> Int
V.length Vector (Value m)
xs
                      Either RuntimeError (Value m) -> m (Either RuntimeError (Value m))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError (Value m)
 -> m (Either RuntimeError (Value m)))
-> (Maybe (Value m) -> Either RuntimeError (Value m))
-> Maybe (Value m)
-> m (Either RuntimeError (Value m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value m -> Either RuntimeError (Value m)
forall a b. b -> Either a b
Right (Value m -> Either RuntimeError (Value m))
-> (Maybe (Value m) -> Value m)
-> Maybe (Value m)
-> Either RuntimeError (Value m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Value m) -> Value m
forall a (m :: * -> *). ToValue a m => a -> Value m
toValue (Maybe (Value m) -> m (Either RuntimeError (Value m)))
-> Maybe (Value m) -> m (Either RuntimeError (Value m))
forall a b. (a -> b) -> a -> b
$ Vector (Value m)
xs Vector (Value m) -> Int -> Maybe (Value m)
forall a. Vector a -> Int -> Maybe a
V.!? Int
n'
                    Value m
_ ->
                      Either RuntimeError (Value m) -> m (Either RuntimeError (Value m))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError (Value m)
 -> m (Either RuntimeError (Value m)))
-> (Value m -> Either RuntimeError (Value m))
-> Value m
-> m (Either RuntimeError (Value m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value m -> Either RuntimeError (Value m)
forall a b. b -> Either a b
Right (Value m -> m (Either RuntimeError (Value m)))
-> Value m -> m (Either RuntimeError (Value m))
forall a b. (a -> b) -> a -> b
$ Value m
forall (m :: * -> *). Value m
NoneV
                [(Maybe Identifier, Value m)]
_ -> Either RuntimeError (Value m) -> m (Either RuntimeError (Value m))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError (Value m)
 -> m (Either RuntimeError (Value m)))
-> (RuntimeError -> Either RuntimeError (Value m))
-> RuntimeError
-> m (Either RuntimeError (Value m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuntimeError -> Either RuntimeError (Value m)
forall a b. a -> Either a b
Left (RuntimeError -> m (Either RuntimeError (Value m)))
-> RuntimeError -> m (Either RuntimeError (Value m))
forall a b. (a -> b) -> a -> b
$
                        Text -> Text -> Text -> Text -> RuntimeError
ArgumentError Text
"cycle()" Text
"1" Text
"end of arguments" Text
"argument"


evalSs :: MonadRandom m => [Statement] -> GingerT m (Value m)
evalSs :: forall (m :: * -> *).
MonadRandom m =>
[Statement] -> GingerT m (Value m)
evalSs [Statement]
stmts = (Statement -> GingerT m (Value m))
-> [Statement] -> GingerT m [Value m]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Statement -> GingerT m (Value m)
forall (m :: * -> *).
MonadRandom m =>
Statement -> GingerT m (Value m)
evalS [Statement]
stmts GingerT m [Value m]
-> ([Value m] -> GingerT m (Value m)) -> GingerT m (Value m)
forall a b. GingerT m a -> (a -> GingerT m b) -> GingerT m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value m -> Value m -> GingerT m (Value m))
-> Value m -> [Value m] -> GingerT m (Value m)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Value m -> Value m -> GingerT m (Value m)
forall (m :: * -> *).
Monad m =>
Value m -> Value m -> GingerT m (Value m)
concatValues Value m
forall (m :: * -> *). Value m
NoneV