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

module Language.Ginger.Interpret.DefEnv
where

import Language.Ginger.AST
import Language.Ginger.Interpret.Builtins
import Language.Ginger.Interpret.Eval
import Language.Ginger.Interpret.Type
import Language.Ginger.Render
import Language.Ginger.RuntimeError
import Language.Ginger.Value

import Control.Monad.Except
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe (isJust, fromJust)
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Lazy as LText
import Data.Text.Lazy.Builder (Builder)
import qualified Data.Text.Lazy.Builder as Builder
import qualified Data.Vector as V
import qualified System.Random as R

defEnv :: Monad m => Env m
defEnv :: forall (m :: * -> *). Monad m => Env m
defEnv =
  Env m
forall (m :: * -> *). Env m
emptyEnv
    { envVars = mempty
    }

defContext :: Monad m => Context m
defContext :: forall (m :: * -> *). Monad m => Context m
defContext =
  Context m
forall (m :: * -> *). Applicative m => Context m
emptyContext
    { contextVars = defVars
    , contextEncode = pure . htmlEncode
    }

htmlEncoder :: Monad m => Encoder m
htmlEncoder :: forall (m :: * -> *). Monad m => Encoder m
htmlEncoder Text
txt = do
  Encoded -> m Encoded
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoded -> m Encoded) -> Encoded -> m Encoded
forall a b. (a -> b) -> a -> b
$ Text -> Encoded
htmlEncode Text
txt

htmlEncode :: Text -> Encoded
htmlEncode :: Text -> Encoded
htmlEncode Text
txt =
  (Text -> Encoded
Encoded (Text -> Encoded) -> (Text -> Text) -> Text -> Encoded
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LazyText -> Text
LText.toStrict (LazyText -> Text) -> (Text -> LazyText) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> LazyText
Builder.toLazyText (Builder -> LazyText) -> (Text -> Builder) -> Text -> LazyText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Builder -> Char -> Builder) -> Builder -> Text -> Builder
forall a. (a -> Char -> a) -> a -> Text -> a
Text.foldl' Builder -> Char -> Builder
f Builder
forall a. Monoid a => a
mempty) Text
txt
  where
    f :: Builder -> Char -> Builder
    f :: Builder -> Char -> Builder
f Builder
lhs Char
c = Builder
lhs Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
encodeChar Char
c

    encodeChar :: Char -> Builder
    encodeChar :: Char -> Builder
encodeChar Char
'&' = Builder
"&amp;"
    encodeChar Char
'<' = Builder
"&lt;"
    encodeChar Char
'>' = Builder
"&gt;"
    encodeChar Char
'"' = Builder
"&quot;"
    encodeChar Char
'\'' = Builder
"&apos;"
    encodeChar Char
c = Char -> Builder
Builder.singleton Char
c

defVarsCommon :: forall m. Monad m
              => Map Identifier (Value m)
defVarsCommon :: forall (m :: * -> *). Monad m => Map Identifier (Value m)
defVarsCommon = [(Identifier, Value m)] -> Map Identifier (Value m)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
  [ ( Identifier
"__jinja__"
    , [(Scalar, Value m)] -> Value m
forall (m :: * -> *). [(Scalar, Value m)] -> Value m
dictV
      [ ( Scalar
"tests"
        , 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
$ Map Identifier (Value m)
forall (m :: * -> *). Monad m => Map Identifier (Value m)
builtinTests
        )
      , ( Scalar
"filters"
        , 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
$ Map Identifier (Value m)
forall (m :: * -> *). Monad m => Map Identifier (Value m)
builtinFilters
        )
      , ( Scalar
"globals"
        , 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
$ (Expr -> GingerT m (Value m)) -> Map Identifier (Value m)
forall (m :: * -> *).
Monad m =>
(Expr -> GingerT m (Value m)) -> Map Identifier (Value m)
builtinGlobals Expr -> GingerT m (Value m)
forall (m :: * -> *). Monad m => Expr -> GingerT m (Value m)
evalE
        )
      ]
    )
  ]
  Map Identifier (Value m)
-> Map Identifier (Value m) -> Map Identifier (Value m)
forall a. Semigroup a => a -> a -> a
<> (Expr -> GingerT m (Value m)) -> Map Identifier (Value m)
forall (m :: * -> *).
Monad m =>
(Expr -> GingerT m (Value m)) -> Map Identifier (Value m)
builtinGlobals Expr -> GingerT m (Value m)
forall (m :: * -> *). Monad m => Expr -> GingerT m (Value m)
evalE

defVarsCompat :: forall m. Monad m
              => Map Identifier (Value m)
defVarsCompat :: forall (m :: * -> *). Monad m => Map Identifier (Value m)
defVarsCompat = Map Identifier (Value m)
forall (m :: * -> *). Monad m => Map Identifier (Value m)
defVarsCommon

defVars :: forall m. Monad m
        => Map Identifier (Value m)
defVars :: forall (m :: * -> *). Monad m => Map Identifier (Value m)
defVars = Map Identifier (Value m)
forall (m :: * -> *). Monad m => Map Identifier (Value m)
defVarsCommon
        Map Identifier (Value m)
-> Map Identifier (Value m) -> Map Identifier (Value m)
forall a. Semigroup a => a -> a -> a
<> (Expr -> GingerT m (Value m)) -> Map Identifier (Value m)
forall (m :: * -> *).
Monad m =>
(Expr -> GingerT m (Value m)) -> Map Identifier (Value m)
builtinGlobalsNonJinja Expr -> GingerT m (Value m)
forall (m :: * -> *). Monad m => Expr -> GingerT m (Value m)
evalE
        Map Identifier (Value m)
-> Map Identifier (Value m) -> Map Identifier (Value m)
forall a. Semigroup a => a -> a -> a
<> [(Identifier, Value m)] -> Map Identifier (Value m)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
           [ ( Identifier
"__ginger__"
             , [(Scalar, Value m)] -> Value m
forall (m :: * -> *). [(Scalar, Value m)] -> Value m
dictV
               [ ( Scalar
"globals"
                 , 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
$ (Expr -> GingerT m (Value m)) -> Map Identifier (Value m)
forall (m :: * -> *).
Monad m =>
(Expr -> GingerT m (Value m)) -> Map Identifier (Value m)
builtinGlobalsNonJinja Expr -> GingerT m (Value m)
forall (m :: * -> *). Monad m => Expr -> GingerT m (Value m)
evalE
                 )
               ]
             )
           ]

builtinFilters :: forall m. Monad m
             => Map Identifier (Value m)
builtinFilters :: forall (m :: * -> *). Monad m => Map Identifier (Value m)
builtinFilters = [(Identifier, Value m)] -> Map Identifier (Value m)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
            [ (Identifier
"default", Filter m -> Value m
forall (m :: * -> *). Filter m -> Value m
FilterV (Filter m -> Value m) -> Filter m -> Value m
forall a b. (a -> b) -> a -> b
$ Filter m
forall (m :: * -> *). Monad m => Filter m
defaultFilter)
            , (Identifier
"d", Filter m -> Value m
forall (m :: * -> *). Filter m -> Value m
FilterV (Filter m -> Value m) -> Filter m -> Value m
forall a b. (a -> b) -> a -> b
$ Filter m
forall (m :: * -> *). Monad m => Filter m
defaultFilter)
            ]

builtinTests :: forall m. Monad m
             => Map Identifier (Value m)
builtinTests :: forall (m :: * -> *). Monad m => Map Identifier (Value m)
builtinTests = [(Identifier, Value m)] -> Map Identifier (Value m)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
            [ (Identifier
"defined", Test m -> Value m
forall (m :: * -> *). Test m -> Value m
TestV (Test m -> Value m) -> Test m -> Value m
forall a b. (a -> b) -> a -> b
$
                            Maybe ProcedureDoc -> TestFunc m -> Test m
forall (m :: * -> *). Maybe ProcedureDoc -> TestFunc m -> Test m
NativeTest
                              (ProcedureDoc -> Maybe ProcedureDoc
forall a. a -> Maybe a
Just ProcedureDoc
                                { procedureDocName :: Text
procedureDocName = Text
"defined"
                                , procedureDocArgs :: Vector ArgumentDoc
procedureDocArgs = [Text -> Maybe TypeDoc -> Maybe Text -> Text -> ArgumentDoc
ArgumentDoc Text
"value" (TypeDoc -> Maybe TypeDoc
forall a. a -> Maybe a
Just TypeDoc
TypeDocAny) Maybe Text
forall a. Maybe a
Nothing Text
""]
                                , 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
"bool"
                                , procedureDocDescription :: Text
procedureDocDescription =
                                    Text
"Test whether a variable is defined."
                                }
                              )
                              TestFunc m
forall (m :: * -> *). Monad m => TestFunc m
isDefined)
            , (Identifier
"undefined", Test m -> Value m
forall (m :: * -> *). Test m -> Value m
TestV (Test m -> Value m) -> Test m -> Value m
forall a b. (a -> b) -> a -> b
$
                              Maybe ProcedureDoc -> TestFunc m -> Test m
forall (m :: * -> *). Maybe ProcedureDoc -> TestFunc m -> Test m
NativeTest
                                (ProcedureDoc -> Maybe ProcedureDoc
forall a. a -> Maybe a
Just ProcedureDoc
                                  { procedureDocName :: Text
procedureDocName = Text
"defined"
                                  , procedureDocArgs :: Vector ArgumentDoc
procedureDocArgs = [Text -> Maybe TypeDoc -> Maybe Text -> Text -> ArgumentDoc
ArgumentDoc Text
"value" (TypeDoc -> Maybe TypeDoc
forall a. a -> Maybe a
Just TypeDoc
TypeDocAny) Maybe Text
forall a. Maybe a
Nothing Text
""]
                                  , 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
"bool"
                                  , procedureDocDescription :: Text
procedureDocDescription =
                                      Text
"Test whether a variable is undefined."
                                  }
                                )
                                TestFunc m
forall (m :: * -> *). Monad m => TestFunc m
isUndefined)
            , (Identifier
"boolean", ObjectID -> Maybe ProcedureDoc -> (Value m -> Value m) -> Value m
forall a (m :: * -> *).
FnToValue a m =>
ObjectID -> Maybe ProcedureDoc -> a -> Value m
fnToValue
                            ObjectID
"builtin:test:boolean"
                            (ProcedureDoc -> Maybe ProcedureDoc
forall a. a -> Maybe a
Just ProcedureDoc
                              { procedureDocName :: Text
procedureDocName = Text
"boolean"
                              , procedureDocArgs :: Vector ArgumentDoc
procedureDocArgs = [Text -> Maybe TypeDoc -> Maybe Text -> Text -> ArgumentDoc
ArgumentDoc Text
"value" (TypeDoc -> Maybe TypeDoc
forall a. a -> Maybe a
Just TypeDoc
TypeDocAny) Maybe Text
forall a. Maybe a
Nothing Text
""]
                              , 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
"bool"
                              , procedureDocDescription :: Text
procedureDocDescription =
                                  Text
"Test whether `value` is a boolean."
                              }
                            )
                            (forall (m :: * -> *). Monad m => Value m -> Value m
isBool @m))
            , (Identifier
"callable", ObjectID -> Maybe ProcedureDoc -> (Value m -> Value m) -> Value m
forall a (m :: * -> *).
FnToValue a m =>
ObjectID -> Maybe ProcedureDoc -> a -> Value m
fnToValue
                            ObjectID
"builtin:test:callable"
                            (ProcedureDoc -> Maybe ProcedureDoc
forall a. a -> Maybe a
Just ProcedureDoc
                              { procedureDocName :: Text
procedureDocName = Text
"callable"
                              , procedureDocArgs :: Vector ArgumentDoc
procedureDocArgs = [Text -> Maybe TypeDoc -> Maybe Text -> Text -> ArgumentDoc
ArgumentDoc Text
"value" (TypeDoc -> Maybe TypeDoc
forall a. a -> Maybe a
Just TypeDoc
TypeDocAny) Maybe Text
forall a. Maybe a
Nothing Text
""]
                              , 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
"bool"
                              , procedureDocDescription :: Text
procedureDocDescription =
                                  Text
"Test whether `value` is callable."
                              }
                            )
                            (forall (m :: * -> *). Monad m => Value m -> Value m
isCallable @m))
            , (Identifier
"filter", Test m -> Value m
forall (m :: * -> *). Test m -> Value m
TestV (Test m -> Value m) -> Test m -> Value m
forall a b. (a -> b) -> a -> b
$
                          Maybe ProcedureDoc -> TestFunc m -> Test m
forall (m :: * -> *). Maybe ProcedureDoc -> TestFunc m -> Test m
NativeTest
                          (ProcedureDoc -> Maybe ProcedureDoc
forall a. a -> Maybe a
Just ProcedureDoc
                              { procedureDocName :: Text
procedureDocName = Text
"filter"
                              , procedureDocArgs :: Vector ArgumentDoc
procedureDocArgs = [Text -> Maybe TypeDoc -> Maybe Text -> Text -> ArgumentDoc
ArgumentDoc Text
"value" (TypeDoc -> Maybe TypeDoc
forall a. a -> Maybe a
Just TypeDoc
TypeDocAny) Maybe Text
forall a. Maybe a
Nothing Text
""]
                              , 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
"bool"
                              , procedureDocDescription :: Text
procedureDocDescription =
                                  Text
"Test whether `value` is a filter."
                              }
                          )
                          TestFunc m
forall (m :: * -> *). Monad m => TestFunc m
isFilter)
            , (Identifier
"float", ObjectID -> Maybe ProcedureDoc -> (Value m -> Value m) -> Value m
forall a (m :: * -> *).
FnToValue a m =>
ObjectID -> Maybe ProcedureDoc -> a -> Value m
fnToValue
                            ObjectID
"builtin:test:float"
                            (ProcedureDoc -> Maybe ProcedureDoc
forall a. a -> Maybe a
Just ProcedureDoc
                              { procedureDocName :: Text
procedureDocName = Text
"float"
                              , procedureDocArgs :: Vector ArgumentDoc
procedureDocArgs = [Text -> Maybe TypeDoc -> Maybe Text -> Text -> ArgumentDoc
ArgumentDoc Text
"value" (TypeDoc -> Maybe TypeDoc
forall a. a -> Maybe a
Just TypeDoc
TypeDocAny) Maybe Text
forall a. Maybe a
Nothing Text
""]
                              , 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
"bool"
                              , procedureDocDescription :: Text
procedureDocDescription =
                                  Text
"Test whether `value` is a float."
                              }
                            )
                            (forall (m :: * -> *). Monad m => Value m -> Value m
isFloat @m))
            , (Identifier
"integer", ObjectID -> Maybe ProcedureDoc -> (Value m -> Value m) -> Value m
forall a (m :: * -> *).
FnToValue a m =>
ObjectID -> Maybe ProcedureDoc -> a -> Value m
fnToValue
                            ObjectID
"builtin:test:integer"
                            (ProcedureDoc -> Maybe ProcedureDoc
forall a. a -> Maybe a
Just ProcedureDoc
                              { procedureDocName :: Text
procedureDocName = Text
"integer"
                              , 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
"bool"
                              , procedureDocDescription :: Text
procedureDocDescription =
                                  Text
"Test whether `value` is an integer."
                              }
                            )
                            (forall (m :: * -> *). Monad m => Value m -> Value m
isInteger @m))
            , (Identifier
"iterable", ObjectID -> Maybe ProcedureDoc -> (Value m -> Value m) -> Value m
forall a (m :: * -> *).
FnToValue a m =>
ObjectID -> Maybe ProcedureDoc -> a -> Value m
fnToValue
                            ObjectID
"builtin:test:iterable"
                            (ProcedureDoc -> Maybe ProcedureDoc
forall a. a -> Maybe a
Just ProcedureDoc
                              { procedureDocName :: Text
procedureDocName = Text
"iterable"
                              , procedureDocArgs :: Vector ArgumentDoc
procedureDocArgs = [Text -> Maybe TypeDoc -> Maybe Text -> Text -> ArgumentDoc
ArgumentDoc Text
"value" (TypeDoc -> Maybe TypeDoc
forall a. a -> Maybe a
Just TypeDoc
TypeDocAny) Maybe Text
forall a. Maybe a
Nothing Text
""]
                              , 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
"bool"
                              , procedureDocDescription :: Text
procedureDocDescription =
                                  Text
"Test whether `value` is iterable.\n"
                                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Lists and list-like native objects are iterable."
                              }
                            )
                            (forall (m :: * -> *). Monad m => Value m -> Value m
isIterable @m))
            , (Identifier
"mapping", ObjectID -> Maybe ProcedureDoc -> (Value m -> Value m) -> Value m
forall a (m :: * -> *).
FnToValue a m =>
ObjectID -> Maybe ProcedureDoc -> a -> Value m
fnToValue
                            ObjectID
"builtin:test:mapping"
                            (ProcedureDoc -> Maybe ProcedureDoc
forall a. a -> Maybe a
Just ProcedureDoc
                              { procedureDocName :: Text
procedureDocName = Text
"mapping"
                              , procedureDocArgs :: Vector ArgumentDoc
procedureDocArgs = [Text -> Maybe TypeDoc -> Maybe Text -> Text -> ArgumentDoc
ArgumentDoc Text
"value" (TypeDoc -> Maybe TypeDoc
forall a. a -> Maybe a
Just TypeDoc
TypeDocAny) Maybe Text
forall a. Maybe a
Nothing Text
""]
                              , 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
"bool"
                              , procedureDocDescription :: Text
procedureDocDescription =
                                  Text
"Test whether `value` is a mapping.\n"
                                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Mappings are dicts and dict-like native objects."
                              }
                            )
                            (forall (m :: * -> *). Monad m => Value m -> Value m
isMapping @m))
            , (Identifier
"number", ObjectID -> Maybe ProcedureDoc -> (Value m -> Value m) -> Value m
forall a (m :: * -> *).
FnToValue a m =>
ObjectID -> Maybe ProcedureDoc -> a -> Value m
fnToValue
                            ObjectID
"builtin:test:number"
                            (ProcedureDoc -> Maybe ProcedureDoc
forall a. a -> Maybe a
Just ProcedureDoc
                              { procedureDocName :: Text
procedureDocName = Text
"number"
                              , procedureDocArgs :: Vector ArgumentDoc
procedureDocArgs = [Text -> Maybe TypeDoc -> Maybe Text -> Text -> ArgumentDoc
ArgumentDoc Text
"value" (TypeDoc -> Maybe TypeDoc
forall a. a -> Maybe a
Just TypeDoc
TypeDocAny) Maybe Text
forall a. Maybe a
Nothing Text
""]
                              , 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
"bool"
                              , procedureDocDescription :: Text
procedureDocDescription =
                                  Text
"Test whether `value` is a number (integer or float)."
                              }
                            )
                            (forall (m :: * -> *). Monad m => Value m -> Value m
isNumber @m))
            , (Identifier
"sequence", ObjectID -> Maybe ProcedureDoc -> (Value m -> Value m) -> Value m
forall a (m :: * -> *).
FnToValue a m =>
ObjectID -> Maybe ProcedureDoc -> a -> Value m
fnToValue
                            ObjectID
"builtin:test:sequence"
                            (ProcedureDoc -> Maybe ProcedureDoc
forall a. a -> Maybe a
Just ProcedureDoc
                              { procedureDocName :: Text
procedureDocName = Text
"sequence"
                              , procedureDocArgs :: Vector ArgumentDoc
procedureDocArgs = [Text -> Maybe TypeDoc -> Maybe Text -> Text -> ArgumentDoc
ArgumentDoc Text
"value" (TypeDoc -> Maybe TypeDoc
forall a. a -> Maybe a
Just TypeDoc
TypeDocAny) Maybe Text
forall a. Maybe a
Nothing Text
""]
                              , 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
"bool"
                              , procedureDocDescription :: Text
procedureDocDescription =
                                  Text
"Test whether `value` is a sequence (i.e., a list)."
                              }
                            )
                            (forall (m :: * -> *). Monad m => Value m -> Value m
isSequence @m))
            , (Identifier
"string", ObjectID -> Maybe ProcedureDoc -> (Value m -> Value m) -> Value m
forall a (m :: * -> *).
FnToValue a m =>
ObjectID -> Maybe ProcedureDoc -> a -> Value m
fnToValue
                            ObjectID
"builtin:test:string"
                            (ProcedureDoc -> Maybe ProcedureDoc
forall a. a -> Maybe a
Just ProcedureDoc
                              { procedureDocName :: Text
procedureDocName = Text
"string"
                              , procedureDocArgs :: Vector ArgumentDoc
procedureDocArgs = [Text -> Maybe TypeDoc -> Maybe Text -> Text -> ArgumentDoc
ArgumentDoc Text
"value" (TypeDoc -> Maybe TypeDoc
forall a. a -> Maybe a
Just TypeDoc
TypeDocAny) Maybe Text
forall a. Maybe a
Nothing Text
""]
                              , 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
"bool"
                              , procedureDocDescription :: Text
procedureDocDescription =
                                  Text
"Test whether `value` is a string."
                              }
                            )
                            (forall (m :: * -> *). Monad m => Value m -> Value m
isString @m))
            , (Identifier
"test", Test m -> Value m
forall (m :: * -> *). Test m -> Value m
TestV (Test m -> Value m) -> Test m -> Value m
forall a b. (a -> b) -> a -> b
$
                          Maybe ProcedureDoc -> TestFunc m -> Test m
forall (m :: * -> *). Maybe ProcedureDoc -> TestFunc m -> Test m
NativeTest
                          (ProcedureDoc -> Maybe ProcedureDoc
forall a. a -> Maybe a
Just ProcedureDoc
                              { procedureDocName :: Text
procedureDocName = Text
"test"
                              , procedureDocArgs :: Vector ArgumentDoc
procedureDocArgs = [Text -> Maybe TypeDoc -> Maybe Text -> Text -> ArgumentDoc
ArgumentDoc Text
"value" (TypeDoc -> Maybe TypeDoc
forall a. a -> Maybe a
Just TypeDoc
TypeDocAny) Maybe Text
forall a. Maybe a
Nothing Text
""]
                              , 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
"bool"
                              , procedureDocDescription :: Text
procedureDocDescription =
                                  Text
"Test whether `value` is a test."
                              }
                          )
                          TestFunc m
forall (m :: * -> *). Monad m => TestFunc m
isTest)
            , (Identifier
"upper", ObjectID -> Maybe ProcedureDoc -> (Value m -> Value m) -> Value m
forall a (m :: * -> *).
FnToValue a m =>
ObjectID -> Maybe ProcedureDoc -> a -> Value m
fnToValue
                            ObjectID
"builtin:test:upper"
                            (ProcedureDoc -> Maybe ProcedureDoc
forall a. a -> Maybe a
Just ProcedureDoc
                              { procedureDocName :: Text
procedureDocName = Text
"upper"
                              , procedureDocArgs :: Vector ArgumentDoc
procedureDocArgs = [Text -> Maybe TypeDoc -> Maybe Text -> Text -> ArgumentDoc
ArgumentDoc Text
"value" (TypeDoc -> Maybe TypeDoc
forall a. a -> Maybe a
Just TypeDoc
TypeDocAny) Maybe Text
forall a. Maybe a
Nothing Text
""]
                              , 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
"bool"
                              , procedureDocDescription :: Text
procedureDocDescription =
                                  Text
"Test whether `value` is an all-uppercase string."
                              }
                            )
                            (forall (m :: * -> *). Value m -> Value m
isUpperVal @m))
            , (Identifier
"eq", Test m -> Value m
forall (m :: * -> *). Test m -> Value m
TestV (Test m -> Value m) -> Test m -> Value m
forall a b. (a -> b) -> a -> b
$
                          Maybe ProcedureDoc -> TestFunc m -> Test m
forall (m :: * -> *). Maybe ProcedureDoc -> TestFunc m -> Test m
NativeTest
                          (ProcedureDoc -> Maybe ProcedureDoc
forall a. a -> Maybe a
Just ProcedureDoc
                              { procedureDocName :: Text
procedureDocName = Text
"eq"
                              , procedureDocArgs :: Vector ArgumentDoc
procedureDocArgs = [Text -> Maybe TypeDoc -> Maybe Text -> Text -> ArgumentDoc
ArgumentDoc Text
"value" (TypeDoc -> Maybe TypeDoc
forall a. a -> Maybe a
Just TypeDoc
TypeDocAny) Maybe Text
forall a. Maybe a
Nothing Text
""]
                              , 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
"bool"
                              , procedureDocDescription :: Text
procedureDocDescription =
                                  Text
"Test whether `value` is a eq."
                              }
                          )
                          TestFunc m
forall (m :: * -> *). Monad m => TestFunc m
isEqual)
            , (Identifier
"escaped", forall (m :: * -> *). Monad m => Text -> Value m
builtinNotImplemented @m Text
"escaped")
            , (Identifier
"false", ObjectID -> Maybe ProcedureDoc -> (Value m -> Value m) -> Value m
forall a (m :: * -> *).
FnToValue a m =>
ObjectID -> Maybe ProcedureDoc -> a -> Value m
fnToValue
                            ObjectID
"builtin:test:false"
                            (ProcedureDoc -> Maybe ProcedureDoc
forall a. a -> Maybe a
Just ProcedureDoc
                              { procedureDocName :: Text
procedureDocName = Text
"false"
                              , procedureDocArgs :: Vector ArgumentDoc
procedureDocArgs = [Text -> Maybe TypeDoc -> Maybe Text -> Text -> ArgumentDoc
ArgumentDoc Text
"value" (TypeDoc -> Maybe TypeDoc
forall a. a -> Maybe a
Just TypeDoc
TypeDocAny) Maybe Text
forall a. Maybe a
Nothing Text
""]
                              , 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
"bool"
                              , procedureDocDescription :: Text
procedureDocDescription =
                                  Text
"Test whether `value` is boolean `false`"
                              }
                            )
                            (Bool -> Value m -> Value m
forall (m :: * -> *). Bool -> Value m -> Value m
isBoolean Bool
False :: Value m -> Value m))
            , (Identifier
"ge", BinaryOperator -> Value m
forall (m :: * -> *). Monad m => BinaryOperator -> Value m
gingerBinopTest BinaryOperator
BinopGTE)
            , (Identifier
"gt", BinaryOperator -> Value m
forall (m :: * -> *). Monad m => BinaryOperator -> Value m
gingerBinopTest BinaryOperator
BinopGT)
            , (Identifier
"in", BinaryOperator -> Value m
forall (m :: * -> *). Monad m => BinaryOperator -> Value m
gingerBinopTest BinaryOperator
BinopIn)
            , (Identifier
"le", BinaryOperator -> Value m
forall (m :: * -> *). Monad m => BinaryOperator -> Value m
gingerBinopTest BinaryOperator
BinopLTE)
            , (Identifier
"lower", ObjectID -> Maybe ProcedureDoc -> (Value m -> Value m) -> Value m
forall a (m :: * -> *).
FnToValue a m =>
ObjectID -> Maybe ProcedureDoc -> a -> Value m
fnToValue
                            ObjectID
"builtin:test:lower"
                            (ProcedureDoc -> Maybe ProcedureDoc
forall a. a -> Maybe a
Just ProcedureDoc
                              { procedureDocName :: Text
procedureDocName = Text
"lower"
                              , procedureDocArgs :: Vector ArgumentDoc
procedureDocArgs = [Text -> Maybe TypeDoc -> Maybe Text -> Text -> ArgumentDoc
ArgumentDoc Text
"value" (TypeDoc -> Maybe TypeDoc
forall a. a -> Maybe a
Just TypeDoc
TypeDocAny) Maybe Text
forall a. Maybe a
Nothing Text
""]
                              , 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
"bool"
                              , procedureDocDescription :: Text
procedureDocDescription =
                                  Text
"Test whether `value` is an all-lowercase string"
                              }
                            )
                            (forall (m :: * -> *). Value m -> Value m
isLowerVal @m))
            , (Identifier
"lt", BinaryOperator -> Value m
forall (m :: * -> *). Monad m => BinaryOperator -> Value m
gingerBinopTest BinaryOperator
BinopLT)
            , (Identifier
"sameas", forall (m :: * -> *). Monad m => Text -> Value m
builtinNotImplemented @m Text
"sameas")
            , (Identifier
"true", ObjectID -> Maybe ProcedureDoc -> (Value m -> Value m) -> Value m
forall a (m :: * -> *).
FnToValue a m =>
ObjectID -> Maybe ProcedureDoc -> a -> Value m
fnToValue
                            ObjectID
"builtin:test:true"
                            (ProcedureDoc -> Maybe ProcedureDoc
forall a. a -> Maybe a
Just ProcedureDoc
                              { procedureDocName :: Text
procedureDocName = Text
"true"
                              , procedureDocArgs :: Vector ArgumentDoc
procedureDocArgs = [Text -> Maybe TypeDoc -> Maybe Text -> Text -> ArgumentDoc
ArgumentDoc Text
"value" (TypeDoc -> Maybe TypeDoc
forall a. a -> Maybe a
Just TypeDoc
TypeDocAny) Maybe Text
forall a. Maybe a
Nothing Text
""]
                              , 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
"bool"
                              , procedureDocDescription :: Text
procedureDocDescription =
                                  Text
"Test whether `value` is boolean `true`"
                              }
                            )
                            (Bool -> Value m -> Value m
forall (m :: * -> *). Bool -> Value m -> Value m
isBoolean Bool
True :: Value m -> Value m))
            , (Identifier
"none", ObjectID -> Maybe ProcedureDoc -> (Value m -> Value m) -> Value m
forall a (m :: * -> *).
FnToValue a m =>
ObjectID -> Maybe ProcedureDoc -> a -> Value m
fnToValue
                            ObjectID
"builtin:test:none"
                            (ProcedureDoc -> Maybe ProcedureDoc
forall a. a -> Maybe a
Just ProcedureDoc
                              { procedureDocName :: Text
procedureDocName = Text
"none"
                              , procedureDocArgs :: Vector ArgumentDoc
procedureDocArgs = [Text -> Maybe TypeDoc -> Maybe Text -> Text -> ArgumentDoc
ArgumentDoc Text
"value" (TypeDoc -> Maybe TypeDoc
forall a. a -> Maybe a
Just TypeDoc
TypeDocAny) Maybe Text
forall a. Maybe a
Nothing Text
""]
                              , 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
"bool"
                              , procedureDocDescription :: Text
procedureDocDescription =
                                  Text
"Test whether `value` is the `none` value"
                              }
                            )
                            (Value m -> Value m
forall (m :: * -> *). Value m -> Value m
isNone :: Value m -> Value m))
            ]

isCallable' :: Monad m => Value m -> Bool
isCallable' :: forall (m :: * -> *). Monad m => Value m -> Bool
isCallable' (ProcedureV {}) = Bool
True
isCallable' (NativeV NativeObject m
n) =
  Maybe
  (NativeObject m
   -> [(Maybe Identifier, Value m)]
   -> m (Either RuntimeError (Value m)))
-> Bool
forall a. Maybe a -> Bool
isJust (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
n)
isCallable' (DictV Map Scalar (Value m)
d) =
  Bool -> (Value m -> Bool) -> Maybe (Value m) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Bool
False) Value m -> Bool
forall (m :: * -> *). Monad m => Value m -> Bool
isCallable' (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)
d)
isCallable' Value m
_ = Bool
False

isCallable :: Monad m => Value m -> Value m
isCallable :: forall (m :: * -> *). Monad m => Value m -> Value m
isCallable = Bool -> Value m
forall (m :: * -> *). Bool -> Value m
BoolV (Bool -> Value m) -> (Value m -> Bool) -> Value m -> Value m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value m -> Bool
forall (m :: * -> *). Monad m => Value m -> Bool
isCallable'

isFilter :: Monad m => TestFunc m
isFilter :: forall (m :: * -> *). Monad m => TestFunc m
isFilter Expr
expr [(Maybe Identifier, Value m)]
_ Context m
ctx Env m
env SomePRNG
rng = do
  let (SomePRNG
rngL, SomePRNG
rngR) = SomePRNG -> (SomePRNG, SomePRNG)
forall g. SplitGen g => g -> (g, g)
R.splitGen SomePRNG
rng
  Either RuntimeError (Value m)
result <- 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 (Expr -> GingerT m (Value m)
forall (m :: * -> *). Monad m => Expr -> GingerT m (Value m)
evalE Expr
expr) Context m
ctx Env m
env SomePRNG
rngL
  case Either RuntimeError (Value m)
result of
    Right (StringV Text
name) -> do
      let exists :: Bool
exists =
            Maybe (Value m) -> Bool
forall a. Maybe a -> Bool
isJust (Identifier -> Map Identifier (Value m) -> Maybe (Value m)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Text -> Identifier
Identifier Text
name) (Env m -> Map Identifier (Value m)
forall (m :: * -> *). Env m -> Map Identifier (Value m)
envVars Env m
env)) Bool -> Bool -> Bool
||
            Maybe (Value m) -> Bool
forall a. Maybe a -> Bool
isJust (Identifier -> Map Identifier (Value m) -> Maybe (Value m)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Text -> Identifier
Identifier Text
name) (Context m -> Map Identifier (Value m)
forall (m :: * -> *). Context m -> Map Identifier (Value m)
contextVars Context m
ctx))
      Either RuntimeError Bool
existsExt <-
        GingerT m Bool
-> Context m -> Env m -> SomePRNG -> m (Either RuntimeError Bool)
forall (m :: * -> *) g a.
(Monad m, SplitGen g) =>
GingerT m a -> Context m -> Env m -> g -> m (Either RuntimeError a)
runGingerT
          (Text -> Value m -> GingerT m Bool
forall (m :: * -> *). Monad m => Text -> Value m -> GingerT m Bool
asBool Text
""
              (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 :: * -> *) a. Eval m a => a -> GingerT m (Value m)
eval
                  (Expr -> Expr -> Expr
InE (Text -> Expr
StringLitE Text
name) (Expr -> Identifier -> Expr
DotE (Identifier -> Expr
VarE Identifier
"__jinja__") Identifier
"filters")))
          Context m
ctx Env m
env SomePRNG
rngR
      Either RuntimeError Bool -> m (Either RuntimeError Bool)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError Bool -> m (Either RuntimeError Bool))
-> Either RuntimeError Bool -> m (Either RuntimeError Bool)
forall a b. (a -> b) -> a -> b
$ (Bool
exists Bool -> Bool -> Bool
||) (Bool -> Bool)
-> Either RuntimeError Bool -> Either RuntimeError Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either RuntimeError Bool
existsExt
    Right Value m
a ->
      Either RuntimeError Bool -> m (Either RuntimeError Bool)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError Bool -> m (Either RuntimeError Bool))
-> (RuntimeError -> Either RuntimeError Bool)
-> RuntimeError
-> m (Either RuntimeError Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuntimeError -> Either RuntimeError Bool
forall a b. a -> Either a b
Left (RuntimeError -> m (Either RuntimeError Bool))
-> RuntimeError -> m (Either RuntimeError Bool)
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> RuntimeError
TagError Text
"filter name" Text
"string" (Value m -> Text
forall (m :: * -> *). Value m -> Text
tagNameOf Value m
a)
    Left RuntimeError
err ->
      Either RuntimeError Bool -> m (Either RuntimeError Bool)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError Bool -> m (Either RuntimeError Bool))
-> Either RuntimeError Bool -> m (Either RuntimeError Bool)
forall a b. (a -> b) -> a -> b
$ RuntimeError -> Either RuntimeError Bool
forall a b. a -> Either a b
Left RuntimeError
err

isMapping :: Monad m => Value m -> Value m
isMapping :: forall (m :: * -> *). Monad m => Value m -> Value m
isMapping (NativeV {}) = Value m
forall (m :: * -> *). Value m
TrueV
isMapping (DictV {}) = Value m
forall (m :: * -> *). Value m
TrueV
isMapping Value m
_ = Value m
forall (m :: * -> *). Value m
FalseV

isIterable :: Monad m => Value m -> Value m
isIterable :: forall (m :: * -> *). Monad m => Value m -> Value m
isIterable (NativeV {}) = Value m
forall (m :: * -> *). Value m
TrueV
isIterable (DictV {}) = Value m
forall (m :: * -> *). Value m
TrueV
isIterable (ListV {}) = Value m
forall (m :: * -> *). Value m
TrueV
isIterable Value m
_ = Value m
forall (m :: * -> *). Value m
FalseV

isSequence :: Monad m => Value m -> Value m
isSequence :: forall (m :: * -> *). Monad m => Value m -> Value m
isSequence (NativeV {}) = Value m
forall (m :: * -> *). Value m
TrueV
isSequence (ListV {}) = Value m
forall (m :: * -> *). Value m
TrueV
isSequence Value m
_ = Value m
forall (m :: * -> *). Value m
FalseV

isTest :: Monad m => TestFunc m
isTest :: forall (m :: * -> *). Monad m => TestFunc m
isTest Expr
expr [(Maybe Identifier, Value m)]
_ Context m
ctx Env m
env SomePRNG
rng = do
  Either RuntimeError (Value m)
result <- 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 (Expr -> GingerT m (Value m)
forall (m :: * -> *). Monad m => Expr -> GingerT m (Value m)
evalE Expr
expr) Context m
ctx Env m
env SomePRNG
rng
  case Either RuntimeError (Value m)
result of
    Right Value m
NoneV -> Either RuntimeError Bool -> m (Either RuntimeError Bool)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError Bool -> m (Either RuntimeError Bool))
-> (Bool -> Either RuntimeError Bool)
-> Bool
-> m (Either RuntimeError Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Either RuntimeError Bool
forall a b. b -> Either a b
Right (Bool -> m (Either RuntimeError Bool))
-> Bool -> m (Either RuntimeError Bool)
forall a b. (a -> b) -> a -> b
$ Bool
True
    Right BoolV {} -> Either RuntimeError Bool -> m (Either RuntimeError Bool)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError Bool -> m (Either RuntimeError Bool))
-> (Bool -> Either RuntimeError Bool)
-> Bool
-> m (Either RuntimeError Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Either RuntimeError Bool
forall a b. b -> Either a b
Right (Bool -> m (Either RuntimeError Bool))
-> Bool -> m (Either RuntimeError Bool)
forall a b. (a -> b) -> a -> b
$ Bool
True
    Right (StringV Text
name) -> do
      let testsVars :: Map Scalar (Value m)
testsVars = case Identifier -> Map Identifier (Value m) -> Maybe (Value m)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Identifier
"__jinja__" (Context m -> Map Identifier (Value m)
forall (m :: * -> *). Context m -> Map Identifier (Value m)
contextVars Context m
ctx) of
            Just (DictV Map Scalar (Value m)
xs) ->
              case Scalar -> Map Scalar (Value m) -> Maybe (Value m)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Scalar
"tests" Map Scalar (Value m)
xs of
                Just (DictV Map Scalar (Value m)
ts) -> Map Scalar (Value m)
ts
                Maybe (Value m)
_ -> Map Scalar (Value m)
forall a. Monoid a => a
mempty
            Maybe (Value m)
_ -> Map Scalar (Value m)
forall a. Monoid a => a
mempty
      let vars :: Map Scalar (Value m)
vars =
            (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 (Text -> Scalar
forall a. ToScalar a => a -> Scalar
toScalar (Text -> Scalar) -> (Identifier -> Text) -> Identifier -> Scalar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Text
identifierName) (Context m -> Map Identifier (Value m)
forall (m :: * -> *). Context m -> Map Identifier (Value m)
contextVars Context m
ctx) Map Scalar (Value m)
-> Map Scalar (Value m) -> Map Scalar (Value m)
forall a. Semigroup a => a -> a -> a
<>
            (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 (Text -> Scalar
forall a. ToScalar a => a -> Scalar
toScalar (Text -> Scalar) -> (Identifier -> Text) -> Identifier -> Scalar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Text
identifierName) (Env m -> Map Identifier (Value m)
forall (m :: * -> *). Env m -> Map Identifier (Value m)
envVars Env m
env) Map Scalar (Value m)
-> Map Scalar (Value m) -> Map Scalar (Value m)
forall a. Semigroup a => a -> a -> a
<>
            Map Scalar (Value m)
testsVars
      let existing :: Maybe (Value m)
existing = Scalar -> Map Scalar (Value m) -> Maybe (Value m)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Text -> Scalar
forall a. ToScalar a => a -> Scalar
toScalar Text
name) Map Scalar (Value m)
vars
      case Maybe (Value m)
existing of
        Just Value m
a -> Either RuntimeError Bool -> m (Either RuntimeError Bool)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError Bool -> m (Either RuntimeError Bool))
-> (Bool -> Either RuntimeError Bool)
-> Bool
-> m (Either RuntimeError Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Either RuntimeError Bool
forall a b. b -> Either a b
Right (Bool -> m (Either RuntimeError Bool))
-> Bool -> m (Either RuntimeError Bool)
forall a b. (a -> b) -> a -> b
$ Value m -> Bool
forall (m :: * -> *). Monad m => Value m -> Bool
isCallable' Value m
a
        Maybe (Value m)
_ -> Either RuntimeError Bool -> m (Either RuntimeError Bool)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError Bool -> m (Either RuntimeError Bool))
-> (Bool -> Either RuntimeError Bool)
-> Bool
-> m (Either RuntimeError Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Either RuntimeError Bool
forall a b. b -> Either a b
Right (Bool -> m (Either RuntimeError Bool))
-> Bool -> m (Either RuntimeError Bool)
forall a b. (a -> b) -> a -> b
$ Bool
False

    Right Value m
a ->
      Either RuntimeError Bool -> m (Either RuntimeError Bool)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError Bool -> m (Either RuntimeError Bool))
-> (RuntimeError -> Either RuntimeError Bool)
-> RuntimeError
-> m (Either RuntimeError Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuntimeError -> Either RuntimeError Bool
forall a b. a -> Either a b
Left (RuntimeError -> m (Either RuntimeError Bool))
-> RuntimeError -> m (Either RuntimeError Bool)
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> RuntimeError
TagError Text
"test name" Text
"string" (Value m -> Text
forall (m :: * -> *). Value m -> Text
tagNameOf Value m
a)
    Left RuntimeError
err ->
      Either RuntimeError Bool -> m (Either RuntimeError Bool)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError Bool -> m (Either RuntimeError Bool))
-> Either RuntimeError Bool -> m (Either RuntimeError Bool)
forall a b. (a -> b) -> a -> b
$ RuntimeError -> Either RuntimeError Bool
forall a b. a -> Either a b
Left RuntimeError
err

isEscaped :: Monad m => Value m -> Value m
isEscaped :: forall (m :: * -> *). Monad m => Value m -> Value m
isEscaped (EncodedV {}) = Value m
forall (m :: * -> *). Value m
TrueV
isEscaped Value m
_ = Value m
forall (m :: * -> *). Value m
FalseV

isBool :: Monad m => Value m -> Value m
isBool :: forall (m :: * -> *). Monad m => Value m -> Value m
isBool (BoolV {}) = Value m
forall (m :: * -> *). Value m
TrueV
isBool Value m
_ = Value m
forall (m :: * -> *). Value m
FalseV

isInteger :: Monad m => Value m -> Value m
isInteger :: forall (m :: * -> *). Monad m => Value m -> Value m
isInteger (IntV {}) = Value m
forall (m :: * -> *). Value m
TrueV
isInteger Value m
_ = Value m
forall (m :: * -> *). Value m
FalseV

isFloat :: Monad m => Value m -> Value m
isFloat :: forall (m :: * -> *). Monad m => Value m -> Value m
isFloat (FloatV {}) = Value m
forall (m :: * -> *). Value m
TrueV
isFloat Value m
_ = Value m
forall (m :: * -> *). Value m
FalseV

isNumber :: Monad m => Value m -> Value m
isNumber :: forall (m :: * -> *). Monad m => Value m -> Value m
isNumber (IntV {}) = Value m
forall (m :: * -> *). Value m
TrueV
isNumber (FloatV {}) = Value m
forall (m :: * -> *). Value m
TrueV
isNumber Value m
_ = Value m
forall (m :: * -> *). Value m
FalseV

isString :: Monad m => Value m -> Value m
isString :: forall (m :: * -> *). Monad m => Value m -> Value m
isString (StringV {}) = Value m
forall (m :: * -> *). Value m
TrueV
isString Value m
_ = Value m
forall (m :: * -> *). Value m
FalseV

defaultFilter :: Monad m => Filter m
defaultFilter :: forall (m :: * -> *). Monad m => Filter m
defaultFilter =
  Maybe ProcedureDoc -> FilterFunc m -> Filter m
forall (m :: * -> *).
Maybe ProcedureDoc -> FilterFunc m -> Filter m
NativeFilter
    (ProcedureDoc -> Maybe ProcedureDoc
forall a. a -> Maybe a
Just (ProcedureDoc -> Maybe ProcedureDoc)
-> ProcedureDoc -> Maybe ProcedureDoc
forall a b. (a -> b) -> a -> b
$ ProcedureDoc
      { procedureDocName :: Text
procedureDocName = Text
"default"
      , procedureDocArgs :: Vector ArgumentDoc
procedureDocArgs =
          [ Text -> Maybe TypeDoc -> Maybe Text -> Text -> ArgumentDoc
ArgumentDoc Text
"value" (TypeDoc -> Maybe TypeDoc
forall a. a -> Maybe a
Just TypeDoc
TypeDocAny) Maybe Text
forall a. Maybe a
Nothing Text
""
          , Text -> Maybe TypeDoc -> Maybe Text -> Text -> ArgumentDoc
ArgumentDoc Text
"default" (TypeDoc -> Maybe TypeDoc
forall a. a -> Maybe a
Just TypeDoc
TypeDocAny) Maybe Text
forall a. Maybe a
Nothing Text
""
          ]
      , 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
$ TypeDoc
TypeDocAny
      , procedureDocDescription :: Text
procedureDocDescription =
          Text
"Return `default` if `value` is `false`, `none`, or undefined, " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
          Text
"`value` otherwise."
      }
    ) (FilterFunc m -> Filter m) -> FilterFunc m -> Filter m
forall a b. (a -> b) -> a -> b
$
    \Expr
expr [(Maybe Identifier, Value m)]
args Context m
ctx Env m
env SomePRNG
rng -> do
      Either RuntimeError (Value m)
calleeEither <- 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 (Expr -> GingerT m (Value m)
forall (m :: * -> *). Monad m => Expr -> GingerT m (Value m)
evalE Expr
expr) Context m
ctx Env m
env SomePRNG
rng
      let resolvedArgsEither :: Either RuntimeError (Map Identifier (Value m))
resolvedArgsEither = Text
-> [(Identifier, Maybe (Value m))]
-> [(Maybe Identifier, Value m)]
-> Either RuntimeError (Map Identifier (Value m))
forall (m :: * -> *).
Text
-> [(Identifier, Maybe (Value m))]
-> [(Maybe Identifier, Value m)]
-> Either RuntimeError (Map Identifier (Value m))
resolveArgs
                                Text
"default"
                                [(Identifier
"default_value", Value m -> Maybe (Value m)
forall a. a -> Maybe a
Just (Text -> Value m
forall (m :: * -> *). Text -> Value m
StringV Text
"")), (Identifier
"boolean", Value m -> Maybe (Value m)
forall a. a -> Maybe a
Just Value m
forall (m :: * -> *). Value m
FalseV)]
                                [(Maybe Identifier, Value m)]
args
      case (Either RuntimeError (Value m)
calleeEither, Either RuntimeError (Map Identifier (Value m))
resolvedArgsEither) of
        (Either RuntimeError (Value m)
_, Left RuntimeError
err) ->
          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)))
-> Either RuntimeError (Value m)
-> m (Either RuntimeError (Value m))
forall a b. (a -> b) -> a -> b
$ RuntimeError -> Either RuntimeError (Value m)
forall a b. a -> Either a b
Left RuntimeError
err
        (Right Value m
val, Right Map Identifier (Value m)
rargs) ->
          let defval :: Value m
defval = Maybe (Value m) -> Value m
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Value m) -> Value m) -> Maybe (Value m) -> Value m
forall a b. (a -> b) -> a -> b
$ Identifier -> Map Identifier (Value m) -> Maybe (Value m)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Identifier
"default_value" Map Identifier (Value m)
rargs
              boolean :: Value m
boolean = Maybe (Value m) -> Value m
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Value m) -> Value m) -> Maybe (Value m) -> Value m
forall a b. (a -> b) -> a -> b
$ Identifier -> Map Identifier (Value m) -> Maybe (Value m)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Identifier
"boolean" Map Identifier (Value m)
rargs
          in case Value m
val of
            Value m
NoneV -> 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
defval
            Value m
FalseV -> 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
$ if Value m
boolean Value m -> Value m -> Bool
forall a. Eq a => a -> a -> Bool
== Value m
forall (m :: * -> *). Value m
TrueV then Value m
defval else Value m
forall (m :: * -> *). Value m
FalseV
            Value m
a -> 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
a
        (Left NotInScopeError {}, Right Map Identifier (Value m)
rargs) ->
          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. HasCallStack => Maybe a -> a
fromJust (Maybe (Value m) -> m (Either RuntimeError (Value m)))
-> Maybe (Value m) -> m (Either RuntimeError (Value m))
forall a b. (a -> b) -> a -> b
$ Identifier -> Map Identifier (Value m) -> Maybe (Value m)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Identifier
"default_value" Map Identifier (Value m)
rargs
        (Left RuntimeError
err, Either RuntimeError (Map 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
$ RuntimeError
err

isDefined :: forall m. Monad m => TestFunc m
isDefined :: forall (m :: * -> *). Monad m => TestFunc m
isDefined Expr
_ ((Maybe Identifier, Value m)
_:[(Maybe Identifier, Value m)]
_) Context m
_ Env m
_ SomePRNG
_ = Either RuntimeError Bool -> m (Either RuntimeError Bool)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError Bool -> m (Either RuntimeError Bool))
-> Either RuntimeError Bool -> m (Either RuntimeError Bool)
forall a b. (a -> b) -> a -> b
$ RuntimeError -> Either RuntimeError Bool
forall a b. a -> Either a b
Left (RuntimeError -> Either RuntimeError Bool)
-> RuntimeError -> Either RuntimeError Bool
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Text -> RuntimeError
ArgumentError Text
"defined" Text
"0" Text
"end of arguments" Text
"argument"
isDefined Expr
value [] Context m
ctx Env m
env SomePRNG
rng = Expr -> m (Either RuntimeError Bool)
go Expr
value
  where
    go :: Expr -> m (Either RuntimeError Bool)
    go :: Expr -> m (Either RuntimeError Bool)
go (PositionedE SourcePosition
_ Expr
e) =
      Expr -> m (Either RuntimeError Bool)
go Expr
e
    go (VarE Identifier
name) =
      Either RuntimeError Bool -> m (Either RuntimeError Bool)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError Bool -> m (Either RuntimeError Bool))
-> (Bool -> Either RuntimeError Bool)
-> Bool
-> m (Either RuntimeError Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Either RuntimeError Bool
forall a b. b -> Either a b
Right (Bool -> m (Either RuntimeError Bool))
-> Bool -> m (Either RuntimeError Bool)
forall a b. (a -> b) -> a -> b
$
        Identifier
name Identifier -> Map Identifier (Value m) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` (Env m -> Map Identifier (Value m)
forall (m :: * -> *). Env m -> Map Identifier (Value m)
envVars Env m
env) Bool -> Bool -> Bool
||
        Identifier
name Identifier -> Map Identifier (Value m) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` (Context m -> Map Identifier (Value m)
forall (m :: * -> *). Context m -> Map Identifier (Value m)
contextVars Context m
ctx)
    go Expr
NoneE = Either RuntimeError Bool -> m (Either RuntimeError Bool)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError Bool -> m (Either RuntimeError Bool))
-> (Bool -> Either RuntimeError Bool)
-> Bool
-> m (Either RuntimeError Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Either RuntimeError Bool
forall a b. b -> Either a b
Right (Bool -> m (Either RuntimeError Bool))
-> Bool -> m (Either RuntimeError Bool)
forall a b. (a -> b) -> a -> b
$ Bool
True
    go BoolE {} = Either RuntimeError Bool -> m (Either RuntimeError Bool)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError Bool -> m (Either RuntimeError Bool))
-> (Bool -> Either RuntimeError Bool)
-> Bool
-> m (Either RuntimeError Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Either RuntimeError Bool
forall a b. b -> Either a b
Right (Bool -> m (Either RuntimeError Bool))
-> Bool -> m (Either RuntimeError Bool)
forall a b. (a -> b) -> a -> b
$ Bool
True
    go StringLitE {} = Either RuntimeError Bool -> m (Either RuntimeError Bool)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError Bool -> m (Either RuntimeError Bool))
-> (Bool -> Either RuntimeError Bool)
-> Bool
-> m (Either RuntimeError Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Either RuntimeError Bool
forall a b. b -> Either a b
Right (Bool -> m (Either RuntimeError Bool))
-> Bool -> m (Either RuntimeError Bool)
forall a b. (a -> b) -> a -> b
$ Bool
True
    go IntLitE {} = Either RuntimeError Bool -> m (Either RuntimeError Bool)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError Bool -> m (Either RuntimeError Bool))
-> (Bool -> Either RuntimeError Bool)
-> Bool
-> m (Either RuntimeError Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Either RuntimeError Bool
forall a b. b -> Either a b
Right (Bool -> m (Either RuntimeError Bool))
-> Bool -> m (Either RuntimeError Bool)
forall a b. (a -> b) -> a -> b
$ Bool
True
    go FloatLitE {} = Either RuntimeError Bool -> m (Either RuntimeError Bool)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError Bool -> m (Either RuntimeError Bool))
-> (Bool -> Either RuntimeError Bool)
-> Bool
-> m (Either RuntimeError Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Either RuntimeError Bool
forall a b. b -> Either a b
Right (Bool -> m (Either RuntimeError Bool))
-> Bool -> m (Either RuntimeError Bool)
forall a b. (a -> b) -> a -> b
$ Bool
True
    go (SliceE Expr
slicee Maybe Expr
startMay Maybe Expr
endMay) = do
      Either RuntimeError Bool
definedSlicee <- Expr -> m (Either RuntimeError Bool)
go Expr
slicee
      Either RuntimeError Bool
definedStart <- m (Either RuntimeError Bool)
-> (Expr -> m (Either RuntimeError Bool))
-> Maybe Expr
-> m (Either RuntimeError Bool)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Either RuntimeError Bool -> m (Either RuntimeError Bool)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError Bool -> m (Either RuntimeError Bool))
-> (Bool -> Either RuntimeError Bool)
-> Bool
-> m (Either RuntimeError Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Either RuntimeError Bool
forall a b. b -> Either a b
Right (Bool -> m (Either RuntimeError Bool))
-> Bool -> m (Either RuntimeError Bool)
forall a b. (a -> b) -> a -> b
$ Bool
True) (\Expr
start -> Expr -> m (Either RuntimeError Bool)
go Expr
start) Maybe Expr
startMay
      Either RuntimeError Bool
definedEnd <- m (Either RuntimeError Bool)
-> (Expr -> m (Either RuntimeError Bool))
-> Maybe Expr
-> m (Either RuntimeError Bool)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Either RuntimeError Bool -> m (Either RuntimeError Bool)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError Bool -> m (Either RuntimeError Bool))
-> (Bool -> Either RuntimeError Bool)
-> Bool
-> m (Either RuntimeError Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Either RuntimeError Bool
forall a b. b -> Either a b
Right (Bool -> m (Either RuntimeError Bool))
-> Bool -> m (Either RuntimeError Bool)
forall a b. (a -> b) -> a -> b
$ Bool
True) (\Expr
end -> Expr -> m (Either RuntimeError Bool)
go Expr
end) Maybe Expr
endMay
      Either RuntimeError Bool -> m (Either RuntimeError Bool)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError Bool -> m (Either RuntimeError Bool))
-> Either RuntimeError Bool -> m (Either RuntimeError Bool)
forall a b. (a -> b) -> a -> b
$ [Either RuntimeError Bool] -> Either RuntimeError Bool
forall a. [Either a Bool] -> Either a Bool
allEitherBool [ Either RuntimeError Bool
Item [Either RuntimeError Bool]
definedSlicee, Either RuntimeError Bool
Item [Either RuntimeError Bool]
definedStart, Either RuntimeError Bool
Item [Either RuntimeError Bool]
definedEnd ]
    go (IndexE Expr
parent Expr
selector) = do
      Either RuntimeError Bool
definedParent <- Expr -> m (Either RuntimeError Bool)
go Expr
parent
      case Either RuntimeError Bool
definedParent of
        Right Bool
True -> do
          Either RuntimeError (Value m)
result <- 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 (Expr -> GingerT m (Value m)
forall (m :: * -> *). Monad m => Expr -> GingerT m (Value m)
evalE (Expr -> Expr -> Expr
InE Expr
selector Expr
parent)) Context m
ctx Env m
env SomePRNG
rng
          case Either RuntimeError (Value m)
result of
            Left (NotInScopeError {}) -> Either RuntimeError Bool -> m (Either RuntimeError Bool)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError Bool -> m (Either RuntimeError Bool))
-> (Bool -> Either RuntimeError Bool)
-> Bool
-> m (Either RuntimeError Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Either RuntimeError Bool
forall a b. b -> Either a b
Right (Bool -> m (Either RuntimeError Bool))
-> Bool -> m (Either RuntimeError Bool)
forall a b. (a -> b) -> a -> b
$ Bool
False
            Left RuntimeError
err -> Either RuntimeError Bool -> m (Either RuntimeError Bool)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError Bool -> m (Either RuntimeError Bool))
-> (RuntimeError -> Either RuntimeError Bool)
-> RuntimeError
-> m (Either RuntimeError Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuntimeError -> Either RuntimeError Bool
forall a b. a -> Either a b
Left (RuntimeError -> m (Either RuntimeError Bool))
-> RuntimeError -> m (Either RuntimeError Bool)
forall a b. (a -> b) -> a -> b
$ RuntimeError
err
            Right (BoolV Bool
b) -> Either RuntimeError Bool -> m (Either RuntimeError Bool)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError Bool -> m (Either RuntimeError Bool))
-> (Bool -> Either RuntimeError Bool)
-> Bool
-> m (Either RuntimeError Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Either RuntimeError Bool
forall a b. b -> Either a b
Right (Bool -> m (Either RuntimeError Bool))
-> Bool -> m (Either RuntimeError Bool)
forall a b. (a -> b) -> a -> b
$ Bool
b
            Right Value m
_ -> Either RuntimeError Bool -> m (Either RuntimeError Bool)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError Bool -> m (Either RuntimeError Bool))
-> (RuntimeError -> Either RuntimeError Bool)
-> RuntimeError
-> m (Either RuntimeError Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuntimeError -> Either RuntimeError Bool
forall a b. a -> Either a b
Left (RuntimeError -> m (Either RuntimeError Bool))
-> RuntimeError -> m (Either RuntimeError Bool)
forall a b. (a -> b) -> a -> b
$ Text -> RuntimeError
FatalError Text
"Evaluating an 'in' expression produced non-boolean result"
        Either RuntimeError Bool
x -> Either RuntimeError Bool -> m (Either RuntimeError Bool)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either RuntimeError Bool
x
    go (UnaryE UnaryOperator
_ Expr
a) =
      Expr -> m (Either RuntimeError Bool)
go Expr
a
    go (BinaryE BinaryOperator
_ Expr
a Expr
b) = do
      Either RuntimeError Bool
definedA <- Expr -> m (Either RuntimeError Bool)
go Expr
a
      Either RuntimeError Bool
definedB <- Expr -> m (Either RuntimeError Bool)
go Expr
b
      Either RuntimeError Bool -> m (Either RuntimeError Bool)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError Bool -> m (Either RuntimeError Bool))
-> Either RuntimeError Bool -> m (Either RuntimeError Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Bool
(&&) (Bool -> Bool -> Bool)
-> Either RuntimeError Bool -> Either RuntimeError (Bool -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either RuntimeError Bool
definedA Either RuntimeError (Bool -> Bool)
-> Either RuntimeError Bool -> Either RuntimeError Bool
forall a b.
Either RuntimeError (a -> b)
-> Either RuntimeError a -> Either RuntimeError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either RuntimeError Bool
definedB
    go (DotE Expr
a Identifier
_b) = do
      Expr -> m (Either RuntimeError Bool)
go Expr
a
    go (TernaryE Expr
c Expr
a Expr
b) = do
      Either RuntimeError Bool
definedA <- Expr -> m (Either RuntimeError Bool)
go Expr
a
      Either RuntimeError Bool
definedB <- Expr -> m (Either RuntimeError Bool)
go Expr
b
      Either RuntimeError Bool
definedC <- Expr -> m (Either RuntimeError Bool)
go Expr
c
      Either RuntimeError Bool -> m (Either RuntimeError Bool)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError Bool -> m (Either RuntimeError Bool))
-> Either RuntimeError Bool -> m (Either RuntimeError Bool)
forall a b. (a -> b) -> a -> b
$ [Either RuntimeError Bool] -> Either RuntimeError Bool
forall a. [Either a Bool] -> Either a Bool
allEitherBool [Either RuntimeError Bool
Item [Either RuntimeError Bool]
definedA, Either RuntimeError Bool
Item [Either RuntimeError Bool]
definedB, Either RuntimeError Bool
Item [Either RuntimeError Bool]
definedC]
    go (ListE Vector Expr
v) =
      case Vector Expr -> Maybe (Expr, Vector Expr)
forall a. Vector a -> Maybe (a, Vector a)
V.uncons Vector Expr
v of
        Maybe (Expr, Vector Expr)
Nothing -> Either RuntimeError Bool -> m (Either RuntimeError Bool)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError Bool -> m (Either RuntimeError Bool))
-> (Bool -> Either RuntimeError Bool)
-> Bool
-> m (Either RuntimeError Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Either RuntimeError Bool
forall a b. b -> Either a b
Right (Bool -> m (Either RuntimeError Bool))
-> Bool -> m (Either RuntimeError Bool)
forall a b. (a -> b) -> a -> b
$ Bool
True
        Just (Expr
x, Vector Expr
xs) -> do
          Either RuntimeError Bool
definedX <- Expr -> m (Either RuntimeError Bool)
go Expr
x
          Either RuntimeError Bool
definedXS <- Expr -> m (Either RuntimeError Bool)
go (Vector Expr -> Expr
ListE Vector Expr
xs)
          Either RuntimeError Bool -> m (Either RuntimeError Bool)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError Bool -> m (Either RuntimeError Bool))
-> Either RuntimeError Bool -> m (Either RuntimeError Bool)
forall a b. (a -> b) -> a -> b
$ [Either RuntimeError Bool] -> Either RuntimeError Bool
forall a. [Either a Bool] -> Either a Bool
allEitherBool [Either RuntimeError Bool
Item [Either RuntimeError Bool]
definedX, Either RuntimeError Bool
Item [Either RuntimeError Bool]
definedXS]
    go (DictE []) = Either RuntimeError Bool -> m (Either RuntimeError Bool)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError Bool -> m (Either RuntimeError Bool))
-> (Bool -> Either RuntimeError Bool)
-> Bool
-> m (Either RuntimeError Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Either RuntimeError Bool
forall a b. b -> Either a b
Right (Bool -> m (Either RuntimeError Bool))
-> Bool -> m (Either RuntimeError Bool)
forall a b. (a -> b) -> a -> b
$ Bool
True
    go (DictE ((Expr
k, Expr
v):[(Expr, Expr)]
xs)) = do
      Either RuntimeError Bool
definedK <- Expr -> m (Either RuntimeError Bool)
go Expr
k
      Either RuntimeError Bool
definedV <- Expr -> m (Either RuntimeError Bool)
go Expr
v
      Either RuntimeError Bool
definedXS <- Expr -> m (Either RuntimeError Bool)
go ([(Expr, Expr)] -> Expr
DictE [(Expr, Expr)]
xs)
      Either RuntimeError Bool -> m (Either RuntimeError Bool)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError Bool -> m (Either RuntimeError Bool))
-> Either RuntimeError Bool -> m (Either RuntimeError Bool)
forall a b. (a -> b) -> a -> b
$ [Either RuntimeError Bool] -> Either RuntimeError Bool
forall a. [Either a Bool] -> Either a Bool
allEitherBool [Either RuntimeError Bool
Item [Either RuntimeError Bool]
definedK, Either RuntimeError Bool
Item [Either RuntimeError Bool]
definedV, Either RuntimeError Bool
Item [Either RuntimeError Bool]
definedXS]
    go (IsE {}) = Either RuntimeError Bool -> m (Either RuntimeError Bool)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError Bool -> m (Either RuntimeError Bool))
-> (Bool -> Either RuntimeError Bool)
-> Bool
-> m (Either RuntimeError Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Either RuntimeError Bool
forall a b. b -> Either a b
Right (Bool -> m (Either RuntimeError Bool))
-> Bool -> m (Either RuntimeError Bool)
forall a b. (a -> b) -> a -> b
$ Bool
True
    go (StatementE {}) = Either RuntimeError Bool -> m (Either RuntimeError Bool)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError Bool -> m (Either RuntimeError Bool))
-> (Bool -> Either RuntimeError Bool)
-> Bool
-> m (Either RuntimeError Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Either RuntimeError Bool
forall a b. b -> Either a b
Right (Bool -> m (Either RuntimeError Bool))
-> Bool -> m (Either RuntimeError Bool)
forall a b. (a -> b) -> a -> b
$ Bool
True
    go (FilterE Expr
posArg0 Expr
callee [Expr]
posArgs [(Identifier, Expr)]
kwArgs) = do
      Either RuntimeError Bool
definedPosArg0 <- Expr -> m (Either RuntimeError Bool)
go Expr
posArg0
      Either RuntimeError Bool
definedCallee <- Expr -> m (Either RuntimeError Bool)
go Expr
callee
      Either RuntimeError Bool
definedPosArgs <- [Either RuntimeError Bool] -> Either RuntimeError Bool
forall a. [Either a Bool] -> Either a Bool
allEitherBool ([Either RuntimeError Bool] -> Either RuntimeError Bool)
-> m [Either RuntimeError Bool] -> m (Either RuntimeError Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Expr -> m (Either RuntimeError Bool))
-> [Expr] -> m [Either RuntimeError 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 (\Expr
x -> Expr -> m (Either RuntimeError Bool)
go Expr
x) [Expr]
posArgs
      Either RuntimeError Bool
definedKWArgs <- [Either RuntimeError Bool] -> Either RuntimeError Bool
forall a. [Either a Bool] -> Either a Bool
allEitherBool ([Either RuntimeError Bool] -> Either RuntimeError Bool)
-> m [Either RuntimeError Bool] -> m (Either RuntimeError Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Identifier, Expr) -> m (Either RuntimeError Bool))
-> [(Identifier, Expr)] -> m [Either RuntimeError 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 (\(Identifier
_, Expr
x) -> Expr -> m (Either RuntimeError Bool)
go Expr
x) [(Identifier, Expr)]
kwArgs
      Either RuntimeError Bool -> m (Either RuntimeError Bool)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError Bool -> m (Either RuntimeError Bool))
-> Either RuntimeError Bool -> m (Either RuntimeError Bool)
forall a b. (a -> b) -> a -> b
$ [Either RuntimeError Bool] -> Either RuntimeError Bool
forall a. [Either a Bool] -> Either a Bool
allEitherBool [Either RuntimeError Bool
Item [Either RuntimeError Bool]
definedPosArg0, Either RuntimeError Bool
Item [Either RuntimeError Bool]
definedCallee, Either RuntimeError Bool
Item [Either RuntimeError Bool]
definedPosArgs, Either RuntimeError Bool
Item [Either RuntimeError Bool]
definedKWArgs]
    go (CallE Expr
callee [Expr]
posArgs [(Identifier, Expr)]
kwArgs) = do
      Either RuntimeError Bool
definedCallee <- Expr -> m (Either RuntimeError Bool)
go Expr
callee
      Either RuntimeError Bool
definedPosArgs <- [Either RuntimeError Bool] -> Either RuntimeError Bool
forall a. [Either a Bool] -> Either a Bool
allEitherBool ([Either RuntimeError Bool] -> Either RuntimeError Bool)
-> m [Either RuntimeError Bool] -> m (Either RuntimeError Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Expr -> m (Either RuntimeError Bool))
-> [Expr] -> m [Either RuntimeError 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 (\Expr
x -> Expr -> m (Either RuntimeError Bool)
go Expr
x) [Expr]
posArgs
      Either RuntimeError Bool
definedKWArgs <- [Either RuntimeError Bool] -> Either RuntimeError Bool
forall a. [Either a Bool] -> Either a Bool
allEitherBool ([Either RuntimeError Bool] -> Either RuntimeError Bool)
-> m [Either RuntimeError Bool] -> m (Either RuntimeError Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Identifier, Expr) -> m (Either RuntimeError Bool))
-> [(Identifier, Expr)] -> m [Either RuntimeError 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 (\(Identifier
_, Expr
x) -> Expr -> m (Either RuntimeError Bool)
go Expr
x) [(Identifier, Expr)]
kwArgs
      Either RuntimeError Bool -> m (Either RuntimeError Bool)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError Bool -> m (Either RuntimeError Bool))
-> Either RuntimeError Bool -> m (Either RuntimeError Bool)
forall a b. (a -> b) -> a -> b
$ [Either RuntimeError Bool] -> Either RuntimeError Bool
forall a. [Either a Bool] -> Either a Bool
allEitherBool [Either RuntimeError Bool
Item [Either RuntimeError Bool]
definedCallee, Either RuntimeError Bool
Item [Either RuntimeError Bool]
definedPosArgs, Either RuntimeError Bool
Item [Either RuntimeError Bool]
definedKWArgs]

isUndefined :: Monad m => TestFunc m
isUndefined :: forall (m :: * -> *). Monad m => TestFunc m
isUndefined Expr
expr [(Maybe Identifier, Value m)]
args Context m
ctx Env m
env SomePRNG
rng = do
  Either RuntimeError Bool
defined <- TestFunc m
forall (m :: * -> *). Monad m => TestFunc m
isDefined Expr
expr [(Maybe Identifier, Value m)]
args Context m
ctx Env m
env SomePRNG
rng
  Either RuntimeError Bool -> m (Either RuntimeError Bool)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError Bool -> m (Either RuntimeError Bool))
-> Either RuntimeError Bool -> m (Either RuntimeError Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool)
-> Either RuntimeError Bool -> Either RuntimeError Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either RuntimeError Bool
defined

isEqual :: Monad m => TestFunc m
isEqual :: forall (m :: * -> *). Monad m => TestFunc m
isEqual Expr
expr [(Maybe Identifier, Value m)]
args Context m
ctx Env m
env SomePRNG
rng =
  GingerT m Bool
-> Context m -> Env m -> SomePRNG -> m (Either RuntimeError Bool)
forall (m :: * -> *) g a.
(Monad m, SplitGen g) =>
GingerT m a -> Context m -> Env m -> g -> m (Either RuntimeError a)
runGingerT GingerT m Bool
go Context m
ctx Env m
env SomePRNG
rng
  where
    go :: GingerT m Bool
go = do
      SomePRNG
rng' <- GingerT m SomePRNG
forall (m :: * -> *). Monad m => GingerT m SomePRNG
splitRNG
      Bool
definedLHS <- 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
$ TestFunc m
forall (m :: * -> *). Monad m => TestFunc m
isDefined Expr
expr [(Maybe Identifier, Value m)]
args Context m
ctx Env m
env SomePRNG
rng'
      if Bool
definedLHS then do
        Value m
val <- Expr -> GingerT m (Value m)
forall (m :: * -> *) a. Eval m a => a -> GingerT m (Value m)
eval Expr
expr
        [Bool]
equals <- ((Maybe Identifier, Value m) -> GingerT m Bool)
-> [(Maybe Identifier, Value m)] -> 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 (Value m -> Value m -> GingerT m Bool
forall (m :: * -> *).
Monad m =>
Value m -> Value m -> GingerT m Bool
valuesEqual Value m
val (Value m -> GingerT m Bool)
-> ((Maybe Identifier, Value m) -> Value m)
-> (Maybe Identifier, Value m)
-> GingerT m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Identifier, Value m) -> Value m
forall a b. (a, b) -> b
snd) [(Maybe Identifier, Value m)]
args
        Bool -> GingerT m Bool
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> GingerT m Bool) -> Bool -> GingerT m Bool
forall a b. (a -> b) -> a -> b
$ (Bool -> Bool) -> [Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Bool -> Bool
forall a. a -> a
id [Bool]
equals
      else
        Bool -> GingerT m Bool
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False

gingerBinopTest :: forall m. Monad m
                => BinaryOperator
                -> Value m
gingerBinopTest :: forall (m :: * -> *). Monad m => BinaryOperator -> Value m
gingerBinopTest BinaryOperator
op =
  Test m -> Value m
forall (m :: * -> *). Test m -> Value m
TestV (Test m -> Value m) -> Test m -> Value m
forall a b. (a -> b) -> a -> b
$ Maybe ProcedureDoc -> TestFunc m -> Test m
forall (m :: * -> *). Maybe ProcedureDoc -> TestFunc m -> Test m
NativeTest
    (ProcedureDoc -> Maybe ProcedureDoc
forall a. a -> Maybe a
Just ProcedureDoc
        { procedureDocName :: Text
procedureDocName = Text
opName
        , procedureDocArgs :: Vector ArgumentDoc
procedureDocArgs =
            [ Text -> Maybe TypeDoc -> Maybe Text -> Text -> ArgumentDoc
ArgumentDoc Text
"expr" (TypeDoc -> Maybe TypeDoc
forall a. a -> Maybe a
Just TypeDoc
TypeDocAny) Maybe Text
forall a. Maybe a
Nothing Text
""
            , Text -> Maybe TypeDoc -> Maybe Text -> Text -> ArgumentDoc
ArgumentDoc Text
"arg" (TypeDoc -> Maybe TypeDoc
forall a. a -> Maybe a
Just TypeDoc
TypeDocAny) Maybe Text
forall a. Maybe a
Nothing Text
""
            ]
        , 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
$ TypeDoc
TypeDocAny
        , procedureDocDescription :: Text
procedureDocDescription =
            Text
"Apply the '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
opName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' operation to the value of `expr` " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
            Text
"and  the `arg`, and use the result as a boolean condition."
        })
    TestFunc m
f
  where
    opName :: Text
    opName :: Text
opName = BinaryOperator -> Text
forall a. RenderSyntax a => a -> Text
renderSyntaxText BinaryOperator
op

    f :: TestFunc m
    f :: TestFunc m
f Expr
expr [(Maybe Identifier, Value m)]
args Context m
ctx Env m
env = GingerT m Bool
-> Context m -> Env m -> SomePRNG -> m (Either RuntimeError Bool)
forall (m :: * -> *) g a.
(Monad m, SplitGen g) =>
GingerT m a -> Context m -> Env m -> g -> m (Either RuntimeError a)
runGingerT (Expr -> [(Maybe Identifier, Value m)] -> GingerT m Bool
forall {m :: * -> *} {a}.
Monad m =>
Expr -> [(a, Value m)] -> GingerT m Bool
go Expr
expr [(Maybe Identifier, Value m)]
args) Context m
ctx Env m
env

    go :: Expr -> [(a, Value m)] -> GingerT m Bool
go Expr
expr [(a, Value m)]
args = 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
      Identifier -> Value m -> GingerT m ()
forall (m :: * -> *).
Monad m =>
Identifier -> Value m -> GingerT m ()
setVar Identifier
"#args" (Vector (Value m) -> Value m
forall (m :: * -> *). Vector (Value m) -> Value m
ListV (Vector (Value m) -> Value m)
-> ([Value m] -> Vector (Value m)) -> [Value m] -> Value m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value m] -> Vector (Value m)
forall a. [a] -> Vector a
V.fromList ([Value m] -> Value m) -> [Value m] -> Value m
forall a b. (a -> b) -> a -> b
$ ((a, Value m) -> Value m) -> [(a, Value m)] -> [Value m]
forall a b. (a -> b) -> [a] -> [b]
map (a, Value m) -> Value m
forall a b. (a, b) -> b
snd [(a, Value m)]
args)
      Expr -> GingerT m (Value m)
forall (m :: * -> *) a. Eval m a => a -> GingerT m (Value m)
eval (BinaryOperator -> Expr -> Expr -> Expr
BinaryE BinaryOperator
op Expr
expr (Identifier -> Expr
VarE Identifier
"#args")) 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
>>= \case
        Value m
TrueV -> Bool -> GingerT m Bool
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
        Value m
_ -> Bool -> GingerT m Bool
forall a. a -> GingerT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False

fnEither :: Monad m => Either a b -> ExceptT a m b
fnEither :: forall (m :: * -> *) a b. Monad m => Either a b -> ExceptT a m b
fnEither = (a -> ExceptT a m b)
-> (b -> ExceptT a m b) -> Either a b -> ExceptT a m b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> ExceptT a m b
forall a. a -> ExceptT a m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError b -> ExceptT a m b
forall a. a -> ExceptT a m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

fnMaybeArg :: Monad m => Text -> Text -> Maybe b -> ExceptT RuntimeError m b
fnMaybeArg :: forall (m :: * -> *) b.
Monad m =>
Text -> Text -> Maybe b -> ExceptT RuntimeError m b
fnMaybeArg Text
context Text
name =
  ExceptT RuntimeError m b
-> (b -> ExceptT RuntimeError m b)
-> Maybe b
-> ExceptT RuntimeError m b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (RuntimeError -> ExceptT RuntimeError m b
forall a. RuntimeError -> ExceptT RuntimeError m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (RuntimeError -> ExceptT RuntimeError m b)
-> RuntimeError -> ExceptT RuntimeError m b
forall a b. (a -> b) -> a -> b
$
        Text -> Text -> Text -> Text -> RuntimeError
ArgumentError
          Text
context
          Text
name
          Text
"argument"
          Text
"end of arguments"
    )
    b -> ExceptT RuntimeError m b
forall a. a -> ExceptT RuntimeError m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure