{-# 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
, splitRNG
)
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.StringFormatting
import Language.Ginger.Value

import Control.Monad (foldM, forM, void)
import Control.Monad.Except
  ( MonadError (..)
  , throwError
  )
import Control.Monad.Reader (ask , asks, local, MonadReader (..))
import Control.Monad.State (gets, modify)
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
import qualified System.Random as R

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
  Maybe LoadedTemplate
sMay <- Text -> GingerT m (Maybe LoadedTemplate)
forall (m :: * -> *).
Monad m =>
Text -> GingerT m (Maybe LoadedTemplate)
loadTemplateMaybe Text
name
  case Maybe LoadedTemplate
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
  TemplateLoader m
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
  Maybe Text
srcMay <- m (Maybe Text) -> GingerT m (Maybe Text)
forall (m :: * -> *) a. Monad m => m a -> GingerT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TemplateLoader m
loader Text
name)
  case Maybe Text
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
          Maybe LoadedTemplate
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 :: Statement
body = Template -> Statement
templateBody Template
t
          Maybe LoadedTemplate -> GingerT m (Maybe LoadedTemplate)
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe LoadedTemplate -> GingerT m (Maybe LoadedTemplate))
-> (LoadedTemplate -> Maybe LoadedTemplate)
-> LoadedTemplate
-> GingerT m (Maybe LoadedTemplate)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoadedTemplate -> Maybe LoadedTemplate
forall a. a -> Maybe a
Just (LoadedTemplate -> GingerT m (Maybe LoadedTemplate))
-> LoadedTemplate -> GingerT m (Maybe LoadedTemplate)
forall a b. (a -> b) -> a -> b
$ Maybe LoadedTemplate -> Statement -> LoadedTemplate
LoadedTemplate Maybe LoadedTemplate
parent Statement
body

mapArgs :: forall m. Monad m
        => Text
        -> [(Identifier, Maybe (Value m))]
        -> [(Maybe Identifier, Value m)]
        -> GingerT m (Map Identifier (Value m))
mapArgs :: forall (m :: * -> *).
Monad 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
          Map Identifier (Value m)
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)
          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) -> GingerT m (Map Identifier (Value m)))
-> Map Identifier (Value m) -> GingerT m (Map Identifier (Value m))
forall a b. (a -> b) -> a -> b
$ Map Identifier (Value m)
cur Map Identifier (Value m)
-> Map Identifier (Value m) -> Map Identifier (Value m)
forall a. Semigroup a => a -> a -> a
<> Map Identifier (Value m)
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
              Map Identifier (Value m)
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
              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) -> GingerT m (Map Identifier (Value m)))
-> Map Identifier (Value m) -> GingerT m (Map Identifier (Value m))
forall a b. (a -> b) -> a -> b
$ Map Identifier (Value m)
cur Map Identifier (Value m)
-> Map Identifier (Value m) -> Map Identifier (Value m)
forall a. Semigroup a => a -> a -> a
<> Map Identifier (Value m)
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
                  Map Identifier (Value m)
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
                  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) -> GingerT m (Map Identifier (Value m)))
-> Map Identifier (Value m) -> GingerT m (Map Identifier (Value m))
forall a b. (a -> b) -> a -> b
$ Map Identifier (Value m)
cur Map Identifier (Value m)
-> Map Identifier (Value m) -> Map Identifier (Value m)
forall a. Semigroup a => a -> a -> a
<> Map Identifier (Value m)
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 :: Monad m => [Expr] -> [(Identifier, Expr)] -> GingerT m [(Maybe Identifier, Value m)]
evalCallArgs :: forall (m :: * -> *).
Monad m =>
[Expr]
-> [(Identifier, Expr)] -> GingerT m [(Maybe Identifier, Value m)]
evalCallArgs [Expr]
posArgsExpr [(Identifier, Expr)]
namedArgsExpr = do
  [Value m]
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 :: * -> *). Monad m => Expr -> GingerT m (Value m)
evalE [Expr]
posArgsExpr
  [(Maybe Identifier, Value m)]
namedArgs <- ((Identifier, Expr) -> GingerT m (Maybe Identifier, Value m))
-> [(Identifier, Expr)] -> GingerT m [(Maybe 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, Expr) -> GingerT m (Maybe Identifier, Value m)
forall (m :: * -> *).
Monad m =>
(Identifier, Expr) -> GingerT m (Maybe Identifier, Value m)
evalNamedArg [(Identifier, Expr)]
namedArgsExpr
  [(Maybe Identifier, Value m)]
-> GingerT m [(Maybe Identifier, Value m)]
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Maybe Identifier, Value m)]
 -> GingerT m [(Maybe Identifier, Value m)])
-> [(Maybe Identifier, Value m)]
-> GingerT m [(Maybe Identifier, Value m)]
forall a b. (a -> b) -> a -> b
$ [Maybe Identifier] -> [Value m] -> [(Maybe Identifier, Value m)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Maybe Identifier -> [Maybe Identifier]
forall a. a -> [a]
repeat Maybe Identifier
forall a. Maybe a
Nothing) [Value m]
posArgs [(Maybe Identifier, Value m)]
-> [(Maybe Identifier, Value m)] -> [(Maybe Identifier, Value m)]
forall a. [a] -> [a] -> [a]
++ [(Maybe Identifier, Value m)]
namedArgs

splitRNG :: Monad m => GingerT m SomePRNG
splitRNG :: forall (m :: * -> *). Monad m => GingerT m SomePRNG
splitRNG = do
  SomePRNG
rng <- (EvalState m -> SomePRNG) -> GingerT m SomePRNG
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EvalState m -> SomePRNG
forall (m :: * -> *). EvalState m -> SomePRNG
evalPRNG
  let (SomePRNG
rngL, SomePRNG
rngR) = SomePRNG -> (SomePRNG, SomePRNG)
forall g. SplitGen g => g -> (g, g)
R.splitGen SomePRNG
rng
  (EvalState m -> EvalState m) -> GingerT m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EvalState m
e -> EvalState m
e { evalPRNG = rngL })
  SomePRNG -> GingerT m SomePRNG
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SomePRNG
rngR

callTest :: Monad m => Value m -> Expr -> [Expr] -> [(Identifier, Expr)] -> GingerT m (Value m)
callTest :: forall (m :: * -> *).
Monad 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
      [(Maybe Identifier, Value m)]
args <- [Expr]
-> [(Identifier, Expr)] -> GingerT m [(Maybe Identifier, Value m)]
forall (m :: * -> *).
Monad m =>
[Expr]
-> [(Identifier, Expr)] -> GingerT m [(Maybe Identifier, Value m)]
evalCallArgs [Expr]
posArgsExpr [(Identifier, Expr)]
namedArgsExpr
      Context m
ctx <- GingerT m (Context m)
forall r (m :: * -> *). MonadReader r m => m r
ask
      Env m
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
      SomePRNG
rng <- GingerT m SomePRNG
forall (m :: * -> *). Monad m => GingerT m SomePRNG
splitRNG
      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
<$> 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 (Test m -> TestFunc m
forall (m :: * -> *). Test m -> TestFunc m
runTest Test m
t Expr
scrutinee [(Maybe Identifier, Value m)]
args Context m
ctx Env m
env SomePRNG
rng)

    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 :: * -> *). Monad 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 :: * -> *).
Monad 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 :: Monad m => Value m -> Expr -> [Expr] -> [(Identifier, Expr)] -> GingerT m (Value m)
callFilter :: forall (m :: * -> *).
Monad 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
      [(Maybe Identifier, Value m)]
args <- [Expr]
-> [(Identifier, Expr)] -> GingerT m [(Maybe Identifier, Value m)]
forall (m :: * -> *).
Monad m =>
[Expr]
-> [(Identifier, Expr)] -> GingerT m [(Maybe Identifier, Value m)]
evalCallArgs [Expr]
posArgsExpr [(Identifier, Expr)]
namedArgsExpr
      Context m
ctx <- GingerT m (Context m)
forall r (m :: * -> *). MonadReader r m => m r
ask
      Env m
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
      SomePRNG
rng <- GingerT m SomePRNG
forall (m :: * -> *). Monad m => GingerT m SomePRNG
splitRNG
      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 (Filter m -> FilterFunc m
forall (m :: * -> *). Filter m -> FilterFunc m
runFilter Filter m
f Expr
scrutinee [(Maybe Identifier, Value m)]
args Context m
ctx Env m
env SomePRNG
rng)

    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 :: * -> *). Monad 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 :: * -> *).
Monad 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 :: Monad m => Maybe (Value m) -> Value m -> [Expr] -> [(Identifier, Expr)] -> GingerT m (Value m)
call :: forall (m :: * -> *).
Monad 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
  [(Maybe Identifier, Value m)]
args <- [Expr]
-> [(Identifier, Expr)] -> GingerT m [(Maybe Identifier, Value m)]
forall (m :: * -> *).
Monad m =>
[Expr]
-> [(Identifier, Expr)] -> GingerT m [(Maybe Identifier, Value m)]
evalCallArgs [Expr]
posArgsExpr [(Identifier, Expr)]
namedArgsExpr
  case Value m
callable of
    ProcedureV (NativeProcedure ObjectID
_ Maybe ProcedureDoc
_ [(Maybe Identifier, Value m)]
-> Context m -> SomePRNG -> 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
        Context m
ctx <- GingerT m (Context m)
forall r (m :: * -> *). MonadReader r m => m r
ask
        SomePRNG
rng <- GingerT m SomePRNG
forall (m :: * -> *). Monad m => GingerT m SomePRNG
splitRNG
        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
$ [(Maybe Identifier, Value m)]
-> Context m -> SomePRNG -> m (Either RuntimeError (Value m))
f [(Maybe Identifier, Value m)]
args Context m
ctx SomePRNG
rng
    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
        Map Identifier (Value m)
argDict <- Text
-> [(Identifier, Maybe (Value m))]
-> [(Maybe Identifier, Value m)]
-> GingerT m (Map Identifier (Value m))
forall (m :: * -> *).
Monad 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
        GingerT m (Value m) -> GingerT m (Value m)
forall (m :: * -> *) a. Monad m => GingerT m a -> GingerT m a
scoped (GingerT m (Value m) -> GingerT m (Value m))
-> GingerT m (Value m) -> GingerT m (Value m)
forall a b. (a -> b) -> a -> b
$ do
          Map Identifier (Value m) -> GingerT m ()
forall (m :: * -> *).
Monad m =>
Map Identifier (Value m) -> GingerT m ()
setVars Map Identifier (Value m)
argDict
          Expr -> GingerT m (Value m)
forall (m :: * -> *). Monad m => Expr -> GingerT m (Value m)
evalE Expr
f
    ProcedureV Procedure m
NamespaceProcedure -> do
      RefID
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)
      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
$ RefID -> Value m
forall (m :: * -> *). RefID -> Value m
MutableRefV RefID
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 :: * -> *).
Monad 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 Monad m => Eval m Expr where
  eval :: Expr -> GingerT m (Value m)
eval = Expr -> GingerT m (Value m)
forall (m :: * -> *). Monad m => Expr -> GingerT m (Value m)
evalE

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

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

-- | Evaluate an expression, dereferencing mutable refs.
evalE :: Monad m => Expr -> GingerT m (Value m)
evalE :: forall (m :: * -> *). Monad m => Expr -> GingerT m (Value m)
evalE Expr
expr =
  Expr -> GingerT m (Value m)
forall (m :: * -> *). Monad 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' :: Monad m => Expr -> GingerT m (Value m)
evalE' :: forall (m :: * -> *). Monad m => Expr -> GingerT m (Value m)
evalE' (PositionedE SourcePosition
pos Expr
e) = do
  Expr -> GingerT m (Value m)
forall (m :: * -> *). Monad 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 :: * -> *). Monad 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 :: * -> *).
Monad m =>
(Expr, Expr) -> GingerT m (Scalar, Value m)
evalKV [(Expr, Expr)]
xs
evalE' (UnaryE UnaryOperator
op Expr
expr) = do
  Value m
v <- Expr -> GingerT m (Value m)
forall (m :: * -> *). Monad m => Expr -> GingerT m (Value m)
evalE Expr
expr
  UnaryOperator -> Value m -> GingerT m (Value m)
forall (m :: * -> *).
Monad m =>
UnaryOperator -> Value m -> GingerT m (Value m)
evalUnary UnaryOperator
op Value m
v
evalE' (BinaryE BinaryOperator
op Expr
aExpr Expr
bExpr) = do
  Value m
a <- Expr -> GingerT m (Value m)
forall (m :: * -> *). Monad m => Expr -> GingerT m (Value m)
evalE Expr
aExpr
  Value m
b <- Expr -> GingerT m (Value m)
forall (m :: * -> *). Monad m => Expr -> GingerT m (Value m)
evalE Expr
bExpr
  BinaryOperator -> Value m -> Value m -> GingerT m (Value m)
forall (m :: * -> *).
Monad m =>
BinaryOperator -> Value m -> Value m -> GingerT m (Value m)
evalBinary BinaryOperator
op Value m
a Value m
b
evalE' (DotE Expr
aExpr Identifier
b) = do
  Value m
a <- Expr -> GingerT m (Value m)
forall (m :: * -> *). Monad m => Expr -> GingerT m (Value m)
evalE Expr
aExpr
  Maybe (Value m)
attrMay <- Value m -> Identifier -> GingerT m (Maybe (Value m))
forall (m :: * -> *).
Monad m =>
Value m -> Identifier -> GingerT m (Maybe (Value m))
getAttr Value m
a Identifier
b
  case Maybe (Value m)
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
      Maybe (Value m)
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 Maybe (Value m)
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
  Value m
slicee <- Expr -> GingerT m (Value m)
forall (m :: * -> *). Monad m => Expr -> GingerT m (Value m)
evalE Expr
sliceeE
  Maybe (Value m)
beginMay <- (Expr -> GingerT m (Value m))
-> Maybe Expr -> GingerT m (Maybe (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) -> Maybe a -> m (Maybe b)
mapM Expr -> GingerT m (Value m)
forall (m :: * -> *). Monad m => Expr -> GingerT m (Value m)
evalE Maybe Expr
beginEMay
  Maybe (Value m)
endMay <- (Expr -> GingerT m (Value m))
-> Maybe Expr -> GingerT m (Maybe (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) -> Maybe a -> m (Maybe b)
mapM Expr -> GingerT m (Value m)
forall (m :: * -> *). Monad m => Expr -> GingerT m (Value m)
evalE Maybe Expr
endEMay
  Value m
-> Maybe (Value m) -> Maybe (Value m) -> GingerT m (Value m)
forall (m :: * -> *).
Monad m =>
Value m
-> Maybe (Value m) -> Maybe (Value m) -> GingerT m (Value m)
sliceValue Value m
slicee Maybe (Value m)
beginMay Maybe (Value m)
endMay
evalE' (CallE Expr
callableExpr [Expr]
posArgsExpr [(Identifier, Expr)]
namedArgsExpr) = do
  Value m
callable <- Expr -> GingerT m (Value m)
forall (m :: * -> *). Monad m => Expr -> GingerT m (Value m)
evalE Expr
callableExpr
  Maybe (Value m)
-> Value m -> [Expr] -> [(Identifier, Expr)] -> GingerT m (Value m)
forall (m :: * -> *).
Monad m =>
Maybe (Value m)
-> Value m -> [Expr] -> [(Identifier, Expr)] -> GingerT m (Value m)
call Maybe (Value m)
forall a. Maybe a
Nothing Value m
callable [Expr]
posArgsExpr [(Identifier, Expr)]
namedArgsExpr
evalE' (FilterE Expr
scrutinee Expr
filterE [Expr]
args [(Identifier, Expr)]
kwargs) = do
  Value m
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)
  Value m
-> Expr -> [Expr] -> [(Identifier, Expr)] -> GingerT m (Value m)
forall (m :: * -> *).
Monad m =>
Value m
-> Expr -> [Expr] -> [(Identifier, Expr)] -> GingerT m (Value m)
callFilter Value m
f Expr
scrutinee [Expr]
args [(Identifier, Expr)]
kwargs
evalE' (TernaryE Expr
condExpr Expr
yesExpr Expr
noExpr) = do
  Bool
cond <- Expr -> GingerT m (Value m)
forall (m :: * -> *). Monad 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"
  Expr -> GingerT m (Value m)
forall (m :: * -> *). Monad m => Expr -> GingerT m (Value m)
evalE (if Bool
cond then Expr
yesExpr else Expr
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 :: * -> *). Monad m => Statement -> GingerT m (Value m)
evalS Statement
statement
evalE' (IsE Expr
scrutinee Expr
testE [Expr]
args [(Identifier, Expr)]
kwargs) = do
  Value m
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 :: * -> *). Monad m => Expr -> GingerT m (Value m)
evalE Expr
testE)
  Value m
-> Expr -> [Expr] -> [(Identifier, Expr)] -> GingerT m (Value m)
forall (m :: * -> *).
Monad m =>
Value m
-> Expr -> [Expr] -> [(Identifier, Expr)] -> GingerT m (Value m)
callTest Value m
t Expr
scrutinee [Expr]
args [(Identifier, Expr)]
kwargs

evalKV :: Monad m => (Expr, Expr) -> GingerT m (Scalar, Value m)
evalKV :: forall (m :: * -> *).
Monad m =>
(Expr, Expr) -> GingerT m (Scalar, Value m)
evalKV (Expr
kExpr, Expr
vExpr) = do
  Value m
kVal <- Expr -> GingerT m (Value m)
forall (m :: * -> *). Monad m => Expr -> GingerT m (Value m)
evalE Expr
kExpr
  Scalar
kScalar <- case Value m
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)
  Value m
vVal <- Expr -> GingerT m (Value m)
forall (m :: * -> *). Monad m => Expr -> GingerT m (Value m)
evalE Expr
vExpr
  (Scalar, Value m) -> GingerT m (Scalar, Value m)
forall a. a -> GingerT m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Scalar
kScalar, Value m
vVal)

evalNamedArg :: Monad m => (Identifier, Expr) -> GingerT m (Maybe Identifier, Value m)
evalNamedArg :: forall (m :: * -> *).
Monad m =>
(Identifier, Expr) -> GingerT m (Maybe Identifier, Value m)
evalNamedArg (Identifier
kIdent, Expr
vExpr) = do
  Value m
vVal <- Expr -> GingerT m (Value m)
forall (m :: * -> *). Monad m => Expr -> GingerT m (Value m)
evalE Expr
vExpr
  (Maybe Identifier, Value m)
-> GingerT m (Maybe Identifier, Value m)
forall a. a -> GingerT m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Identifier -> Maybe Identifier
forall a. a -> Maybe a
Just Identifier
kIdent, Value m
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
  Maybe Integer
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
  Maybe Integer
endMay <- (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 end") Maybe (Value m)
endValMay
  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))
-> (Vector (Value m) -> Value m)
-> Vector (Value m)
-> GingerT m (Value m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (Value m) -> Value m
forall (m :: * -> *). Vector (Value m) -> Value m
ListV (Vector (Value m) -> GingerT m (Value m))
-> Vector (Value m) -> GingerT m (Value m)
forall a b. (a -> b) -> a -> b
$ Vector (Value m) -> Maybe Int -> Maybe Int -> Vector (Value m)
forall a. Vector a -> Maybe Int -> Maybe Int -> Vector a
sliceVector Vector (Value m)
xs (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Maybe Integer -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Integer
startMay) (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Maybe Integer -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Integer
endMay)
sliceValue (StringV Text
xs) Maybe (Value m)
startValMay Maybe (Value m)
endValMay = do
  Maybe Integer
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
  Maybe Integer
endMay <- (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 end") Maybe (Value m)
endValMay
  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
. Text -> Value m
forall (m :: * -> *). Text -> Value m
StringV (Text -> GingerT m (Value m)) -> Text -> GingerT m (Value m)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Int -> Maybe Int -> Text
sliceText Text
xs (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Maybe Integer -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Integer
startMay) (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Maybe Integer -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Integer
endMay)
sliceValue (BytesV StrictByteString
xs) Maybe (Value m)
startValMay Maybe (Value m)
endValMay = do
  Maybe Integer
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
  Maybe Integer
endMay <- (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 end") Maybe (Value m)
endValMay
  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))
-> (StrictByteString -> Value m)
-> StrictByteString
-> GingerT m (Value m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictByteString -> Value m
forall (m :: * -> *). StrictByteString -> Value m
BytesV (StrictByteString -> GingerT m (Value m))
-> StrictByteString -> GingerT m (Value m)
forall a b. (a -> b) -> a -> b
$ StrictByteString -> Maybe Int -> Maybe Int -> StrictByteString
sliceByteString StrictByteString
xs (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Maybe Integer -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Integer
startMay) (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Maybe Integer -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Integer
endMay)
sliceValue (EncodedV (Encoded Text
xs)) Maybe (Value m)
startValMay Maybe (Value m)
endValMay = do
  Maybe Integer
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
  Maybe Integer
endMay <- (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 end") Maybe (Value m)
endValMay
  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 -> Maybe Int -> Maybe Int -> Text
sliceText Text
xs (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Maybe Integer -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Integer
startMay) (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Maybe Integer -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Integer
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
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
  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
$ Bool -> Value m
forall (m :: * -> *). Bool -> Value m
BoolV (Ordering -> Bool
f Ordering
ordering)

printfValues :: Monad m => Text -> Value m -> GingerT m (Value m)
printfValues :: forall (m :: * -> *).
Monad m =>
Text -> Value m -> GingerT m (Value m)
printfValues Text
fmtText (ListV Vector (Value m)
args) = do
  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))
-> (String -> Value m) -> String -> GingerT m (Value m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value m
forall (m :: * -> *). Text -> Value m
StringV (Text -> Value m) -> (String -> Text) -> String -> Value m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> GingerT m (Value m)) -> String -> GingerT m (Value m)
forall a b. (a -> b) -> a -> b
$ String -> [Value m] -> String
forall a. PrintfArg a => String -> [a] -> String
printfList (Text -> String
Text.unpack Text
fmtText) (Vector (Value m) -> [Value m]
forall a. Vector a -> [a]
V.toList Vector (Value m)
args)
printfValues Text
fmtText Value m
x = do
  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))
-> (String -> Value m) -> String -> GingerT m (Value m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value m
forall (m :: * -> *). Text -> Value m
StringV (Text -> Value m) -> (String -> Text) -> String -> Value m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> GingerT m (Value m)) -> String -> GingerT m (Value m)
forall a b. (a -> b) -> a -> b
$ String -> [Value m] -> String
forall a. PrintfArg a => String -> [a] -> String
printfList (Text -> String
Text.unpack Text
fmtText) [Item [Value m]
Value m
x]

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 :: * -> *).
Monad m =>
Text -> Value m -> GingerT 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
      Bool
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 Bool
found then
        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
$ Bool
True
      else
        BinaryOperator -> Value m -> Value m -> GingerT m (Value m)
forall (m :: * -> *).
Monad m =>
BinaryOperator -> Value m -> Value m -> GingerT m (Value m)
evalBinary BinaryOperator
BinopIn Value m
a (Vector (Value m) -> Value m
forall (m :: * -> *). Vector (Value m) -> Value m
ListV Vector (Value m)
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
  Maybe (Value m)
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 Maybe (Value m)
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
      Maybe (Value m)
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 Maybe (Value m)
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
    Encoded
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
    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
$ Encoded -> Value m
forall (m :: * -> *). Encoded -> Value m
EncodedV (Encoded
x Encoded -> Encoded -> Encoded
forall a. Semigroup a => a -> a -> a
<> Encoded
yEnc)
  (Value m
x, EncodedV Encoded
y) -> do
    Encoded
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
    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
$ Encoded -> Value m
forall (m :: * -> *). Encoded -> Value m
EncodedV (Encoded
xEnc Encoded -> Encoded -> Encoded
forall a. Semigroup a => a -> a -> a
<> Encoded
y)

  -- Anything else is cast to and concatenated as strings
  (Value m
x, Value m
y) -> do
    Text
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
    Text
yStr <- Value m -> GingerT m Text
forall (m :: * -> *) (t :: (* -> *) -> * -> *).
(Monad m, MonadError RuntimeError (t m), MonadTrans t) =>
Value m -> t m Text
stringify 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))
-> (Text -> Value m) -> Text -> GingerT m (Value m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value m
forall (m :: * -> *). Text -> Value m
StringV (Text -> GingerT m (Value m)) -> Text -> GingerT m (Value m)
forall a b. (a -> b) -> a -> b
$ Text
xStr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
yStr

evalT :: Monad m => Template -> GingerT m (Value m)
evalT :: forall (m :: * -> *). Monad 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 :: * -> *). Monad m => Statement -> GingerT m (Value m)
evalS (Template -> Statement
templateBody Template
t)
    Just Text
parentName -> do
      LoadedTemplate
parent <- Text -> GingerT m LoadedTemplate
forall (m :: * -> *). Monad m => Text -> GingerT m LoadedTemplate
loadTemplate Text
parentName
      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 :: * -> *). Monad m => Statement -> GingerT m (Value m)
evalS (Template -> Statement
templateBody Template
t)
      LoadedTemplate -> GingerT m (Value m)
forall (m :: * -> *).
Monad m =>
LoadedTemplate -> GingerT m (Value m)
evalLT LoadedTemplate
parent

evalLT :: Monad m => LoadedTemplate -> GingerT m (Value m)
evalLT :: forall (m :: * -> *).
Monad 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 :: * -> *). Monad 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 :: * -> *). Monad m => Statement -> GingerT m (Value m)
evalS (LoadedTemplate -> Statement
loadedTemplateBody LoadedTemplate
t)
      LoadedTemplate -> GingerT m (Value m)
forall (m :: * -> *).
Monad m =>
LoadedTemplate -> GingerT m (Value m)
evalLT LoadedTemplate
parent

evalS :: Monad m => Statement -> GingerT m (Value m)
evalS :: forall (m :: * -> *). Monad m => Statement -> GingerT m (Value m)
evalS (PositionedS SourcePosition
pos Statement
s) = do
  Statement -> GingerT m (Value m)
forall (m :: * -> *). Monad 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 :: * -> *). Monad 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
  Value m
iteree <- Expr -> GingerT m (Value m)
forall (m :: * -> *). Monad m => Expr -> GingerT m (Value m)
evalE Expr
itereeE
  Maybe Identifier
-> Identifier
-> Value m
-> Maybe Expr
-> Recursivity
-> Statement
-> Maybe Statement
-> Int
-> GingerT m (Value m)
forall (m :: * -> *).
Monad 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
0
evalS (IfS Expr
condE Statement
yesS Maybe Statement
noSMay) = do
  Bool
cond <- Expr -> GingerT m (Value m)
forall (m :: * -> *). Monad 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 Bool
cond then Statement -> GingerT m (Value m)
forall (m :: * -> *). Monad m => Statement -> GingerT m (Value m)
evalS Statement
yesS else GingerT m (Value m)
-> (Statement -> GingerT m (Value m))
-> Maybe Statement
-> GingerT m (Value m)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (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) Statement -> GingerT m (Value m)
forall (m :: * -> *). Monad m => Statement -> GingerT m (Value m)
evalS Maybe Statement
noSMay
evalS (MacroS Identifier
name [MacroArg]
argsSig Statement
body) = do
  Env m
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
  [(Identifier, Maybe (Value m))]
argsSig' <- (MacroArg -> GingerT m (Identifier, Maybe (Value m)))
-> [MacroArg] -> GingerT m [(Identifier, Maybe (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
argname, Maybe Expr
defEMay) -> do
                  Maybe (Value m)
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 :: * -> *). Monad m => Expr -> GingerT m (Value m)
evalE) Maybe Expr
defEMay
                  (Identifier, Maybe (Value m))
-> GingerT m (Identifier, Maybe (Value m))
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Identifier
argname, Maybe (Value m)
defMay)
                )
                [MacroArg]
argsSig
  Identifier -> Value m -> GingerT m ()
forall (m :: * -> *).
Monad m =>
Identifier -> Value m -> GingerT m ()
setVar Identifier
name (Value m -> GingerT m ())
-> (Procedure m -> Value m) -> Procedure m -> GingerT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Procedure m -> Value m
forall (m :: * -> *). Procedure m -> Value m
ProcedureV (Procedure m -> GingerT m ()) -> Procedure m -> GingerT 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, Maybe (Value m))]
argsSig' (Statement -> Expr
StatementE Statement
body)
  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 (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
  Value m
callee <- Identifier -> GingerT m (Value m)
forall (m :: * -> *). Monad m => Identifier -> GingerT m (Value m)
lookupVar Identifier
name
  Value m
callerVal <- Statement -> GingerT m (Value m)
forall (m :: * -> *) a. Eval m a => a -> GingerT m (Value m)
eval Statement
bodyS
  Maybe SourcePosition
srcPosMay <- (EvalState m -> Maybe SourcePosition)
-> GingerT m (Maybe SourcePosition)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EvalState m -> Maybe SourcePosition
forall (m :: * -> *). EvalState m -> Maybe SourcePosition
evalSourcePosition
  let callerID :: ObjectID
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 :: Value m
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 -> SomePRNG -> m (Either RuntimeError (Value m)))
-> Procedure m
forall (m :: * -> *).
ObjectID
-> Maybe ProcedureDoc
-> ([(Maybe Identifier, Value m)]
    -> Context m -> SomePRNG -> 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 -> SomePRNG -> m (Either RuntimeError (Value m)))
-> [(Maybe Identifier, Value m)]
-> Context m
-> SomePRNG
-> m (Either RuntimeError (Value m))
forall a b. a -> b -> a
const ((Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
 -> [(Maybe Identifier, Value m)]
 -> Context m
 -> SomePRNG
 -> m (Either RuntimeError (Value m)))
-> (Value m
    -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
-> Value m
-> [(Maybe Identifier, Value m)]
-> Context m
-> SomePRNG
-> m (Either RuntimeError (Value m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomePRNG -> m (Either RuntimeError (Value m)))
-> Context m -> SomePRNG -> m (Either RuntimeError (Value m))
forall a b. a -> b -> a
const ((SomePRNG -> m (Either RuntimeError (Value m)))
 -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
-> (Value m -> SomePRNG -> m (Either RuntimeError (Value m)))
-> Value m
-> Context m
-> SomePRNG
-> m (Either RuntimeError (Value m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Either RuntimeError (Value m))
-> SomePRNG -> m (Either RuntimeError (Value m))
forall a b. a -> b -> a
const (m (Either RuntimeError (Value m))
 -> SomePRNG -> m (Either RuntimeError (Value m)))
-> (Value m -> m (Either RuntimeError (Value m)))
-> Value m
-> SomePRNG
-> 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
 -> SomePRNG
 -> m (Either RuntimeError (Value m)))
-> Value m
-> [(Maybe Identifier, Value m)]
-> Context m
-> SomePRNG
-> m (Either RuntimeError (Value m))
forall a b. (a -> b) -> a -> b
$ Value m
callerVal)
  Maybe (Value m)
-> Value m -> [Expr] -> [(Identifier, Expr)] -> GingerT m (Value m)
forall (m :: * -> *).
Monad m =>
Maybe (Value m)
-> Value m -> [Expr] -> [(Identifier, Expr)] -> GingerT m (Value m)
call (Value m -> Maybe (Value m)
forall a. a -> Maybe a
Just Value m
caller) Value m
callee [Expr]
posArgsExpr [(Identifier, Expr)]
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
  Value m
callee <- Identifier -> GingerT m (Value m)
forall (m :: * -> *). Monad m => Identifier -> GingerT m (Value m)
lookupVar Identifier
name
  let posArgsExpr' :: [Expr]
posArgsExpr' = Statement -> Expr
StatementE Statement
bodyS Expr -> [Expr] -> [Expr]
forall a. a -> [a] -> [a]
: [Expr]
posArgsExpr
  Maybe (Value m)
-> Value m -> [Expr] -> [(Identifier, Expr)] -> GingerT m (Value m)
forall (m :: * -> *).
Monad m =>
Maybe (Value m)
-> Value m -> [Expr] -> [(Identifier, Expr)] -> GingerT m (Value m)
call Maybe (Value m)
forall a. Maybe a
Nothing Value m
callee [Expr]
posArgsExpr' [(Identifier, Expr)]
namedArgsExpr

evalS (SetS SetTarget
target Expr
valE) = do
  Value m
val <- Expr -> GingerT m (Value m)
forall (m :: * -> *). Monad m => Expr -> GingerT m (Value m)
evalE' Expr
valE
  case SetTarget
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
  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 (SetBlockS SetTarget
target Statement
bodyS Maybe Expr
filterEMaybe) = do
  Value m
body <- case Maybe Expr
filterEMaybe of
            Maybe Expr
Nothing ->
              Statement -> GingerT m (Value m)
forall (m :: * -> *). Monad 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 :: * -> *). Monad 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 :: * -> *). Monad 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 SetTarget
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
  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 (IncludeS Expr
nameE IncludeMissingPolicy
missingPolicy IncludeContextPolicy
contextPolicy) = do
  Text
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)
  Maybe LoadedTemplate
templateMay <- case IncludeMissingPolicy
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 Maybe LoadedTemplate
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 :: * -> *).
Monad 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
  Text
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)
  Maybe LoadedTemplate
templateMay <- case IncludeMissingPolicy
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 Maybe LoadedTemplate
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
      Env m
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 :: * -> *).
Monad 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 :: Map Identifier (Value m)
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
              ]
      Map Identifier (Value m) -> GingerT m ()
forall (m :: * -> *).
Monad m =>
Map Identifier (Value m) -> GingerT m ()
setVars Map Identifier (Value m)
vars
      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 (BlockS Identifier
name Block
block) =
  Identifier -> Block -> GingerT m (Value m)
forall (m :: * -> *).
Monad m =>
Identifier -> Block -> GingerT m (Value m)
evalBlock Identifier
name Block
block
evalS (WithS [(Identifier, Expr)]
varEs Statement
bodyS) = do
  Map Identifier (Value m)
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 :: * -> *). Monad m => Expr -> GingerT m (Value m)
evalE Expr
valE) [(Identifier, Expr)]
varEs
  GingerT m (Value m) -> GingerT m (Value m)
forall (m :: * -> *) a. Monad m => GingerT m a -> GingerT m a
scoped (GingerT m (Value m) -> GingerT m (Value m))
-> GingerT m (Value m) -> GingerT m (Value m)
forall a b. (a -> b) -> a -> b
$ do
    Map Identifier (Value m) -> GingerT m ()
forall (m :: * -> *).
Monad m =>
Map Identifier (Value m) -> GingerT m ()
setVars Map Identifier (Value m)
vars
    Statement -> GingerT m (Value m)
forall (m :: * -> *). Monad m => Statement -> GingerT m (Value m)
evalS Statement
bodyS
evalS (GroupS [Statement]
xs) = [Statement] -> GingerT m (Value m)
forall (m :: * -> *). Monad 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
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
outputPolicy OutputPolicy -> OutputPolicy -> Bool
forall a. Eq a => a -> a -> Bool
== OutputPolicy
Output then
    GingerT m (Value m)
action
  else
    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

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 :: Monad m => Identifier -> Block -> GingerT m (Value m)
evalBlock :: forall (m :: * -> *).
Monad m =>
Identifier -> Block -> GingerT m (Value m)
evalBlock Identifier
name Block
block = do
  LoadedBlock
lblock <- Identifier -> Block -> GingerT m LoadedBlock
forall (m :: * -> *).
Monad m =>
Identifier -> Block -> GingerT m LoadedBlock
setBlock Identifier
name Block
block
  Value m
super <- Maybe LoadedBlock -> GingerT m (Value m)
forall (m :: * -> *).
Monad m =>
Maybe LoadedBlock -> GingerT m (Value m)
makeSuper (LoadedBlock -> Maybe LoadedBlock
loadedBlockParent LoadedBlock
lblock)
  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))
-> GingerT m (Value m)
-> GingerT m (Value m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Bool -> GingerT m (Value m) -> GingerT m (Value m)
forall (m :: * -> *) a.
Monad m =>
Bool -> GingerT m a -> GingerT m a
withScopeModifier (Scoped -> Bool
forall a. Boolish a => a -> Bool
is (Scoped -> Bool) -> Scoped -> Bool
forall a b. (a -> b) -> a -> b
$ LoadedBlock -> Scoped
lblockScoped LoadedBlock
lblock) (GingerT m (Value m) -> GingerT m (Value m))
-> (GingerT m (Value m) -> GingerT m (Value m))
-> GingerT m (Value m)
-> GingerT m (Value m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      GingerT m (Value m) -> GingerT m (Value m)
forall (m :: * -> *) a. Monad m => GingerT m a -> GingerT m a
scoped (GingerT m (Value m) -> GingerT m (Value m))
-> GingerT m (Value m) -> GingerT m (Value m)
forall a b. (a -> b) -> a -> b
$ do
        Identifier -> Value m -> GingerT m ()
forall (m :: * -> *).
Monad m =>
Identifier -> Value m -> GingerT m ()
setVar Identifier
"super" Value m
super
        Statement -> GingerT m (Value m)
forall (m :: * -> *). Monad m => Statement -> GingerT m (Value m)
evalS (Block -> Statement
blockBody (Block -> Statement)
-> (LoadedBlock -> Block) -> LoadedBlock -> Statement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoadedBlock -> Block
loadedBlock (LoadedBlock -> Statement) -> LoadedBlock -> Statement
forall a b. (a -> b) -> a -> b
$ 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 :: Monad m => Maybe LoadedBlock -> GingerT m (Value m)
makeSuper :: forall (m :: * -> *).
Monad 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
  Context m
ctx <- GingerT m (Context m)
forall r (m :: * -> *). MonadReader r m => m r
ask
  Env m
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
  SomePRNG
rng <- GingerT m SomePRNG
forall (m :: * -> *). Monad m => GingerT m SomePRNG
splitRNG
  Value m
parent <- Maybe LoadedBlock -> GingerT m (Value m)
forall (m :: * -> *).
Monad m =>
Maybe LoadedBlock -> GingerT m (Value m)
makeSuper (LoadedBlock -> Maybe LoadedBlock
loadedBlockParent LoadedBlock
lblock)
  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
$ [(Scalar, Value m)] -> Value m
forall (m :: * -> *). [(Scalar, Value m)] -> Value m
dictV
    [ Scalar
"__call__" Scalar -> Value m -> (Scalar, Value m)
forall v (m :: * -> *).
ToValue v m =>
Scalar -> v -> (Scalar, Value m)
.=
        Procedure m -> Value m
forall (m :: * -> *). Procedure m -> Value m
ProcedureV
          (Text
-> Text
-> Maybe TypeDoc
-> ExceptT RuntimeError m (Value m)
-> Procedure m
forall (m :: * -> *) r.
(Monad m, ToValue r m) =>
Text
-> Text -> Maybe TypeDoc -> ExceptT RuntimeError m r -> Procedure m
mkFn0 Text
"super()"
              Text
"Evaluate the parent template"
              Maybe TypeDoc
forall a. Maybe a
Nothing (ExceptT RuntimeError m (Value m) -> Procedure m)
-> ExceptT RuntimeError m (Value m) -> Procedure m
forall a b. (a -> b) -> a -> b
$
              m (Either RuntimeError (Value m))
-> ExceptT RuntimeError m (Value m)
forall (m :: * -> *) e (t :: (* -> *) -> * -> *) a.
(Monad m, MonadError e (t m), MonadTrans t) =>
m (Either e a) -> t m a
eitherExceptM (m (Either RuntimeError (Value m))
 -> ExceptT RuntimeError m (Value m))
-> m (Either RuntimeError (Value m))
-> ExceptT RuntimeError m (Value m)
forall a b. (a -> b) -> a -> b
$
                GingerT m (Value m)
-> Context m
-> Env m
-> SomePRNG
-> m (Either RuntimeError (Value m))
forall (m :: * -> *) g a.
(Monad m, SplitGen g) =>
GingerT m a -> Context m -> Env m -> g -> m (Either RuntimeError a)
runGingerT
                  (Statement -> GingerT m (Value m)
forall (m :: * -> *). Monad m => Statement -> GingerT m (Value m)
evalS (Statement -> GingerT m (Value m))
-> (LoadedBlock -> Statement) -> LoadedBlock -> GingerT m (Value m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> Statement
blockBody (Block -> Statement)
-> (LoadedBlock -> Block) -> LoadedBlock -> Statement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoadedBlock -> Block
loadedBlock (LoadedBlock -> GingerT m (Value m))
-> LoadedBlock -> GingerT m (Value m)
forall a b. (a -> b) -> a -> b
$ LoadedBlock
lblock)
                  Context m
ctx
                  Env m
env
                  SomePRNG
rng
          )
    , Scalar
"super" Scalar -> Value m -> (Scalar, Value m)
forall v (m :: * -> *).
ToValue v m =>
Scalar -> v -> (Scalar, Value m)
.= Value m
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. Monad m
         => Maybe Identifier
         -> Identifier
         -> Value m
         -> Maybe Expr
         -> Recursivity
         -> Statement
         -> Maybe Statement
         -> Int
         -> GingerT m (Value m)
evalLoop :: forall (m :: * -> *).
Monad 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.

  Vector (Value m, Value m)
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)

  Vector (Value m, Value m)
filtered <- GingerT m (Vector (Value m, Value m))
-> (Expr -> GingerT m (Vector (Value m, Value m)))
-> Maybe Expr
-> GingerT m (Vector (Value m, Value m))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (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)
itemPairs) (Vector (Value m, Value m)
-> Expr -> GingerT m (Vector (Value m, Value m))
goFilter Vector (Value m, Value m)
itemPairs) Maybe Expr
loopCondMay

  if Vector (Value m, Value m) -> Bool
forall a. Vector a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Vector (Value m, Value m)
filtered then
    case Maybe Statement
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 :: * -> *). Monad m => Statement -> GingerT m (Value m)
evalS Statement
elseS
  else
    Int
-> Int
-> Maybe (Value m)
-> Vector (Value m, Value m)
-> GingerT m (Value m)
go Int
0 (Vector (Value m, Value m) -> Int
forall a. Vector a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Vector (Value m, Value m)
filtered) Maybe (Value m)
forall a. Maybe a
Nothing Vector (Value m, Value m)
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
          Bool
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 :: * -> *). Monad m => Expr -> GingerT m (Value m)
evalE Expr
condE
          Vector (Value m, Value m)
rest <- Vector (Value m, Value m)
-> Expr -> GingerT m (Vector (Value m, Value m))
goFilter Vector (Value m, Value m)
xs Expr
condE
          if Bool
keep then
            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)))
-> Vector (Value m, Value m)
-> GingerT m (Vector (Value m, Value m))
forall a b. (a -> b) -> a -> b
$ (Value m, Value m)
-> Vector (Value m, Value m) -> Vector (Value m, Value m)
forall a. a -> Vector a -> Vector a
V.cons (Value m
k, Value m
v) Vector (Value m, Value m)
rest
          else
            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)
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
          (Maybe (Value m)
prevVal', Value m
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 m
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
            Maybe SourcePosition
srcPosMay <- (EvalState m -> Maybe SourcePosition)
-> GingerT m (Maybe SourcePosition)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EvalState m -> Maybe SourcePosition
forall (m :: * -> *). EvalState m -> Maybe SourcePosition
evalSourcePosition
            let recurFuncID :: ObjectID
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 :: ObjectID
cycleFuncID =
                  Text -> Statement -> Maybe SourcePosition -> ObjectID
forall a. Show a => Text -> a -> Maybe SourcePosition -> ObjectID
objectIDFromContext
                    Text
"loop.cycle" Statement
bodyS Maybe SourcePosition
srcPosMay
            Identifier -> Value m -> GingerT m ()
forall (m :: * -> *).
Monad m =>
Identifier -> Value m -> GingerT m ()
setVar Identifier
"loop" (Value m -> GingerT m ()) -> Value m -> GingerT m ()
forall a b. (a -> b) -> a -> b
$
              [(Scalar, Value m)] -> Value m
forall (m :: * -> *). [(Scalar, Value m)] -> Value m
dictV
                [ Scalar
"index" Scalar -> Int -> (Scalar, Value m)
forall v (m :: * -> *).
ToValue v m =>
Scalar -> v -> (Scalar, Value m)
.= (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                , Scalar
"index0" Scalar -> Int -> (Scalar, Value m)
forall v (m :: * -> *).
ToValue v m =>
Scalar -> v -> (Scalar, Value m)
.= Int
n
                , Scalar
"revindex" Scalar -> Int -> (Scalar, Value m)
forall v (m :: * -> *).
ToValue v m =>
Scalar -> v -> (Scalar, Value m)
.= (Int
num Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n)
                , Scalar
"revindex0" Scalar -> Int -> (Scalar, Value m)
forall v (m :: * -> *).
ToValue v m =>
Scalar -> v -> (Scalar, Value m)
.= (Int
num Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                , Scalar
"first" Scalar -> Bool -> (Scalar, Value m)
forall v (m :: * -> *).
ToValue v m =>
Scalar -> v -> (Scalar, Value m)
.= (Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0)
                , Scalar
"last" Scalar -> Bool -> (Scalar, Value m)
forall v (m :: * -> *).
ToValue v m =>
Scalar -> v -> (Scalar, Value m)
.= (Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
num Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                , Scalar
"length" Scalar -> Int -> (Scalar, Value m)
forall v (m :: * -> *).
ToValue v m =>
Scalar -> v -> (Scalar, Value m)
.= Int
num
                , Scalar
"cycle" Scalar -> Value m -> (Scalar, Value m)
forall v (m :: * -> *).
ToValue v m =>
Scalar -> v -> (Scalar, Value m)
.= ObjectID -> Int -> Value m
cycleFunc ObjectID
cycleFuncID Int
n
                , Scalar
"depth" Scalar -> Int -> (Scalar, Value m)
forall v (m :: * -> *).
ToValue v m =>
Scalar -> v -> (Scalar, Value m)
.= (Int
recursionLevel Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                , Scalar
"depth0" Scalar -> Int -> (Scalar, Value m)
forall v (m :: * -> *).
ToValue v m =>
Scalar -> v -> (Scalar, Value m)
.= Int
recursionLevel
                , Scalar
"previtem" Scalar -> Maybe (Value m) -> (Scalar, Value m)
forall v (m :: * -> *).
ToValue v m =>
Scalar -> v -> (Scalar, Value m)
.= Maybe (Value m)
prevVal
                , Scalar
"nextitem" Scalar -> Maybe (Value m) -> (Scalar, Value m)
forall v (m :: * -> *).
ToValue v m =>
Scalar -> v -> (Scalar, Value m)
.= ((Value m, Value m) -> Value m
forall a b. (a, b) -> b
snd ((Value m, Value m) -> Value m)
-> Maybe (Value m, Value m) -> Maybe (Value m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector (Value m, Value m)
xs Vector (Value m, Value m) -> Int -> Maybe (Value m, Value m)
forall a. Vector a -> Int -> Maybe a
V.!? Int
0)
                , Scalar
"changed" Scalar -> Value m -> (Scalar, Value m)
forall v (m :: * -> *).
ToValue v m =>
Scalar -> v -> (Scalar, Value m)
.= Env m -> Value m -> Value m
changedFunc Env m
env Value m
v
                , Scalar
"__call__" Scalar -> Maybe (Value m) -> (Scalar, Value m)
forall v (m :: * -> *).
ToValue v m =>
Scalar -> v -> (Scalar, Value m)
.= if Recursivity -> Bool
forall a. Boolish a => a -> Bool
is Recursivity
recursivity then Value m -> Maybe (Value m)
forall a. a -> Maybe a
Just (ObjectID -> Env m -> Value m
recurFunc ObjectID
recurFuncID Env m
env) else Maybe (Value m)
forall a. Maybe a
Nothing
                ]
            Value m
body <- Statement -> GingerT m (Value m)
forall (m :: * -> *). Monad m => Statement -> GingerT m (Value m)
evalS Statement
bodyS
            (Maybe (Value m), Value m) -> GingerT m (Maybe (Value m), Value m)
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value m -> Maybe (Value m)
forall a. a -> Maybe a
Just Value m
v, Value m
body)

          Value m
rest <- Int
-> Int
-> Maybe (Value m)
-> Vector (Value m, Value m)
-> GingerT m (Value m)
go (Int -> Int
forall a. Enum a => a -> a
succ Int
n) Int
num Maybe (Value m)
prevVal' Vector (Value m, Value m)
xs
          Value m -> Value m -> GingerT m (Value m)
forall (m :: * -> *).
Monad m =>
Value m -> Value m -> GingerT m (Value m)
concatValues Value m
body Value m
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 -> SomePRNG -> m (Either RuntimeError (Value m)))
    -> Procedure m)
-> ([(Maybe Identifier, Value m)]
    -> Context m -> SomePRNG -> 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 -> SomePRNG -> m (Either RuntimeError (Value m)))
-> Procedure m
forall (m :: * -> *).
ObjectID
-> Maybe ProcedureDoc
-> ([(Maybe Identifier, Value m)]
    -> Context m -> SomePRNG -> 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 -> SomePRNG -> m (Either RuntimeError (Value m)))
 -> Value m)
-> ([(Maybe Identifier, Value m)]
    -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
-> Value m
forall a b. (a -> b) -> a -> b
$ \[(Maybe Identifier, Value m)]
args Context m
ctx SomePRNG
rng -> do
                case [(Maybe Identifier, Value m)]
args of
                  [(Maybe Identifier
_, Value m
iteree')] ->
                    GingerT m (Value m)
-> Context m
-> Env m
-> SomePRNG
-> m (Either RuntimeError (Value m))
forall (m :: * -> *) g a.
(Monad m, SplitGen g) =>
GingerT m a -> Context m -> Env m -> g -> m (Either RuntimeError a)
runGingerT
                      (Maybe Identifier
-> Identifier
-> Value m
-> Maybe Expr
-> Recursivity
-> Statement
-> Maybe Statement
-> Int
-> GingerT m (Value m)
forall (m :: * -> *).
Monad 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
                      SomePRNG
rng
                  [] -> 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 -> SomePRNG -> m (Either RuntimeError (Value m)))
    -> Procedure m)
-> ([(Maybe Identifier, Value m)]
    -> Context m -> SomePRNG -> 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 -> SomePRNG -> m (Either RuntimeError (Value m)))
-> Procedure m
forall (m :: * -> *).
ObjectID
-> Maybe ProcedureDoc
-> ([(Maybe Identifier, Value m)]
    -> Context m -> SomePRNG -> 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 -> SomePRNG -> m (Either RuntimeError (Value m)))
 -> Value m)
-> ([(Maybe Identifier, Value m)]
    -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
-> Value m
forall a b. (a -> b) -> a -> b
$ \[(Maybe Identifier, Value m)]
args Context m
_ctx SomePRNG
_rng -> 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 :: Monad m => [Statement] -> GingerT m (Value m)
evalSs :: forall (m :: * -> *). Monad 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 :: * -> *). Monad 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