{-# 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 Control.Monad.Random (MonadRandom)
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

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

defContext :: MonadRandom m => Context m
defContext :: forall (m :: * -> *). MonadRandom 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. MonadRandom m
              => Map Identifier (Value m)
defVarsCommon :: forall (m :: * -> *). MonadRandom 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 :: * -> *). MonadRandom 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 :: * -> *). MonadRandom 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 :: * -> *).
MonadRandom m =>
(Expr -> GingerT m (Value m)) -> Map Identifier (Value m)
builtinGlobals Expr -> GingerT m (Value m)
forall (m :: * -> *). MonadRandom 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 :: * -> *).
MonadRandom m =>
(Expr -> GingerT m (Value m)) -> Map Identifier (Value m)
builtinGlobals Expr -> GingerT m (Value m)
forall (m :: * -> *). MonadRandom m => Expr -> GingerT m (Value m)
evalE

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

defVars :: forall m. MonadRandom m
        => Map Identifier (Value m)
defVars :: forall (m :: * -> *). MonadRandom m => Map Identifier (Value m)
defVars = Map Identifier (Value m)
forall (m :: * -> *). MonadRandom 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 :: * -> *). MonadRandom 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 :: * -> *). MonadRandom m => Expr -> GingerT m (Value m)
evalE
                 )
               ]
             )
           ]

builtinFilters :: forall m. MonadRandom m
             => Map Identifier (Value m)
builtinFilters :: forall (m :: * -> *). MonadRandom 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 :: * -> *). MonadRandom 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 :: * -> *). MonadRandom m => Filter m
defaultFilter)
            ]

builtinTests :: forall m. MonadRandom m
             => Map Identifier (Value m)
builtinTests :: forall (m :: * -> *). MonadRandom 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 :: * -> *). MonadRandom 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 :: * -> *). MonadRandom 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 :: * -> *). MonadRandom 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 :: * -> *). MonadRandom 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
""
                                  , Text -> Maybe TypeDoc -> Maybe Text -> Text -> ArgumentDoc
ArgumentDoc Text
"other" (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 equal to `other`."
                              }
                          )
                          TestFunc m
forall (m :: * -> *). MonadRandom m => TestFunc m
isEqual)
            , (Identifier
"equalto", 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
""
                                  , Text -> Maybe TypeDoc -> Maybe Text -> Text -> ArgumentDoc
ArgumentDoc Text
"other" (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 equal to `other`."
                              }
                          )
                          TestFunc m
forall (m :: * -> *). MonadRandom 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 :: * -> *). MonadRandom m => BinaryOperator -> Value m
gingerBinopTest BinaryOperator
BinopGTE)
            , (Identifier
"gt", BinaryOperator -> Value m
forall (m :: * -> *). MonadRandom m => BinaryOperator -> Value m
gingerBinopTest BinaryOperator
BinopGT)
            , (Identifier
"greaterthan", BinaryOperator -> Value m
forall (m :: * -> *). MonadRandom m => BinaryOperator -> Value m
gingerBinopTest BinaryOperator
BinopGT)
            , (Identifier
"in", BinaryOperator -> Value m
forall (m :: * -> *). MonadRandom m => BinaryOperator -> Value m
gingerBinopTest BinaryOperator
BinopIn)
            , (Identifier
"le", BinaryOperator -> Value m
forall (m :: * -> *). MonadRandom 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 :: * -> *). MonadRandom m => BinaryOperator -> Value m
gingerBinopTest BinaryOperator
BinopLT)
            , (Identifier
"lessthan", BinaryOperator -> Value m
forall (m :: * -> *). MonadRandom 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 :: MonadRandom m => TestFunc m
isFilter :: forall (m :: * -> *). MonadRandom m => TestFunc m
isFilter Expr
expr [(Maybe Identifier, Value m)]
_ Context m
ctx Env m
env = do
  result <- GingerT m (Value m)
-> Context m -> Env m -> m (Either RuntimeError (Value m))
forall (m :: * -> *) a.
MonadRandom m =>
GingerT m a -> Context m -> Env m -> m (Either RuntimeError a)
runGingerT (Expr -> GingerT m (Value m)
forall (m :: * -> *). MonadRandom m => Expr -> GingerT m (Value m)
evalE Expr
expr) Context m
ctx Env m
env
  case 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))
      existsExt <-
        GingerT m Bool
-> Context m -> Env m -> m (Either RuntimeError Bool)
forall (m :: * -> *) a.
MonadRandom m =>
GingerT m a -> Context m -> Env m -> 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
      pure $ (exists ||) <$> 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 :: MonadRandom m => TestFunc m
isTest :: forall (m :: * -> *). MonadRandom m => TestFunc m
isTest Expr
expr [(Maybe Identifier, Value m)]
_ Context m
ctx Env m
env = do
  result <- GingerT m (Value m)
-> Context m -> Env m -> m (Either RuntimeError (Value m))
forall (m :: * -> *) a.
MonadRandom m =>
GingerT m a -> Context m -> Env m -> m (Either RuntimeError a)
runGingerT (Expr -> GingerT m (Value m)
forall (m :: * -> *). MonadRandom m => Expr -> GingerT m (Value m)
evalE Expr
expr) Context m
ctx Env m
env
  case 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 :: MonadRandom m => Filter m
defaultFilter :: forall (m :: * -> *). MonadRandom 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 -> do
      calleeEither <- GingerT m (Value m)
-> Context m -> Env m -> m (Either RuntimeError (Value m))
forall (m :: * -> *) a.
MonadRandom m =>
GingerT m a -> Context m -> Env m -> m (Either RuntimeError a)
runGingerT (Expr -> GingerT m (Value m)
forall (m :: * -> *). MonadRandom m => Expr -> GingerT m (Value m)
evalE Expr
expr) Context m
ctx Env m
env
      let 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 (calleeEither, 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. MonadRandom m => TestFunc m
isDefined :: forall (m :: * -> *). MonadRandom m => TestFunc m
isDefined Expr
_ ((Maybe Identifier, Value m)
_:[(Maybe Identifier, Value m)]
_) Context m
_ Env 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))
-> 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 = 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
      definedSlicee <- Expr -> m (Either RuntimeError Bool)
go Expr
slicee
      definedStart <- maybe (pure . Right $ True) (\Expr
start -> Expr -> m (Either RuntimeError Bool)
go Expr
start) startMay
      definedEnd <- maybe (pure . Right $ True) (\Expr
end -> Expr -> m (Either RuntimeError Bool)
go Expr
end) endMay
      pure $ allEitherBool [ definedSlicee, definedStart, definedEnd ]
    go (IndexE Expr
parent Expr
selector) = do
      definedParent <- Expr -> m (Either RuntimeError Bool)
go Expr
parent
      case definedParent of
        Right Bool
True -> do
          result <- GingerT m (Value m)
-> Context m -> Env m -> m (Either RuntimeError (Value m))
forall (m :: * -> *) a.
MonadRandom m =>
GingerT m a -> Context m -> Env m -> m (Either RuntimeError a)
runGingerT (Expr -> GingerT m (Value m)
forall (m :: * -> *). MonadRandom m => Expr -> GingerT m (Value m)
evalE (Expr -> Expr -> Expr
InE Expr
selector Expr
parent)) Context m
ctx Env m
env
          case 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
      definedA <- Expr -> m (Either RuntimeError Bool)
go Expr
a
      definedB <- go b
      pure $ (&&) <$> definedA <*> 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
      definedA <- Expr -> m (Either RuntimeError Bool)
go Expr
a
      definedB <- go b
      definedC <- go c
      pure $ allEitherBool [definedA, definedB, 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
          definedX <- Expr -> m (Either RuntimeError Bool)
go Expr
x
          definedXS <- go (ListE xs)
          pure $ allEitherBool [definedX, 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
      definedK <- Expr -> m (Either RuntimeError Bool)
go Expr
k
      definedV <- go v
      definedXS <- go (DictE xs)
      pure $ allEitherBool [definedK, definedV, 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
      definedPosArg0 <- Expr -> m (Either RuntimeError Bool)
go Expr
posArg0
      definedCallee <- go callee
      definedPosArgs <- allEitherBool <$> mapM (\Expr
x -> Expr -> m (Either RuntimeError Bool)
go Expr
x) posArgs
      definedKWArgs <- allEitherBool <$> mapM (\(Identifier
_, Expr
x) -> Expr -> m (Either RuntimeError Bool)
go Expr
x) kwArgs
      pure $ allEitherBool [definedPosArg0, definedCallee, definedPosArgs, definedKWArgs]
    go (CallE Expr
callee [Expr]
posArgs [(Identifier, Expr)]
kwArgs) = do
      definedCallee <- Expr -> m (Either RuntimeError Bool)
go Expr
callee
      definedPosArgs <- allEitherBool <$> mapM (\Expr
x -> Expr -> m (Either RuntimeError Bool)
go Expr
x) posArgs
      definedKWArgs <- allEitherBool <$> mapM (\(Identifier
_, Expr
x) -> Expr -> m (Either RuntimeError Bool)
go Expr
x) kwArgs
      pure $ allEitherBool [definedCallee, definedPosArgs, definedKWArgs]

isUndefined :: MonadRandom m => TestFunc m
isUndefined :: forall (m :: * -> *). MonadRandom m => TestFunc m
isUndefined Expr
expr [(Maybe Identifier, Value m)]
args Context m
ctx Env m
env = do
  defined <- TestFunc m
forall (m :: * -> *). MonadRandom m => TestFunc m
isDefined Expr
expr [(Maybe Identifier, Value m)]
args Context m
ctx Env m
env
  pure $ not <$> defined

isEqual :: MonadRandom m => TestFunc m
isEqual :: forall (m :: * -> *). MonadRandom m => TestFunc m
isEqual Expr
expr [(Maybe Identifier, Value m)]
args Context m
ctx Env m
env =
  GingerT m Bool
-> Context m -> Env m -> m (Either RuntimeError Bool)
forall (m :: * -> *) a.
MonadRandom m =>
GingerT m a -> Context m -> Env m -> m (Either RuntimeError a)
runGingerT GingerT m Bool
go Context m
ctx Env m
env
  where
    go :: GingerT m Bool
go = do
      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 :: * -> *). MonadRandom m => TestFunc m
isDefined Expr
expr [(Maybe Identifier, Value m)]
args Context m
ctx Env m
env
      if definedLHS then do
        val <- eval expr
        equals <- mapM (valuesEqual val . snd) args
        pure $ all id equals
      else
        pure False

gingerBinopTest :: forall m. MonadRandom m
                => BinaryOperator
                -> Value m
gingerBinopTest :: forall (m :: * -> *). MonadRandom 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 -> m (Either RuntimeError Bool)
forall (m :: * -> *) a.
MonadRandom m =>
GingerT m a -> Context m -> Env m -> m (Either RuntimeError a)
runGingerT (Expr -> [(Maybe Identifier, Value m)] -> GingerT m Bool
go Expr
expr [(Maybe Identifier, Value m)]
args) Context m
ctx Env m
env

    go :: Expr -> [(Maybe Identifier, Value m)] -> GingerT m Bool
    go :: Expr -> [(Maybe Identifier, Value m)] -> GingerT m Bool
go Expr
_ [] = RuntimeError -> GingerT m Bool
forall a. RuntimeError -> GingerT m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (RuntimeError -> GingerT m Bool) -> RuntimeError -> GingerT m Bool
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Text -> RuntimeError
ArgumentError Text
opName Text
"2" Text
"any" Text
"end of arguments"
    go Expr
expr ((Maybe Identifier, Value m)
arg:[(Maybe Identifier, Value m)]
_) = 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
"#arg" ((Maybe Identifier, Value m) -> Value m
forall a b. (a, b) -> b
snd (Maybe Identifier, Value m)
arg)
      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
"#arg")) 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