{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ExistentialQuantification #-}

module Language.Ginger.Value
where

import Control.Monad.Except (runExceptT, throwError, MonadError)
import Control.Monad.Reader (MonadReader (..))
import Control.Monad.Trans (MonadTrans, lift)
import Data.Aeson
          ( FromJSON (..)
          , FromJSONKey (..)
          , ToJSON (..)
          , FromJSONKeyFunction (..)
          , ToJSONKey (..)
          )
import qualified Data.Aeson as JSON
import qualified Data.Aeson.Types as JSON
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base64 as Base64
import qualified Data.ByteString.Lazy as LBS
import Data.Foldable (fold)
import Data.Int
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe (fromMaybe)
import Data.Scientific (floatingOrInteger)
import Data.String (IsString (..))
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Text.Encoding (decodeUtf8)
import qualified Data.Text.Lazy as LText
import Data.Vector (Vector)
import qualified Data.Vector as V
import Data.Word
import GHC.Float (float2Double)
import System.Random (RandomGen (..), SplitGen (..))
import Test.Tasty.QuickCheck (Arbitrary (..))
import qualified Test.Tasty.QuickCheck as QC
import Text.Printf (PrintfArg (..))
import Text.Read (readMaybe)

import Language.Ginger.AST
import Language.Ginger.RuntimeError

data SomePRNG =
  forall g. (SplitGen g) => SomePRNG { ()
unPRNG :: g }

instance RandomGen SomePRNG where
  genWord32 :: SomePRNG -> (Word32, SomePRNG)
genWord32 (SomePRNG g
g) =
    (Word32
i, g -> SomePRNG
forall g. SplitGen g => g -> SomePRNG
SomePRNG g
g')
    where
      (Word32
i, g
g') = g -> (Word32, g)
forall g. RandomGen g => g -> (Word32, g)
genWord32 g
g
  genWord64 :: SomePRNG -> (Word64, SomePRNG)
genWord64 (SomePRNG g
g) =
    (Word64
i, g -> SomePRNG
forall g. SplitGen g => g -> SomePRNG
SomePRNG g
g')
    where
      (Word64
i, g
g') = g -> (Word64, g)
forall g. RandomGen g => g -> (Word64, g)
genWord64 g
g

instance SplitGen SomePRNG where
  splitGen :: SomePRNG -> (SomePRNG, SomePRNG)
splitGen (SomePRNG g
g) =
    (g -> SomePRNG
forall g. SplitGen g => g -> SomePRNG
SomePRNG g
a, g -> SomePRNG
forall g. SplitGen g => g -> SomePRNG
SomePRNG g
b)
    where
      (g
a, g
b) = g -> (g, g)
forall g. SplitGen g => g -> (g, g)
splitGen g
g

data Env m =
  Env
    { forall (m :: * -> *). Env m -> Map Identifier (Value m)
envVars :: !(Map Identifier (Value m))
    , forall (m :: * -> *). Env m -> Maybe (Env m)
envRootMay :: Maybe (Env m)
    }
  deriving (Env m -> Env m -> Bool
(Env m -> Env m -> Bool) -> (Env m -> Env m -> Bool) -> Eq (Env m)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (m :: * -> *). Env m -> Env m -> Bool
$c== :: forall (m :: * -> *). Env m -> Env m -> Bool
== :: Env m -> Env m -> Bool
$c/= :: forall (m :: * -> *). Env m -> Env m -> Bool
/= :: Env m -> Env m -> Bool
Eq, Eq (Env m)
Eq (Env m) =>
(Env m -> Env m -> Ordering)
-> (Env m -> Env m -> Bool)
-> (Env m -> Env m -> Bool)
-> (Env m -> Env m -> Bool)
-> (Env m -> Env m -> Bool)
-> (Env m -> Env m -> Env m)
-> (Env m -> Env m -> Env m)
-> Ord (Env m)
Env m -> Env m -> Bool
Env m -> Env m -> Ordering
Env m -> Env m -> Env m
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (m :: * -> *). Eq (Env m)
forall (m :: * -> *). Env m -> Env m -> Bool
forall (m :: * -> *). Env m -> Env m -> Ordering
forall (m :: * -> *). Env m -> Env m -> Env m
$ccompare :: forall (m :: * -> *). Env m -> Env m -> Ordering
compare :: Env m -> Env m -> Ordering
$c< :: forall (m :: * -> *). Env m -> Env m -> Bool
< :: Env m -> Env m -> Bool
$c<= :: forall (m :: * -> *). Env m -> Env m -> Bool
<= :: Env m -> Env m -> Bool
$c> :: forall (m :: * -> *). Env m -> Env m -> Bool
> :: Env m -> Env m -> Bool
$c>= :: forall (m :: * -> *). Env m -> Env m -> Bool
>= :: Env m -> Env m -> Bool
$cmax :: forall (m :: * -> *). Env m -> Env m -> Env m
max :: Env m -> Env m -> Env m
$cmin :: forall (m :: * -> *). Env m -> Env m -> Env m
min :: Env m -> Env m -> Env m
Ord)

envRoot :: Env m -> Env m
envRoot :: forall (m :: * -> *). Env m -> Env m
envRoot Env m
e =
  Env m -> Maybe (Env m) -> Env m
forall a. a -> Maybe a -> a
fromMaybe Env m
e (Maybe (Env m) -> Env m) -> Maybe (Env m) -> Env m
forall a b. (a -> b) -> a -> b
$ Env m -> Maybe (Env m)
forall (m :: * -> *). Env m -> Maybe (Env m)
envRootMay Env m
e

emptyEnv :: Env m
emptyEnv :: forall (m :: * -> *). Env m
emptyEnv = Map Identifier (Value m) -> Maybe (Env m) -> Env m
forall (m :: * -> *).
Map Identifier (Value m) -> Maybe (Env m) -> Env m
Env Map Identifier (Value m)
forall a. Monoid a => a
mempty Maybe (Env m)
forall a. Maybe a
Nothing

instance Semigroup (Env m) where
  Env m
a <> :: Env m -> Env m -> Env m
<> Env m
b = Env
            { envVars :: Map Identifier (Value m)
envVars = Env m -> Map Identifier (Value m)
forall (m :: * -> *). Env m -> Map Identifier (Value m)
envVars Env m
a Map Identifier (Value m)
-> Map Identifier (Value m) -> Map Identifier (Value m)
forall a. Semigroup a => a -> a -> a
<> Env m -> Map Identifier (Value m)
forall (m :: * -> *). Env m -> Map Identifier (Value m)
envVars Env m
b
            , envRootMay :: Maybe (Env m)
envRootMay = Env m -> Maybe (Env m)
forall (m :: * -> *). Env m -> Maybe (Env m)
envRootMay Env m
a Maybe (Env m) -> Maybe (Env m) -> Maybe (Env m)
forall a. Semigroup a => a -> a -> a
<> Env m -> Maybe (Env m)
forall (m :: * -> *). Env m -> Maybe (Env m)
envRootMay Env m
b
            }

instance Monoid (Env m) where
  mempty :: Env m
mempty = Env m
forall (m :: * -> *). Env m
emptyEnv

type TemplateLoader m = Text -> m (Maybe Text)

type Encoder m = Text -> m Encoded

data Context m =
  Context
    { forall (m :: * -> *). Context m -> Encoder m
contextEncode :: Encoder m
    , forall (m :: * -> *). Context m -> TemplateLoader m
contextLoadTemplateFile :: TemplateLoader m
    , forall (m :: * -> *). Context m -> Map Identifier (Value m)
contextVars :: !(Map Identifier (Value m))
    , forall (m :: * -> *). Context m -> OutputPolicy
contextOutput :: !OutputPolicy
    }

data OutputPolicy
  = Quiet
  | Output
  deriving (Int -> OutputPolicy -> ShowS
[OutputPolicy] -> ShowS
OutputPolicy -> String
(Int -> OutputPolicy -> ShowS)
-> (OutputPolicy -> String)
-> ([OutputPolicy] -> ShowS)
-> Show OutputPolicy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OutputPolicy -> ShowS
showsPrec :: Int -> OutputPolicy -> ShowS
$cshow :: OutputPolicy -> String
show :: OutputPolicy -> String
$cshowList :: [OutputPolicy] -> ShowS
showList :: [OutputPolicy] -> ShowS
Show, OutputPolicy -> OutputPolicy -> Bool
(OutputPolicy -> OutputPolicy -> Bool)
-> (OutputPolicy -> OutputPolicy -> Bool) -> Eq OutputPolicy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OutputPolicy -> OutputPolicy -> Bool
== :: OutputPolicy -> OutputPolicy -> Bool
$c/= :: OutputPolicy -> OutputPolicy -> Bool
/= :: OutputPolicy -> OutputPolicy -> Bool
Eq, Eq OutputPolicy
Eq OutputPolicy =>
(OutputPolicy -> OutputPolicy -> Ordering)
-> (OutputPolicy -> OutputPolicy -> Bool)
-> (OutputPolicy -> OutputPolicy -> Bool)
-> (OutputPolicy -> OutputPolicy -> Bool)
-> (OutputPolicy -> OutputPolicy -> Bool)
-> (OutputPolicy -> OutputPolicy -> OutputPolicy)
-> (OutputPolicy -> OutputPolicy -> OutputPolicy)
-> Ord OutputPolicy
OutputPolicy -> OutputPolicy -> Bool
OutputPolicy -> OutputPolicy -> Ordering
OutputPolicy -> OutputPolicy -> OutputPolicy
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: OutputPolicy -> OutputPolicy -> Ordering
compare :: OutputPolicy -> OutputPolicy -> Ordering
$c< :: OutputPolicy -> OutputPolicy -> Bool
< :: OutputPolicy -> OutputPolicy -> Bool
$c<= :: OutputPolicy -> OutputPolicy -> Bool
<= :: OutputPolicy -> OutputPolicy -> Bool
$c> :: OutputPolicy -> OutputPolicy -> Bool
> :: OutputPolicy -> OutputPolicy -> Bool
$c>= :: OutputPolicy -> OutputPolicy -> Bool
>= :: OutputPolicy -> OutputPolicy -> Bool
$cmax :: OutputPolicy -> OutputPolicy -> OutputPolicy
max :: OutputPolicy -> OutputPolicy -> OutputPolicy
$cmin :: OutputPolicy -> OutputPolicy -> OutputPolicy
min :: OutputPolicy -> OutputPolicy -> OutputPolicy
Ord, Int -> OutputPolicy
OutputPolicy -> Int
OutputPolicy -> [OutputPolicy]
OutputPolicy -> OutputPolicy
OutputPolicy -> OutputPolicy -> [OutputPolicy]
OutputPolicy -> OutputPolicy -> OutputPolicy -> [OutputPolicy]
(OutputPolicy -> OutputPolicy)
-> (OutputPolicy -> OutputPolicy)
-> (Int -> OutputPolicy)
-> (OutputPolicy -> Int)
-> (OutputPolicy -> [OutputPolicy])
-> (OutputPolicy -> OutputPolicy -> [OutputPolicy])
-> (OutputPolicy -> OutputPolicy -> [OutputPolicy])
-> (OutputPolicy -> OutputPolicy -> OutputPolicy -> [OutputPolicy])
-> Enum OutputPolicy
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: OutputPolicy -> OutputPolicy
succ :: OutputPolicy -> OutputPolicy
$cpred :: OutputPolicy -> OutputPolicy
pred :: OutputPolicy -> OutputPolicy
$ctoEnum :: Int -> OutputPolicy
toEnum :: Int -> OutputPolicy
$cfromEnum :: OutputPolicy -> Int
fromEnum :: OutputPolicy -> Int
$cenumFrom :: OutputPolicy -> [OutputPolicy]
enumFrom :: OutputPolicy -> [OutputPolicy]
$cenumFromThen :: OutputPolicy -> OutputPolicy -> [OutputPolicy]
enumFromThen :: OutputPolicy -> OutputPolicy -> [OutputPolicy]
$cenumFromTo :: OutputPolicy -> OutputPolicy -> [OutputPolicy]
enumFromTo :: OutputPolicy -> OutputPolicy -> [OutputPolicy]
$cenumFromThenTo :: OutputPolicy -> OutputPolicy -> OutputPolicy -> [OutputPolicy]
enumFromThenTo :: OutputPolicy -> OutputPolicy -> OutputPolicy -> [OutputPolicy]
Enum, OutputPolicy
OutputPolicy -> OutputPolicy -> Bounded OutputPolicy
forall a. a -> a -> Bounded a
$cminBound :: OutputPolicy
minBound :: OutputPolicy
$cmaxBound :: OutputPolicy
maxBound :: OutputPolicy
Bounded)

instance Semigroup OutputPolicy where
  OutputPolicy
Quiet <> :: OutputPolicy -> OutputPolicy -> OutputPolicy
<> OutputPolicy
Quiet = OutputPolicy
Quiet
  OutputPolicy
_ <> OutputPolicy
_ = OutputPolicy
Output

instance Monoid OutputPolicy where
  mappend :: OutputPolicy -> OutputPolicy -> OutputPolicy
mappend = OutputPolicy -> OutputPolicy -> OutputPolicy
forall a. Semigroup a => a -> a -> a
(<>)
  mempty :: OutputPolicy
mempty = OutputPolicy
Quiet

emptyContext :: Applicative m => Context m
emptyContext :: forall (m :: * -> *). Applicative m => Context m
emptyContext =
  Context
    { contextEncode :: Encoder m
contextEncode = Encoded -> m Encoded
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoded -> m Encoded) -> (Text -> Encoded) -> Encoder m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Encoded
Encoded
    , contextLoadTemplateFile :: TemplateLoader m
contextLoadTemplateFile = m (Maybe Text) -> TemplateLoader m
forall a b. a -> b -> a
const (m (Maybe Text) -> TemplateLoader m)
-> m (Maybe Text) -> TemplateLoader m
forall a b. (a -> b) -> a -> b
$ Maybe Text -> m (Maybe Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing
    , contextVars :: Map Identifier (Value m)
contextVars = Map Identifier (Value m)
forall a. Monoid a => a
mempty
    , contextOutput :: OutputPolicy
contextOutput = OutputPolicy
Output
    }

data Scalar
  = NoneScalar
  | BoolScalar !Bool
  | StringScalar !Text
  | EncodedScalar !Encoded
  | BytesScalar !ByteString
  | IntScalar !Integer
  | FloatScalar !Double
  deriving (Int -> Scalar -> ShowS
[Scalar] -> ShowS
Scalar -> String
(Int -> Scalar -> ShowS)
-> (Scalar -> String) -> ([Scalar] -> ShowS) -> Show Scalar
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Scalar -> ShowS
showsPrec :: Int -> Scalar -> ShowS
$cshow :: Scalar -> String
show :: Scalar -> String
$cshowList :: [Scalar] -> ShowS
showList :: [Scalar] -> ShowS
Show, Scalar -> Scalar -> Bool
(Scalar -> Scalar -> Bool)
-> (Scalar -> Scalar -> Bool) -> Eq Scalar
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Scalar -> Scalar -> Bool
== :: Scalar -> Scalar -> Bool
$c/= :: Scalar -> Scalar -> Bool
/= :: Scalar -> Scalar -> Bool
Eq, Eq Scalar
Eq Scalar =>
(Scalar -> Scalar -> Ordering)
-> (Scalar -> Scalar -> Bool)
-> (Scalar -> Scalar -> Bool)
-> (Scalar -> Scalar -> Bool)
-> (Scalar -> Scalar -> Bool)
-> (Scalar -> Scalar -> Scalar)
-> (Scalar -> Scalar -> Scalar)
-> Ord Scalar
Scalar -> Scalar -> Bool
Scalar -> Scalar -> Ordering
Scalar -> Scalar -> Scalar
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Scalar -> Scalar -> Ordering
compare :: Scalar -> Scalar -> Ordering
$c< :: Scalar -> Scalar -> Bool
< :: Scalar -> Scalar -> Bool
$c<= :: Scalar -> Scalar -> Bool
<= :: Scalar -> Scalar -> Bool
$c> :: Scalar -> Scalar -> Bool
> :: Scalar -> Scalar -> Bool
$c>= :: Scalar -> Scalar -> Bool
>= :: Scalar -> Scalar -> Bool
$cmax :: Scalar -> Scalar -> Scalar
max :: Scalar -> Scalar -> Scalar
$cmin :: Scalar -> Scalar -> Scalar
min :: Scalar -> Scalar -> Scalar
Ord)

instance FromJSON Scalar where
  parseJSON :: Value -> Parser Scalar
parseJSON Value
JSON.Null =
    Scalar -> Parser Scalar
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Scalar
NoneScalar
  parseJSON (JSON.Bool Bool
b) =
    Scalar -> Parser Scalar
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Scalar -> Parser Scalar) -> Scalar -> Parser Scalar
forall a b. (a -> b) -> a -> b
$ Bool -> Scalar
BoolScalar Bool
b
  parseJSON (JSON.String Text
s) =
    Scalar -> Parser Scalar
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Scalar -> Parser Scalar) -> Scalar -> Parser Scalar
forall a b. (a -> b) -> a -> b
$ Text -> Scalar
StringScalar Text
s
  parseJSON (JSON.Number Scientific
i) =
    Scalar -> Parser Scalar
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Scalar -> Parser Scalar) -> Scalar -> Parser Scalar
forall a b. (a -> b) -> a -> b
$ (Double -> Scalar)
-> (Integer -> Scalar) -> Either Double Integer -> Scalar
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Double -> Scalar
FloatScalar Integer -> Scalar
IntScalar (Either Double Integer -> Scalar)
-> Either Double Integer -> Scalar
forall a b. (a -> b) -> a -> b
$ Scientific -> Either Double Integer
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger Scientific
i
  parseJSON Value
x = Value -> Parser Scalar
forall a. Value -> Parser a
JSON.unexpected Value
x

instance ToJSON Scalar where
  toJSON :: Scalar -> Value
toJSON Scalar
NoneScalar = Value
JSON.Null
  toJSON (BoolScalar Bool
b) = Bool -> Value
JSON.Bool Bool
b
  toJSON (StringScalar Text
s) = Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
s
  toJSON (EncodedScalar (Encoded Text
e)) = Text -> Value
JSON.String Text
e
  toJSON (BytesScalar ByteString
bs) =
    [Pair] -> Value
JSON.object
      [ (Key
"@type", Text -> Value
JSON.String Text
"bytes")
      , (Key
"@data", [Word8] -> Value
forall a. ToJSON a => a -> Value
toJSON (ByteString -> [Word8]
BS.unpack ByteString
bs))
      ]
  toJSON (IntScalar Integer
i) = Integer -> Value
forall a. ToJSON a => a -> Value
toJSON Integer
i
  toJSON (FloatScalar Double
f) = Double -> Value
forall a. ToJSON a => a -> Value
toJSON Double
f

instance FromJSONKey Scalar where
  fromJSONKey :: FromJSONKeyFunction Scalar
fromJSONKey = (Text -> Scalar) -> FromJSONKeyFunction Scalar
forall a. (Text -> a) -> FromJSONKeyFunction a
FromJSONKeyText Text -> Scalar
StringScalar

instance ToJSONKey Scalar where
  toJSONKey :: ToJSONKeyFunction Scalar
toJSONKey = (Scalar -> Text) -> ToJSONKeyFunction Scalar
forall a. (a -> Text) -> ToJSONKeyFunction a
JSON.toJSONKeyText Scalar -> Text
scalarToText

scalarToText :: Scalar -> Text
scalarToText :: Scalar -> Text
scalarToText Scalar
NoneScalar = Text
""
scalarToText (BoolScalar Bool
True) = Text
"true"
scalarToText (BoolScalar Bool
False) = Text
"false"
scalarToText (StringScalar Text
str) = Text
str
scalarToText (BytesScalar ByteString
b) = ByteString -> Text
decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base64.encode (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString
b
scalarToText (EncodedScalar (Encoded Text
e)) = Text
e
scalarToText (IntScalar Integer
i) = Integer -> Text
forall a. Show a => a -> Text
Text.show Integer
i
scalarToText (FloatScalar Double
f) = Double -> Text
forall a. Show a => a -> Text
Text.show Double
f

newtype RefID = RefID { RefID -> Int
unRefID :: Int }
  deriving (Int -> RefID -> ShowS
[RefID] -> ShowS
RefID -> String
(Int -> RefID -> ShowS)
-> (RefID -> String) -> ([RefID] -> ShowS) -> Show RefID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RefID -> ShowS
showsPrec :: Int -> RefID -> ShowS
$cshow :: RefID -> String
show :: RefID -> String
$cshowList :: [RefID] -> ShowS
showList :: [RefID] -> ShowS
Show, Eq RefID
Eq RefID =>
(RefID -> RefID -> Ordering)
-> (RefID -> RefID -> Bool)
-> (RefID -> RefID -> Bool)
-> (RefID -> RefID -> Bool)
-> (RefID -> RefID -> Bool)
-> (RefID -> RefID -> RefID)
-> (RefID -> RefID -> RefID)
-> Ord RefID
RefID -> RefID -> Bool
RefID -> RefID -> Ordering
RefID -> RefID -> RefID
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RefID -> RefID -> Ordering
compare :: RefID -> RefID -> Ordering
$c< :: RefID -> RefID -> Bool
< :: RefID -> RefID -> Bool
$c<= :: RefID -> RefID -> Bool
<= :: RefID -> RefID -> Bool
$c> :: RefID -> RefID -> Bool
> :: RefID -> RefID -> Bool
$c>= :: RefID -> RefID -> Bool
>= :: RefID -> RefID -> Bool
$cmax :: RefID -> RefID -> RefID
max :: RefID -> RefID -> RefID
$cmin :: RefID -> RefID -> RefID
min :: RefID -> RefID -> RefID
Ord, RefID -> RefID -> Bool
(RefID -> RefID -> Bool) -> (RefID -> RefID -> Bool) -> Eq RefID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RefID -> RefID -> Bool
== :: RefID -> RefID -> Bool
$c/= :: RefID -> RefID -> Bool
/= :: RefID -> RefID -> Bool
Eq, RefID
RefID -> RefID -> Bounded RefID
forall a. a -> a -> Bounded a
$cminBound :: RefID
minBound :: RefID
$cmaxBound :: RefID
maxBound :: RefID
Bounded, Int -> RefID
RefID -> Int
RefID -> [RefID]
RefID -> RefID
RefID -> RefID -> [RefID]
RefID -> RefID -> RefID -> [RefID]
(RefID -> RefID)
-> (RefID -> RefID)
-> (Int -> RefID)
-> (RefID -> Int)
-> (RefID -> [RefID])
-> (RefID -> RefID -> [RefID])
-> (RefID -> RefID -> [RefID])
-> (RefID -> RefID -> RefID -> [RefID])
-> Enum RefID
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: RefID -> RefID
succ :: RefID -> RefID
$cpred :: RefID -> RefID
pred :: RefID -> RefID
$ctoEnum :: Int -> RefID
toEnum :: Int -> RefID
$cfromEnum :: RefID -> Int
fromEnum :: RefID -> Int
$cenumFrom :: RefID -> [RefID]
enumFrom :: RefID -> [RefID]
$cenumFromThen :: RefID -> RefID -> [RefID]
enumFromThen :: RefID -> RefID -> [RefID]
$cenumFromTo :: RefID -> RefID -> [RefID]
enumFromTo :: RefID -> RefID -> [RefID]
$cenumFromThenTo :: RefID -> RefID -> RefID -> [RefID]
enumFromThenTo :: RefID -> RefID -> RefID -> [RefID]
Enum)

-- | A value, as using by the interpreter.
data Value m
  = ScalarV !Scalar
  | ListV !(Vector (Value m))
  | DictV !(Map Scalar (Value m))
  | NativeV !(NativeObject m)
  | ProcedureV !(Procedure m)
  | TestV !(Test m)
  | FilterV !(Filter m)
  | MutableRefV !RefID
  deriving (Eq (Value m)
Eq (Value m) =>
(Value m -> Value m -> Ordering)
-> (Value m -> Value m -> Bool)
-> (Value m -> Value m -> Bool)
-> (Value m -> Value m -> Bool)
-> (Value m -> Value m -> Bool)
-> (Value m -> Value m -> Value m)
-> (Value m -> Value m -> Value m)
-> Ord (Value m)
Value m -> Value m -> Bool
Value m -> Value m -> Ordering
Value m -> Value m -> Value m
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (m :: * -> *). Eq (Value m)
forall (m :: * -> *). Value m -> Value m -> Bool
forall (m :: * -> *). Value m -> Value m -> Ordering
forall (m :: * -> *). Value m -> Value m -> Value m
$ccompare :: forall (m :: * -> *). Value m -> Value m -> Ordering
compare :: Value m -> Value m -> Ordering
$c< :: forall (m :: * -> *). Value m -> Value m -> Bool
< :: Value m -> Value m -> Bool
$c<= :: forall (m :: * -> *). Value m -> Value m -> Bool
<= :: Value m -> Value m -> Bool
$c> :: forall (m :: * -> *). Value m -> Value m -> Bool
> :: Value m -> Value m -> Bool
$c>= :: forall (m :: * -> *). Value m -> Value m -> Bool
>= :: Value m -> Value m -> Bool
$cmax :: forall (m :: * -> *). Value m -> Value m -> Value m
max :: Value m -> Value m -> Value m
$cmin :: forall (m :: * -> *). Value m -> Value m -> Value m
min :: Value m -> Value m -> Value m
Ord)

pattern NoneV :: Value m
pattern $mNoneV :: forall {r} {m :: * -> *}.
Value m -> ((# #) -> r) -> ((# #) -> r) -> r
$bNoneV :: forall (m :: * -> *). Value m
NoneV = ScalarV NoneScalar

pattern BoolV :: Bool -> Value m
pattern $mBoolV :: forall {r} {m :: * -> *}.
Value m -> (Bool -> r) -> ((# #) -> r) -> r
$bBoolV :: forall (m :: * -> *). Bool -> Value m
BoolV b = ScalarV (BoolScalar b)

pattern TrueV :: Value m
pattern $mTrueV :: forall {r} {m :: * -> *}.
Value m -> ((# #) -> r) -> ((# #) -> r) -> r
$bTrueV :: forall (m :: * -> *). Value m
TrueV = BoolV True

pattern FalseV :: Value m
pattern $mFalseV :: forall {r} {m :: * -> *}.
Value m -> ((# #) -> r) -> ((# #) -> r) -> r
$bFalseV :: forall (m :: * -> *). Value m
FalseV = BoolV False

pattern StringV :: Text -> Value m
pattern $mStringV :: forall {r} {m :: * -> *}.
Value m -> (Text -> r) -> ((# #) -> r) -> r
$bStringV :: forall (m :: * -> *). Text -> Value m
StringV v = ScalarV (StringScalar v)

pattern EncodedV :: Encoded -> Value m
pattern $mEncodedV :: forall {r} {m :: * -> *}.
Value m -> (Encoded -> r) -> ((# #) -> r) -> r
$bEncodedV :: forall (m :: * -> *). Encoded -> Value m
EncodedV v = ScalarV (EncodedScalar v)

pattern BytesV :: ByteString -> Value m
pattern $mBytesV :: forall {r} {m :: * -> *}.
Value m -> (ByteString -> r) -> ((# #) -> r) -> r
$bBytesV :: forall (m :: * -> *). ByteString -> Value m
BytesV v = ScalarV (BytesScalar v)

pattern IntV :: Integer -> Value m
pattern $mIntV :: forall {r} {m :: * -> *}.
Value m -> (Integer -> r) -> ((# #) -> r) -> r
$bIntV :: forall (m :: * -> *). Integer -> Value m
IntV v = ScalarV (IntScalar v)

pattern FloatV :: Double -> Value m
pattern $mFloatV :: forall {r} {m :: * -> *}.
Value m -> (Double -> r) -> ((# #) -> r) -> r
$bFloatV :: forall (m :: * -> *). Double -> Value m
FloatV v = ScalarV (FloatScalar v)

instance FromJSON (Value m) where
  parseJSON :: Value -> Parser (Value m)
parseJSON v :: Value
v@JSON.Object {} = Map Scalar (Value m) -> Value m
forall (m :: * -> *). Map Scalar (Value m) -> Value m
DictV (Map Scalar (Value m) -> Value m)
-> Parser (Map Scalar (Value m)) -> Parser (Value m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (Map Scalar (Value m))
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
  parseJSON v :: Value
v@JSON.Array {} = Vector (Value m) -> Value m
forall (m :: * -> *). Vector (Value m) -> Value m
ListV (Vector (Value m) -> Value m)
-> Parser (Vector (Value m)) -> Parser (Value m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (Vector (Value m))
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
  parseJSON Value
v = Scalar -> Value m
forall (m :: * -> *). Scalar -> Value m
ScalarV (Scalar -> Value m) -> Parser Scalar -> Parser (Value m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Scalar
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

instance ToJSON (Value m) where
  toJSON :: Value m -> Value
toJSON (ScalarV Scalar
s) = Scalar -> Value
forall a. ToJSON a => a -> Value
toJSON Scalar
s
  toJSON (ListV Vector (Value m)
xs) = Vector (Value m) -> Value
forall a. ToJSON a => a -> Value
toJSON Vector (Value m)
xs
  toJSON (DictV Map Scalar (Value m)
d) = Map Scalar (Value m) -> Value
forall a. ToJSON a => a -> Value
toJSON Map Scalar (Value m)
d
  toJSON Value m
x = String -> Value
forall a. ToJSON a => a -> Value
toJSON (Value m -> String
forall a. Show a => a -> String
show Value m
x)

instance Show (Value m) where
  show :: Value m -> String
show (ScalarV Scalar
s) = Scalar -> String
forall a. Show a => a -> String
show Scalar
s
  show (ListV Vector (Value m)
xs) = String
"ListV " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Vector (Value m) -> String
forall a. Show a => a -> String
show Vector (Value m)
xs
  show (DictV Map Scalar (Value m)
m) = String
"DictV " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [(Scalar, Value m)] -> String
forall a. Show a => a -> String
show (Map Scalar (Value m) -> [(Scalar, Value m)]
forall k a. Map k a -> [(k, a)]
Map.toAscList Map Scalar (Value m)
m)
  show (NativeV {}) = String
"<<native>>"
  show (ProcedureV (NativeProcedure ObjectID
oid Maybe ProcedureDoc
_ [(Maybe Identifier, Value m)]
-> Context m -> SomePRNG -> m (Either RuntimeError (Value m))
_)) = String
"<<procedure:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack (ObjectID -> Text
unObjectID ObjectID
oid) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">>"
  show (ProcedureV {}) = String
"<<procedure>>"
  show (TestV Test m
t) =
    String
"<<test" String -> ShowS
forall a. [a] -> [a] -> [a]
++
      Text -> String
Text.unpack (
        Text -> (ProcedureDoc -> Text) -> Maybe ProcedureDoc -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
""
          ((Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (ProcedureDoc -> Text) -> ProcedureDoc -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcedureDoc -> Text
procedureDocName)
          (Test m -> Maybe ProcedureDoc
forall (m :: * -> *). Test m -> Maybe ProcedureDoc
testDoc Test m
t)
      ) String -> ShowS
forall a. [a] -> [a] -> [a]
++
      String
">>"
  show (FilterV Filter m
f) =
    String
"<<filter" String -> ShowS
forall a. [a] -> [a] -> [a]
++
      Text -> String
Text.unpack (
        Text -> (ProcedureDoc -> Text) -> Maybe ProcedureDoc -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
""
          ((Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (ProcedureDoc -> Text) -> ProcedureDoc -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcedureDoc -> Text
procedureDocName)
          (Filter m -> Maybe ProcedureDoc
forall (m :: * -> *). Filter m -> Maybe ProcedureDoc
filterDoc Filter m
f)
      ) String -> ShowS
forall a. [a] -> [a] -> [a]
++
      String
">>"
  show (MutableRefV RefID
i) = RefID -> String
forall a. Show a => a -> String
show RefID
i

instance Eq (Value m) where
  ScalarV Scalar
a == :: Value m -> Value m -> Bool
== ScalarV Scalar
b = Scalar
a Scalar -> Scalar -> Bool
forall a. Eq a => a -> a -> Bool
== Scalar
b
  ListV Vector (Value m)
a == ListV Vector (Value m)
b = Vector (Value m)
a Vector (Value m) -> Vector (Value m) -> Bool
forall a. Eq a => a -> a -> Bool
== Vector (Value m)
b
  DictV Map Scalar (Value m)
a == DictV Map Scalar (Value m)
b = Map Scalar (Value m)
a Map Scalar (Value m) -> Map Scalar (Value m) -> Bool
forall a. Eq a => a -> a -> Bool
== Map Scalar (Value m)
b
  Value m
_ == Value m
_ = Bool
False

instance PrintfArg (Value m) where
  formatArg :: Value m -> FieldFormatter
formatArg (BoolV Bool
b) = Int -> FieldFormatter
forall a. PrintfArg a => a -> FieldFormatter
formatArg (Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
b)
  formatArg (IntV Integer
i) = Integer -> FieldFormatter
forall a. PrintfArg a => a -> FieldFormatter
formatArg Integer
i
  formatArg (FloatV Double
f) = Double -> FieldFormatter
forall a. PrintfArg a => a -> FieldFormatter
formatArg Double
f
  formatArg (StringV Text
t) = Text -> FieldFormatter
forall a. PrintfArg a => a -> FieldFormatter
formatArg Text
t
  formatArg (EncodedV (Encoded Text
t)) = Text -> FieldFormatter
forall a. PrintfArg a => a -> FieldFormatter
formatArg Text
t
  formatArg ScalarV {} = String -> FieldFormatter
forall a. PrintfArg a => a -> FieldFormatter
formatArg (String
"" :: String)
  formatArg (ListV Vector (Value m)
xs) = \FieldFormat
fmt String
x -> (Value m -> ShowS) -> String -> Vector (Value m) -> String
forall a b. (a -> b -> b) -> b -> Vector a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Value m -> FieldFormatter) -> FieldFormat -> Value m -> ShowS
forall a b c. (a -> b -> c) -> b -> a -> c
flip Value m -> FieldFormatter
forall a. PrintfArg a => a -> FieldFormatter
formatArg FieldFormat
fmt) String
x Vector (Value m)
xs
  formatArg (DictV Map Scalar (Value m)
xs) = Value m -> FieldFormatter
forall a. PrintfArg a => a -> FieldFormatter
formatArg (Value m -> FieldFormatter)
-> (Map Scalar (Value m) -> Value m)
-> Map Scalar (Value m)
-> FieldFormatter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (Value m) -> Value m
forall (m :: * -> *). Vector (Value m) -> Value m
ListV (Vector (Value m) -> Value m)
-> (Map Scalar (Value m) -> Vector (Value m))
-> Map Scalar (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] -> Vector (Value m))
-> (Map Scalar (Value m) -> [Value m])
-> Map Scalar (Value m)
-> Vector (Value m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Scalar (Value m) -> [Value m]
forall k a. Map k a -> [a]
Map.elems (Map Scalar (Value m) -> FieldFormatter)
-> Map Scalar (Value m) -> FieldFormatter
forall a b. (a -> b) -> a -> b
$ Map Scalar (Value m)
xs
  formatArg (NativeV {}) = String -> FieldFormatter
forall a. PrintfArg a => a -> FieldFormatter
formatArg (String
"[[object]]" :: String)
  formatArg (ProcedureV {}) = String -> FieldFormatter
forall a. PrintfArg a => a -> FieldFormatter
formatArg (String
"[[procedure]]" :: String)
  formatArg (FilterV {}) = String -> FieldFormatter
forall a. PrintfArg a => a -> FieldFormatter
formatArg (String
"[[filter]]" :: String)
  formatArg (TestV {}) = String -> FieldFormatter
forall a. PrintfArg a => a -> FieldFormatter
formatArg (String
"[[test]]" :: String)
  formatArg (MutableRefV {}) = String -> FieldFormatter
forall a. PrintfArg a => a -> FieldFormatter
formatArg (String
"[[ref]]" :: String)

tagNameOf :: Value m -> Text
tagNameOf :: forall (m :: * -> *). Value m -> Text
tagNameOf ScalarV {} = Text
"scalar"
tagNameOf ListV {} = Text
"list"
tagNameOf DictV {} = Text
"dict"
tagNameOf NativeV {} = Text
"native"
tagNameOf ProcedureV {} = Text
"procedure"
tagNameOf TestV {} = Text
"test"
tagNameOf FilterV {} = Text
"filter"
tagNameOf MutableRefV {} = Text
"mutref"

traverseValue :: Monoid a => (Value m -> a) -> Value m -> a
traverseValue :: forall a (m :: * -> *). Monoid a => (Value m -> a) -> Value m -> a
traverseValue Value m -> a
p v :: Value m
v@(ListV Vector (Value m)
xs) =
  Value m -> a
p Value m
v a -> a -> a
forall a. Semigroup a => a -> a -> a
<> Vector a -> a
forall m. Monoid m => Vector m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ((Value m -> a) -> Vector (Value m) -> Vector a
forall a b. (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Value m -> a) -> Value m -> a
forall a (m :: * -> *). Monoid a => (Value m -> a) -> Value m -> a
traverseValue Value m -> a
p) Vector (Value m)
xs)
traverseValue Value m -> a
p v :: Value m
v@(DictV Map Scalar (Value m)
m) =
  Value m -> a
p Value m
v a -> a -> a
forall a. Semigroup a => a -> a -> a
<> [a] -> a
forall a. Monoid a => [a] -> a
mconcat (((Scalar, Value m) -> a) -> [(Scalar, Value m)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map ((Value m -> a) -> Value m -> a
forall a (m :: * -> *). Monoid a => (Value m -> a) -> Value m -> a
traverseValue Value m -> a
p (Value m -> a)
-> ((Scalar, Value m) -> Value m) -> (Scalar, Value m) -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Scalar, Value m) -> Value m
forall a b. (a, b) -> b
snd) ([(Scalar, Value m)] -> [a]) -> [(Scalar, Value m)] -> [a]
forall a b. (a -> b) -> a -> b
$ Map Scalar (Value m) -> [(Scalar, Value m)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Scalar (Value m)
m)
traverseValue Value m -> a
p Value m
v = Value m -> a
p Value m
v

newtype ObjectID = ObjectID { ObjectID -> Text
unObjectID :: Text }
  deriving (ObjectID -> ObjectID -> Bool
(ObjectID -> ObjectID -> Bool)
-> (ObjectID -> ObjectID -> Bool) -> Eq ObjectID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ObjectID -> ObjectID -> Bool
== :: ObjectID -> ObjectID -> Bool
$c/= :: ObjectID -> ObjectID -> Bool
/= :: ObjectID -> ObjectID -> Bool
Eq, Eq ObjectID
Eq ObjectID =>
(ObjectID -> ObjectID -> Ordering)
-> (ObjectID -> ObjectID -> Bool)
-> (ObjectID -> ObjectID -> Bool)
-> (ObjectID -> ObjectID -> Bool)
-> (ObjectID -> ObjectID -> Bool)
-> (ObjectID -> ObjectID -> ObjectID)
-> (ObjectID -> ObjectID -> ObjectID)
-> Ord ObjectID
ObjectID -> ObjectID -> Bool
ObjectID -> ObjectID -> Ordering
ObjectID -> ObjectID -> ObjectID
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ObjectID -> ObjectID -> Ordering
compare :: ObjectID -> ObjectID -> Ordering
$c< :: ObjectID -> ObjectID -> Bool
< :: ObjectID -> ObjectID -> Bool
$c<= :: ObjectID -> ObjectID -> Bool
<= :: ObjectID -> ObjectID -> Bool
$c> :: ObjectID -> ObjectID -> Bool
> :: ObjectID -> ObjectID -> Bool
$c>= :: ObjectID -> ObjectID -> Bool
>= :: ObjectID -> ObjectID -> Bool
$cmax :: ObjectID -> ObjectID -> ObjectID
max :: ObjectID -> ObjectID -> ObjectID
$cmin :: ObjectID -> ObjectID -> ObjectID
min :: ObjectID -> ObjectID -> ObjectID
Ord)

instance IsString ObjectID where
  fromString :: String -> ObjectID
fromString = Text -> ObjectID
ObjectID (Text -> ObjectID) -> (String -> Text) -> String -> ObjectID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack

data TypeDoc
  = TypeDocNone
  | TypeDocAny
  | TypeDocSingle !Text
  | TypeDocAlternatives !(Vector Text)
  deriving (Int -> TypeDoc -> ShowS
[TypeDoc] -> ShowS
TypeDoc -> String
(Int -> TypeDoc -> ShowS)
-> (TypeDoc -> String) -> ([TypeDoc] -> ShowS) -> Show TypeDoc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TypeDoc -> ShowS
showsPrec :: Int -> TypeDoc -> ShowS
$cshow :: TypeDoc -> String
show :: TypeDoc -> String
$cshowList :: [TypeDoc] -> ShowS
showList :: [TypeDoc] -> ShowS
Show, TypeDoc -> TypeDoc -> Bool
(TypeDoc -> TypeDoc -> Bool)
-> (TypeDoc -> TypeDoc -> Bool) -> Eq TypeDoc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TypeDoc -> TypeDoc -> Bool
== :: TypeDoc -> TypeDoc -> Bool
$c/= :: TypeDoc -> TypeDoc -> Bool
/= :: TypeDoc -> TypeDoc -> Bool
Eq)

instance ToValue TypeDoc m where
  toValue :: TypeDoc -> Value m
toValue TypeDoc
TypeDocNone = Text -> Value m
forall (m :: * -> *). Text -> Value m
StringV Text
"none"
  toValue TypeDoc
TypeDocAny = Text -> Value m
forall (m :: * -> *). Text -> Value m
StringV Text
"any"
  toValue (TypeDocSingle Text
t) = Text -> Value m
forall (m :: * -> *). Text -> Value m
StringV Text
t
  toValue (TypeDocAlternatives Vector Text
xs) =
    [(Scalar, Value m)] -> Value m
forall (m :: * -> *). [(Scalar, Value m)] -> Value m
dictV [Scalar
"oneof" Scalar -> Vector Text -> (Scalar, Value m)
forall v (m :: * -> *).
ToValue v m =>
Scalar -> v -> (Scalar, Value m)
.= Vector Text
xs]

data ArgumentDoc =
  ArgumentDoc
    { ArgumentDoc -> Text
argumentDocName :: !Text
    , ArgumentDoc -> Maybe TypeDoc
argumentDocType :: !(Maybe TypeDoc)
    , ArgumentDoc -> Maybe Text
argumentDocDefault :: !(Maybe Text)
    , ArgumentDoc -> Text
argumentDocDescription :: !Text
    }
    deriving (Int -> ArgumentDoc -> ShowS
[ArgumentDoc] -> ShowS
ArgumentDoc -> String
(Int -> ArgumentDoc -> ShowS)
-> (ArgumentDoc -> String)
-> ([ArgumentDoc] -> ShowS)
-> Show ArgumentDoc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ArgumentDoc -> ShowS
showsPrec :: Int -> ArgumentDoc -> ShowS
$cshow :: ArgumentDoc -> String
show :: ArgumentDoc -> String
$cshowList :: [ArgumentDoc] -> ShowS
showList :: [ArgumentDoc] -> ShowS
Show, ArgumentDoc -> ArgumentDoc -> Bool
(ArgumentDoc -> ArgumentDoc -> Bool)
-> (ArgumentDoc -> ArgumentDoc -> Bool) -> Eq ArgumentDoc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ArgumentDoc -> ArgumentDoc -> Bool
== :: ArgumentDoc -> ArgumentDoc -> Bool
$c/= :: ArgumentDoc -> ArgumentDoc -> Bool
/= :: ArgumentDoc -> ArgumentDoc -> Bool
Eq)

instance ToValue ArgumentDoc m where
  toValue :: ArgumentDoc -> Value m
toValue ArgumentDoc
a =
    [(Scalar, Value m)] -> Value m
forall (m :: * -> *). [(Scalar, Value m)] -> Value m
dictV
      [ Scalar
"name" Scalar -> Text -> (Scalar, Value m)
forall v (m :: * -> *).
ToValue v m =>
Scalar -> v -> (Scalar, Value m)
.= ArgumentDoc -> Text
argumentDocName ArgumentDoc
a
      , Scalar
"type" Scalar -> Maybe TypeDoc -> (Scalar, Value m)
forall v (m :: * -> *).
ToValue v m =>
Scalar -> v -> (Scalar, Value m)
.= ArgumentDoc -> Maybe TypeDoc
argumentDocType ArgumentDoc
a
      , Scalar
"default" Scalar -> Maybe Text -> (Scalar, Value m)
forall v (m :: * -> *).
ToValue v m =>
Scalar -> v -> (Scalar, Value m)
.= ArgumentDoc -> Maybe Text
argumentDocDefault ArgumentDoc
a
      , Scalar
"description" Scalar -> Text -> (Scalar, Value m)
forall v (m :: * -> *).
ToValue v m =>
Scalar -> v -> (Scalar, Value m)
.= ArgumentDoc -> Text
argumentDocDescription ArgumentDoc
a
      ]

data ProcedureDoc =
  ProcedureDoc
    { ProcedureDoc -> Text
procedureDocName :: !Text
    , ProcedureDoc -> Vector ArgumentDoc
procedureDocArgs :: !(Vector ArgumentDoc)
    , ProcedureDoc -> Maybe TypeDoc
procedureDocReturnType :: !(Maybe TypeDoc)
    , ProcedureDoc -> Text
procedureDocDescription :: !Text
    }
    deriving (Int -> ProcedureDoc -> ShowS
[ProcedureDoc] -> ShowS
ProcedureDoc -> String
(Int -> ProcedureDoc -> ShowS)
-> (ProcedureDoc -> String)
-> ([ProcedureDoc] -> ShowS)
-> Show ProcedureDoc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProcedureDoc -> ShowS
showsPrec :: Int -> ProcedureDoc -> ShowS
$cshow :: ProcedureDoc -> String
show :: ProcedureDoc -> String
$cshowList :: [ProcedureDoc] -> ShowS
showList :: [ProcedureDoc] -> ShowS
Show, ProcedureDoc -> ProcedureDoc -> Bool
(ProcedureDoc -> ProcedureDoc -> Bool)
-> (ProcedureDoc -> ProcedureDoc -> Bool) -> Eq ProcedureDoc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProcedureDoc -> ProcedureDoc -> Bool
== :: ProcedureDoc -> ProcedureDoc -> Bool
$c/= :: ProcedureDoc -> ProcedureDoc -> Bool
/= :: ProcedureDoc -> ProcedureDoc -> Bool
Eq)

instance Ord ProcedureDoc where
  compare :: ProcedureDoc -> ProcedureDoc -> Ordering
compare = (ProcedureDoc -> Text) -> ProcedureDoc -> ProcedureDoc -> Ordering
forall b a. Ord b => (a -> b) -> a -> a -> Ordering
compareBy ProcedureDoc -> Text
procedureDocName

instance ToValue ProcedureDoc m where
  toValue :: ProcedureDoc -> Value m
toValue ProcedureDoc
d =
    [(Scalar, Value m)] -> Value m
forall (m :: * -> *). [(Scalar, Value m)] -> Value m
dictV
      [ Scalar
"name" Scalar -> Text -> (Scalar, Value m)
forall v (m :: * -> *).
ToValue v m =>
Scalar -> v -> (Scalar, Value m)
.= ProcedureDoc -> Text
procedureDocName ProcedureDoc
d
      , Scalar
"args" Scalar -> Vector ArgumentDoc -> (Scalar, Value m)
forall v (m :: * -> *).
ToValue v m =>
Scalar -> v -> (Scalar, Value m)
.= ProcedureDoc -> Vector ArgumentDoc
procedureDocArgs ProcedureDoc
d
      , Scalar
"returnType" Scalar -> Maybe TypeDoc -> (Scalar, Value m)
forall v (m :: * -> *).
ToValue v m =>
Scalar -> v -> (Scalar, Value m)
.= ProcedureDoc -> Maybe TypeDoc
procedureDocReturnType ProcedureDoc
d
      , Scalar
"description" Scalar -> Text -> (Scalar, Value m)
forall v (m :: * -> *).
ToValue v m =>
Scalar -> v -> (Scalar, Value m)
.= ProcedureDoc -> Text
procedureDocDescription ProcedureDoc
d
      ]

data Procedure m
  = NativeProcedure
        !ObjectID
        !(Maybe ProcedureDoc)
        !( [(Maybe Identifier, Value m)]
            -> Context m
            -> SomePRNG
            -> m (Either RuntimeError (Value m))
         )
  | GingerProcedure !(Env m) ![(Identifier, Maybe (Value m))] !Expr
  | NamespaceProcedure

namespaceProcedureDoc :: ProcedureDoc
namespaceProcedureDoc :: ProcedureDoc
namespaceProcedureDoc =
  ProcedureDoc
    { procedureDocName :: Text
procedureDocName = Text
"namespace"
    , 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
"namespace"
    , procedureDocDescription :: Text
procedureDocDescription = [Text] -> Text
Text.unlines
        [ Text
"Create a namespace object."
        , Text
"Namespace objects are mutable dictionary-like objects; the main " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
          Text
"use case for these is to work around the fact that `{% for %}` " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
          Text
"loops, macros, and other constructs establish local scopes, " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
          Text
"which means that any `{% set %}` invocations inside those will " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
          Text
"not propagate to the containing scope."
        , Text
""
        , Text
"Using a namespace object, this problem can be solved like in this example:"
        , Text
""
        , Text
"```"
        , Text
"{% set ns = namespace() %}"
        , Text
"{% for x in items %}"
        , Text
"  {{ x.bar }}"
        , Text
"  {% set ns.foo = x.foo %}"
        , Text
"{% endfor %}"
        , Text
"{{ ns.foo }}"
        , Text
"```"
        ]
    }

instance Ord (Procedure m) where
  compare :: Procedure m -> Procedure m -> Ordering
compare Procedure m
NamespaceProcedure Procedure m
NamespaceProcedure = Ordering
EQ
  compare Procedure m
NamespaceProcedure Procedure m
_ = Ordering
GT
  compare Procedure m
_ Procedure m
NamespaceProcedure = Ordering
LT
  compare (GingerProcedure Env m
e1 [(Identifier, Maybe (Value m))]
args1 Expr
body1) (GingerProcedure Env m
e2 [(Identifier, Maybe (Value m))]
args2 Expr
body2) =
    (Env m, [(Identifier, Maybe (Value m))], Expr)
-> (Env m, [(Identifier, Maybe (Value m))], Expr) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Env m
e1, [(Identifier, Maybe (Value m))]
args1, Expr
body1) (Env m
e2, [(Identifier, Maybe (Value m))]
args2, Expr
body2)
  compare GingerProcedure {} Procedure m
_ = Ordering
GT
  compare Procedure m
_ GingerProcedure {} = Ordering
LT
  compare (NativeProcedure ObjectID
oid1 Maybe ProcedureDoc
_ [(Maybe Identifier, Value m)]
-> Context m -> SomePRNG -> m (Either RuntimeError (Value m))
_) (NativeProcedure ObjectID
oid2 Maybe ProcedureDoc
_ [(Maybe Identifier, Value m)]
-> Context m -> SomePRNG -> m (Either RuntimeError (Value m))
_) =
    ObjectID -> ObjectID -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ObjectID
oid1 ObjectID
oid2

instance Eq (Procedure m) where
  NativeProcedure ObjectID
a Maybe ProcedureDoc
_ [(Maybe Identifier, Value m)]
-> Context m -> SomePRNG -> m (Either RuntimeError (Value m))
_ == :: Procedure m -> Procedure m -> Bool
== NativeProcedure ObjectID
b Maybe ProcedureDoc
_ [(Maybe Identifier, Value m)]
-> Context m -> SomePRNG -> m (Either RuntimeError (Value m))
_ =
    ObjectID
a ObjectID -> ObjectID -> Bool
forall a. Eq a => a -> a -> Bool
== ObjectID
b
  GingerProcedure Env m
env1 [(Identifier, Maybe (Value m))]
argspec1 Expr
body1 == GingerProcedure Env m
env2 [(Identifier, Maybe (Value m))]
argspec2 Expr
body2 =
    (Env m
env1, [(Identifier, Maybe (Value m))]
argspec1, Expr
body1) (Env m, [(Identifier, Maybe (Value m))], Expr)
-> (Env m, [(Identifier, Maybe (Value m))], Expr) -> Bool
forall a. Eq a => a -> a -> Bool
== (Env m
env2, [(Identifier, Maybe (Value m))]
argspec2, Expr
body2)
  Procedure m
NamespaceProcedure == Procedure m
NamespaceProcedure = Bool
True
  Procedure m
_ == Procedure m
_ = Bool
False

pureNativeProcedure :: Applicative m
                    => ObjectID
                    -> Maybe ProcedureDoc
                    -> ([(Maybe Identifier, Value m)] -> Either RuntimeError (Value m))
                    -> Procedure m
pureNativeProcedure :: forall (m :: * -> *).
Applicative m =>
ObjectID
-> Maybe ProcedureDoc
-> ([(Maybe Identifier, Value m)] -> Either RuntimeError (Value m))
-> Procedure m
pureNativeProcedure ObjectID
oid Maybe ProcedureDoc
doc [(Maybe Identifier, Value m)] -> Either RuntimeError (Value m)
f =
  ObjectID
-> Maybe ProcedureDoc
-> ([(Maybe Identifier, Value m)]
    -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
-> Procedure m
forall (m :: * -> *).
ObjectID
-> Maybe ProcedureDoc
-> ([(Maybe Identifier, Value m)]
    -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
-> Procedure m
NativeProcedure ObjectID
oid Maybe ProcedureDoc
doc (([(Maybe Identifier, Value m)]
  -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
 -> Procedure m)
-> ([(Maybe Identifier, Value m)]
    -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
-> Procedure m
forall a b. (a -> b) -> a -> b
$ \[(Maybe Identifier, Value m)]
args Context m
_ SomePRNG
_ -> Either RuntimeError (Value m) -> m (Either RuntimeError (Value m))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Maybe Identifier, Value m)] -> Either RuntimeError (Value m)
f [(Maybe Identifier, Value m)]
args)

nativeFunc :: (Monad m)
           => ObjectID
           -> Maybe ProcedureDoc
           -> (Value m -> m (Either RuntimeError (Value m)))
           -> Procedure m
nativeFunc :: forall (m :: * -> *).
Monad m =>
ObjectID
-> Maybe ProcedureDoc
-> (Value m -> m (Either RuntimeError (Value m)))
-> Procedure m
nativeFunc ObjectID
oid Maybe ProcedureDoc
doc Value m -> m (Either RuntimeError (Value m))
f =
  ObjectID
-> Maybe ProcedureDoc
-> ([(Maybe Identifier, Value m)]
    -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
-> Procedure m
forall (m :: * -> *).
ObjectID
-> Maybe ProcedureDoc
-> ([(Maybe Identifier, Value m)]
    -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
-> Procedure m
NativeProcedure ObjectID
oid Maybe ProcedureDoc
doc (([(Maybe Identifier, Value m)]
  -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
 -> Procedure m)
-> ([(Maybe Identifier, Value m)]
    -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
-> Procedure m
forall a b. (a -> b) -> a -> b
$ \[(Maybe Identifier, Value m)]
args Context m
_ SomePRNG
_ -> case [(Maybe Identifier, Value m)]
args of
    [] ->
      Either RuntimeError (Value m) -> m (Either RuntimeError (Value m))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError (Value m)
 -> m (Either RuntimeError (Value m)))
-> (RuntimeError -> Either RuntimeError (Value m))
-> RuntimeError
-> m (Either RuntimeError (Value m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuntimeError -> Either RuntimeError (Value m)
forall a b. a -> Either a b
Left (RuntimeError -> m (Either RuntimeError (Value m)))
-> RuntimeError -> m (Either RuntimeError (Value m))
forall a b. (a -> b) -> a -> b
$
        Text -> Text -> Text -> Text -> RuntimeError
ArgumentError
          Text
"<native function>"
          Text
"<positional argument>"
          Text
"value"
          Text
"end of arguments"
    [(Maybe Identifier
_, Value m
x)] ->
      Value m -> m (Either RuntimeError (Value m))
f Value m
x
    ((Maybe Identifier, Value m)
_:(Maybe Identifier
name, Value m
x):[(Maybe Identifier, Value m)]
_) ->
      Either RuntimeError (Value m) -> m (Either RuntimeError (Value m))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError (Value m)
 -> m (Either RuntimeError (Value m)))
-> (RuntimeError -> Either RuntimeError (Value m))
-> RuntimeError
-> m (Either RuntimeError (Value m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuntimeError -> Either RuntimeError (Value m)
forall a b. a -> Either a b
Left (RuntimeError -> m (Either RuntimeError (Value m)))
-> RuntimeError -> m (Either RuntimeError (Value m))
forall a b. (a -> b) -> a -> b
$
        Text -> Text -> Text -> Text -> RuntimeError
ArgumentError
          Text
"<native function>"
          (Text -> (Identifier -> Text) -> Maybe Identifier -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"<positional argument>" Identifier -> Text
identifierName (Maybe Identifier -> Text) -> Maybe Identifier -> Text
forall a b. (a -> b) -> a -> b
$ Maybe Identifier
name)
          Text
"end of arguments"
          (Value m -> Text
forall (m :: * -> *). Value m -> Text
tagNameOf (Value m -> Text) -> Value m -> Text
forall a b. (a -> b) -> a -> b
$ Value m
x)

pureNativeFunc :: (Applicative m)
               => ObjectID
               -> Maybe ProcedureDoc
               -> (Value m -> Either RuntimeError (Value m))
               -> Procedure m
pureNativeFunc :: forall (m :: * -> *).
Applicative m =>
ObjectID
-> Maybe ProcedureDoc
-> (Value m -> Either RuntimeError (Value m))
-> Procedure m
pureNativeFunc ObjectID
oid Maybe ProcedureDoc
doc Value m -> Either RuntimeError (Value m)
f =
  ObjectID
-> Maybe ProcedureDoc
-> ([(Maybe Identifier, Value m)]
    -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
-> Procedure m
forall (m :: * -> *).
ObjectID
-> Maybe ProcedureDoc
-> ([(Maybe Identifier, Value m)]
    -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
-> Procedure m
NativeProcedure ObjectID
oid Maybe ProcedureDoc
doc (([(Maybe Identifier, Value m)]
  -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
 -> Procedure m)
-> ([(Maybe Identifier, Value m)]
    -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
-> Procedure m
forall a b. (a -> b) -> a -> b
$ \[(Maybe Identifier, Value m)]
args Context m
_ SomePRNG
_ -> case [(Maybe Identifier, Value m)]
args of
    [] ->
      Either RuntimeError (Value m) -> m (Either RuntimeError (Value m))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError (Value m)
 -> m (Either RuntimeError (Value m)))
-> (RuntimeError -> Either RuntimeError (Value m))
-> RuntimeError
-> m (Either RuntimeError (Value m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuntimeError -> Either RuntimeError (Value m)
forall a b. a -> Either a b
Left (RuntimeError -> m (Either RuntimeError (Value m)))
-> RuntimeError -> m (Either RuntimeError (Value m))
forall a b. (a -> b) -> a -> b
$
        Text -> Text -> Text -> Text -> RuntimeError
ArgumentError
          Text
"<native function>"
          Text
"<positional argument>"
          Text
"value"
          Text
"end of arguments"
    [(Maybe Identifier
_, Value m
x)] ->
      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
$ Value m -> Either RuntimeError (Value m)
f Value m
x
    ((Maybe Identifier, Value m)
_:(Maybe Identifier
name, Value m
x):[(Maybe Identifier, Value m)]
_) ->
      Either RuntimeError (Value m) -> m (Either RuntimeError (Value m))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError (Value m)
 -> m (Either RuntimeError (Value m)))
-> (RuntimeError -> Either RuntimeError (Value m))
-> RuntimeError
-> m (Either RuntimeError (Value m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuntimeError -> Either RuntimeError (Value m)
forall a b. a -> Either a b
Left (RuntimeError -> m (Either RuntimeError (Value m)))
-> RuntimeError -> m (Either RuntimeError (Value m))
forall a b. (a -> b) -> a -> b
$
        Text -> Text -> Text -> Text -> RuntimeError
ArgumentError
          Text
"<native function>"
          (Text -> (Identifier -> Text) -> Maybe Identifier -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"<positional argument>" Identifier -> Text
identifierName (Maybe Identifier -> Text) -> Maybe Identifier -> Text
forall a b. (a -> b) -> a -> b
$ Maybe Identifier
name)
          Text
"end of arguments"
          (Value m -> Text
forall (m :: * -> *). Value m -> Text
tagNameOf (Value m -> Text) -> Value m -> Text
forall a b. (a -> b) -> a -> b
$ Value m
x)

pureNativeFunc2 :: (Applicative m)
               => ObjectID
               -> Maybe ProcedureDoc
               -> (Value m -> Value m -> Either RuntimeError (Value m))
               -> Procedure m
pureNativeFunc2 :: forall (m :: * -> *).
Applicative m =>
ObjectID
-> Maybe ProcedureDoc
-> (Value m -> Value m -> Either RuntimeError (Value m))
-> Procedure m
pureNativeFunc2 ObjectID
oid Maybe ProcedureDoc
doc Value m -> Value m -> Either RuntimeError (Value m)
f =
  ObjectID
-> Maybe ProcedureDoc
-> ([(Maybe Identifier, Value m)]
    -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
-> Procedure m
forall (m :: * -> *).
ObjectID
-> Maybe ProcedureDoc
-> ([(Maybe Identifier, Value m)]
    -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
-> Procedure m
NativeProcedure ObjectID
oid Maybe ProcedureDoc
doc (([(Maybe Identifier, Value m)]
  -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
 -> Procedure m)
-> ([(Maybe Identifier, Value m)]
    -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
-> Procedure m
forall a b. (a -> b) -> a -> b
$ \[(Maybe Identifier, Value m)]
args Context m
_ SomePRNG
_ -> case [(Maybe Identifier, Value m)]
args of
    [] ->
      Either RuntimeError (Value m) -> m (Either RuntimeError (Value m))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError (Value m)
 -> m (Either RuntimeError (Value m)))
-> (RuntimeError -> Either RuntimeError (Value m))
-> RuntimeError
-> m (Either RuntimeError (Value m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuntimeError -> Either RuntimeError (Value m)
forall a b. a -> Either a b
Left (RuntimeError -> m (Either RuntimeError (Value m)))
-> RuntimeError -> m (Either RuntimeError (Value m))
forall a b. (a -> b) -> a -> b
$
        Text -> Text -> Text -> Text -> RuntimeError
ArgumentError
          Text
"<native function>"
          Text
"<positional argument>"
          Text
"value"
          Text
"end of arguments"
    [(Maybe Identifier, Value m)
_] ->
      Either RuntimeError (Value m) -> m (Either RuntimeError (Value m))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError (Value m)
 -> m (Either RuntimeError (Value m)))
-> (RuntimeError -> Either RuntimeError (Value m))
-> RuntimeError
-> m (Either RuntimeError (Value m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuntimeError -> Either RuntimeError (Value m)
forall a b. a -> Either a b
Left (RuntimeError -> m (Either RuntimeError (Value m)))
-> RuntimeError -> m (Either RuntimeError (Value m))
forall a b. (a -> b) -> a -> b
$
        Text -> Text -> Text -> Text -> RuntimeError
ArgumentError
          Text
"<native function>"
          Text
"<positional argument>"
          Text
"value"
          Text
"end of arguments"
    [(Maybe Identifier
_, Value m
x), (Maybe Identifier
_, Value m
y)] ->
      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
$ Value m -> Value m -> Either RuntimeError (Value m)
f Value m
x Value m
y
    ((Maybe Identifier, Value m)
_:(Maybe Identifier, Value m)
_:(Maybe Identifier
name, Value m
x):[(Maybe Identifier, Value m)]
_) ->
      Either RuntimeError (Value m) -> m (Either RuntimeError (Value m))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError (Value m)
 -> m (Either RuntimeError (Value m)))
-> (RuntimeError -> Either RuntimeError (Value m))
-> RuntimeError
-> m (Either RuntimeError (Value m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuntimeError -> Either RuntimeError (Value m)
forall a b. a -> Either a b
Left (RuntimeError -> m (Either RuntimeError (Value m)))
-> RuntimeError -> m (Either RuntimeError (Value m))
forall a b. (a -> b) -> a -> b
$
        Text -> Text -> Text -> Text -> RuntimeError
ArgumentError
          Text
"<native function>"
          (Text -> (Identifier -> Text) -> Maybe Identifier -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"<positional argument>" Identifier -> Text
identifierName (Maybe Identifier -> Text) -> Maybe Identifier -> Text
forall a b. (a -> b) -> a -> b
$ Maybe Identifier
name)
          Text
"end of arguments"
          (Value m -> Text
forall (m :: * -> *). Value m -> Text
tagNameOf (Value m -> Text) -> Value m -> Text
forall a b. (a -> b) -> a -> b
$ Value m
x)

type MetaFunc m a =
     Expr
  -> [(Maybe Identifier, Value m)]
  -> Context m
  -> Env m
  -> SomePRNG
  -> m (Either RuntimeError a)

type TestFunc m = MetaFunc m Bool

type FilterFunc m = MetaFunc m (Value m)

data Test m =
  NativeTest  
    { forall (m :: * -> *). Test m -> Maybe ProcedureDoc
testDoc :: !(Maybe ProcedureDoc)
    , forall (m :: * -> *). Test m -> TestFunc m
runTest :: !(TestFunc m)
    }

instance Eq (Test m) where
  Test m
a == :: Test m -> Test m -> Bool
== Test m
b = Test m -> Test m -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Test m
a Test m
b Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ

instance Ord (Test m) where
  compare :: Test m -> Test m -> Ordering
compare = (Test m -> Maybe ProcedureDoc) -> Test m -> Test m -> Ordering
forall b a. Ord b => (a -> b) -> a -> a -> Ordering
compareBy Test m -> Maybe ProcedureDoc
forall (m :: * -> *). Test m -> Maybe ProcedureDoc
testDoc

data Filter m =
  NativeFilter
    { forall (m :: * -> *). Filter m -> Maybe ProcedureDoc
filterDoc :: !(Maybe ProcedureDoc)
    , forall (m :: * -> *). Filter m -> FilterFunc m
runFilter :: !(FilterFunc m)
    }

instance Ord (Filter m) where
  compare :: Filter m -> Filter m -> Ordering
compare = (Filter m -> Maybe ProcedureDoc)
-> Filter m -> Filter m -> Ordering
forall b a. Ord b => (a -> b) -> a -> a -> Ordering
compareBy Filter m -> Maybe ProcedureDoc
forall (m :: * -> *). Filter m -> Maybe ProcedureDoc
filterDoc

instance Eq (Filter m) where
  Filter m
a == :: Filter m -> Filter m -> Bool
== Filter m
b = Filter m -> Filter m -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Filter m
a Filter m
b Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ

data NativeObject m =
  NativeObject
    { forall (m :: * -> *). NativeObject m -> ObjectID
nativeObjectID :: ObjectID
    , forall (m :: * -> *). NativeObject m -> m [Scalar]
nativeObjectGetFieldNames :: m [Scalar]
    , forall (m :: * -> *).
NativeObject m -> Scalar -> m (Maybe (Value m))
nativeObjectGetField :: Scalar -> m (Maybe (Value m))
    , forall (m :: * -> *).
NativeObject m -> Identifier -> m (Maybe (Value m))
nativeObjectGetAttribute :: Identifier -> m (Maybe (Value m))
    , forall (m :: * -> *). NativeObject m -> m Text
nativeObjectStringified :: m Text
    , forall (m :: * -> *). NativeObject m -> Context m -> m Encoded
nativeObjectEncoded :: Context m -> m Encoded
    , forall (m :: * -> *).
NativeObject m -> m (Maybe (Vector (Value m)))
nativeObjectAsList :: m (Maybe (Vector (Value m)))
    , forall (m :: * -> *).
NativeObject m
-> Maybe
     (NativeObject m
      -> [(Maybe Identifier, Value m)]
      -> m (Either RuntimeError (Value m)))
nativeObjectCall :: Maybe
                            (NativeObject m
                              -> [(Maybe Identifier, Value m)]
                              -> m (Either RuntimeError (Value m))
                            )
    , forall (m :: * -> *).
NativeObject m
-> NativeObject m -> NativeObject m -> m (Either RuntimeError Bool)
nativeObjectEq :: NativeObject m
                     -> NativeObject m
                     -> m (Either RuntimeError Bool)
    }

instance Eq (NativeObject m) where
  NativeObject m
a == :: NativeObject m -> NativeObject m -> Bool
== NativeObject m
b = NativeObject m -> NativeObject m -> Ordering
forall a. Ord a => a -> a -> Ordering
compare NativeObject m
a NativeObject m
b Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ

instance Ord (NativeObject m) where
  compare :: NativeObject m -> NativeObject m -> Ordering
compare = (NativeObject m -> ObjectID)
-> NativeObject m -> NativeObject m -> Ordering
forall b a. Ord b => (a -> b) -> a -> a -> Ordering
compareBy NativeObject m -> ObjectID
forall (m :: * -> *). NativeObject m -> ObjectID
nativeObjectID

compareBy :: Ord b => (a -> b) -> a -> a -> Ordering
compareBy :: forall b a. Ord b => (a -> b) -> a -> a -> Ordering
compareBy a -> b
f a
a a
b = b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (a -> b
f a
a) (a -> b
f a
b)

nativeObjectAsDict :: Monad m
                   => NativeObject m
                   -> m (Maybe (Map Scalar (Value m)))
nativeObjectAsDict :: forall (m :: * -> *).
Monad m =>
NativeObject m -> m (Maybe (Map Scalar (Value m)))
nativeObjectAsDict NativeObject m
o = do
  [Scalar]
fieldNames <- NativeObject m -> m [Scalar]
forall (m :: * -> *). NativeObject m -> m [Scalar]
nativeObjectGetFieldNames NativeObject m
o
  case [Scalar]
fieldNames of
    [] -> Maybe (Map Scalar (Value m)) -> m (Maybe (Map Scalar (Value m)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Map Scalar (Value m))
forall a. Maybe a
Nothing
    [Scalar]
keys -> do
      [(Scalar, Value m)]
pairs <- (Scalar -> m (Scalar, Value m))
-> [Scalar] -> m [(Scalar, Value m)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Scalar -> m (Scalar, Value m)
makePair [Scalar]
keys
      Maybe (Map Scalar (Value m)) -> m (Maybe (Map Scalar (Value m)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Map Scalar (Value m)) -> m (Maybe (Map Scalar (Value m))))
-> (Map Scalar (Value m) -> Maybe (Map Scalar (Value m)))
-> Map Scalar (Value m)
-> m (Maybe (Map Scalar (Value m)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Scalar (Value m) -> Maybe (Map Scalar (Value m))
forall a. a -> Maybe a
Just (Map Scalar (Value m) -> m (Maybe (Map Scalar (Value m))))
-> Map Scalar (Value m) -> m (Maybe (Map Scalar (Value m)))
forall a b. (a -> b) -> a -> b
$ [(Scalar, Value m)] -> Map Scalar (Value m)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Scalar, Value m)]
pairs
  where
    makePair :: Scalar -> m (Scalar, Value m)
makePair Scalar
k = (Scalar
k,) (Value m -> (Scalar, Value m))
-> (Maybe (Value m) -> Value m)
-> Maybe (Value m)
-> (Scalar, Value m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value m -> Maybe (Value m) -> Value m
forall a. a -> Maybe a -> a
fromMaybe Value m
forall (m :: * -> *). Value m
NoneV (Maybe (Value m) -> (Scalar, Value m))
-> m (Maybe (Value m)) -> m (Scalar, Value m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NativeObject m -> Scalar -> m (Maybe (Value m))
forall (m :: * -> *).
NativeObject m -> Scalar -> m (Maybe (Value m))
nativeObjectGetField NativeObject m
o Scalar
k

(-->) :: obj -> (obj -> obj -> a) -> a
obj
obj --> :: forall obj a. obj -> (obj -> obj -> a) -> a
--> obj -> obj -> a
field = obj -> obj -> a
field obj
obj obj
obj

defNativeObject :: Monad m => ObjectID -> NativeObject m
defNativeObject :: forall (m :: * -> *). Monad m => ObjectID -> NativeObject m
defNativeObject ObjectID
oid =
  NativeObject
    { nativeObjectID :: ObjectID
nativeObjectID = ObjectID
oid
    , nativeObjectGetFieldNames :: m [Scalar]
nativeObjectGetFieldNames = [Scalar] -> m [Scalar]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    , nativeObjectGetField :: Scalar -> m (Maybe (Value m))
nativeObjectGetField = \Scalar
_ -> Maybe (Value m) -> m (Maybe (Value m))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Value m)
forall a. Maybe a
Nothing
    , nativeObjectGetAttribute :: Identifier -> m (Maybe (Value m))
nativeObjectGetAttribute = \Identifier
_ -> Maybe (Value m) -> m (Maybe (Value m))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Value m)
forall a. Maybe a
Nothing
    , nativeObjectStringified :: m Text
nativeObjectStringified = Text -> m Text
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"<native object>"
    , nativeObjectEncoded :: Context m -> m Encoded
nativeObjectEncoded = m Encoded -> Context m -> m Encoded
forall a b. a -> b -> a
const (m Encoded -> Context m -> m Encoded)
-> m Encoded -> Context m -> m Encoded
forall a b. (a -> b) -> a -> b
$ Encoded -> m Encoded
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Encoded
Encoded Text
"[[native object]]")
    , nativeObjectAsList :: m (Maybe (Vector (Value m)))
nativeObjectAsList = Maybe (Vector (Value m)) -> m (Maybe (Vector (Value m)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Vector (Value m))
forall a. Maybe a
Nothing
    , nativeObjectCall :: Maybe
  (NativeObject m
   -> [(Maybe Identifier, Value m)]
   -> m (Either RuntimeError (Value m)))
nativeObjectCall = Maybe
  (NativeObject m
   -> [(Maybe Identifier, Value m)]
   -> m (Either RuntimeError (Value m)))
forall a. Maybe a
Nothing
    , nativeObjectEq :: NativeObject m -> NativeObject m -> m (Either RuntimeError Bool)
nativeObjectEq = \NativeObject m
_self NativeObject m
_other -> 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
    }

instance IsString Scalar where
  fromString :: String -> Scalar
fromString = Text -> Scalar
StringScalar (Text -> Scalar) -> (String -> Text) -> String -> Scalar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack

instance IsString (Value m) where
  fromString :: String -> Value m
fromString = Scalar -> Value m
forall (m :: * -> *). Scalar -> Value m
ScalarV (Scalar -> Value m) -> (String -> Scalar) -> String -> Value m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Scalar
forall a. IsString a => String -> a
fromString

class ToScalar a where
  toScalar :: a -> Scalar

instance ToScalar Scalar where
  toScalar :: Scalar -> Scalar
toScalar = Scalar -> Scalar
forall a. a -> a
id

instance ToScalar () where
  toScalar :: () -> Scalar
toScalar () = Scalar
NoneScalar

instance ToScalar Bool where
  toScalar :: Bool -> Scalar
toScalar = Bool -> Scalar
BoolScalar

instance ToScalar Integer where
  toScalar :: Integer -> Scalar
toScalar = Integer -> Scalar
IntScalar

toIntScalar :: Integral a => a -> Scalar
toIntScalar :: forall a. Integral a => a -> Scalar
toIntScalar = Integer -> Scalar
IntScalar (Integer -> Scalar) -> (a -> Integer) -> a -> Scalar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance ToScalar Int where
  toScalar :: Int -> Scalar
toScalar = Int -> Scalar
forall a. Integral a => a -> Scalar
toIntScalar

instance ToScalar Word where
  toScalar :: Word -> Scalar
toScalar = Word -> Scalar
forall a. Integral a => a -> Scalar
toIntScalar

instance ToScalar Int8 where
  toScalar :: Int8 -> Scalar
toScalar = Int8 -> Scalar
forall a. Integral a => a -> Scalar
toIntScalar

instance ToScalar Int16 where
  toScalar :: Int16 -> Scalar
toScalar = Int16 -> Scalar
forall a. Integral a => a -> Scalar
toIntScalar

instance ToScalar Int32 where
  toScalar :: Int32 -> Scalar
toScalar = Int32 -> Scalar
forall a. Integral a => a -> Scalar
toIntScalar

instance ToScalar Int64 where
  toScalar :: Int64 -> Scalar
toScalar = Int64 -> Scalar
forall a. Integral a => a -> Scalar
toIntScalar

instance ToScalar Word8 where
  toScalar :: Word8 -> Scalar
toScalar = Word8 -> Scalar
forall a. Integral a => a -> Scalar
toIntScalar

instance ToScalar Word16 where
  toScalar :: Word16 -> Scalar
toScalar = Word16 -> Scalar
forall a. Integral a => a -> Scalar
toIntScalar

instance ToScalar Word32 where
  toScalar :: Word32 -> Scalar
toScalar = Word32 -> Scalar
forall a. Integral a => a -> Scalar
toIntScalar

instance ToScalar Word64 where
  toScalar :: Word64 -> Scalar
toScalar = Word64 -> Scalar
forall a. Integral a => a -> Scalar
toIntScalar

instance ToScalar Double where
  toScalar :: Double -> Scalar
toScalar = Double -> Scalar
FloatScalar

instance ToScalar Float where
  toScalar :: Float -> Scalar
toScalar = Double -> Scalar
FloatScalar (Double -> Scalar) -> (Float -> Double) -> Float -> Scalar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Double
float2Double


instance ToScalar Text where
  toScalar :: Text -> Scalar
toScalar = Text -> Scalar
StringScalar

instance ToScalar LText.Text where
  toScalar :: Text -> Scalar
toScalar = Text -> Scalar
StringScalar (Text -> Scalar) -> (Text -> Text) -> Text -> Scalar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
LText.toStrict

instance ToScalar ByteString where
  toScalar :: ByteString -> Scalar
toScalar = ByteString -> Scalar
BytesScalar

instance ToScalar LBS.ByteString where
  toScalar :: ByteString -> Scalar
toScalar = ByteString -> Scalar
BytesScalar (ByteString -> Scalar)
-> (ByteString -> ByteString) -> ByteString -> Scalar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.toStrict

instance ToScalar a => ToScalar (Maybe a) where
  toScalar :: Maybe a -> Scalar
toScalar Maybe a
Nothing = Scalar
NoneScalar
  toScalar (Just a
x) = a -> Scalar
forall a. ToScalar a => a -> Scalar
toScalar a
x

instance (ToScalar a, ToScalar b) => ToScalar (Either a b) where
  toScalar :: Either a b -> Scalar
toScalar (Left a
x) = a -> Scalar
forall a. ToScalar a => a -> Scalar
toScalar a
x
  toScalar (Right b
x) = b -> Scalar
forall a. ToScalar a => a -> Scalar
toScalar b
x

instance ToScalar Identifier where
  toScalar :: Identifier -> Scalar
toScalar = 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

class FnArgValue a where
  fromArgValue :: Value m -> Either RuntimeError a

--------------------------------------------------------------------------------
-- FromValue
--------------------------------------------------------------------------------

class FromValue a m where
  fromValue :: Value m -> m (Either RuntimeError a)

--------------------------------------------------------------------------------
-- FromValue instances
--------------------------------------------------------------------------------

instance Applicative m => FromValue (Value m) m where
  fromValue :: Value m -> m (Either RuntimeError (Value m))
fromValue = 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

instance Applicative m => FromValue Scalar m where
  fromValue :: Value m -> m (Either RuntimeError Scalar)
fromValue = Either RuntimeError Scalar -> m (Either RuntimeError Scalar)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError Scalar -> m (Either RuntimeError Scalar))
-> (Value m -> Either RuntimeError Scalar)
-> Value m
-> m (Either RuntimeError Scalar)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value m -> Either RuntimeError Scalar
forall (m :: * -> *). Value m -> Either RuntimeError Scalar
asScalarVal

instance Applicative m => FromValue Text m where
  fromValue :: Value m -> m (Either RuntimeError Text)
fromValue = Either RuntimeError Text -> m (Either RuntimeError Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError Text -> m (Either RuntimeError Text))
-> (Value m -> Either RuntimeError Text)
-> Value m
-> m (Either RuntimeError Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value m -> Either RuntimeError Text
forall (m :: * -> *). Value m -> Either RuntimeError Text
asTextVal

instance Applicative m => FromValue Identifier m where
  fromValue :: Value m -> m (Either RuntimeError Identifier)
fromValue = Either RuntimeError Identifier
-> m (Either RuntimeError Identifier)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError Identifier
 -> m (Either RuntimeError Identifier))
-> (Value m -> Either RuntimeError Identifier)
-> Value m
-> m (Either RuntimeError Identifier)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Identifier)
-> Either RuntimeError Text -> Either RuntimeError Identifier
forall a b.
(a -> b) -> Either RuntimeError a -> Either RuntimeError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Identifier
Identifier (Either RuntimeError Text -> Either RuntimeError Identifier)
-> (Value m -> Either RuntimeError Text)
-> Value m
-> Either RuntimeError Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value m -> Either RuntimeError Text
forall (m :: * -> *). Value m -> Either RuntimeError Text
asTextVal

instance Applicative m => FromValue Integer m where
  fromValue :: Value m -> m (Either RuntimeError Integer)
fromValue = Either RuntimeError Integer -> m (Either RuntimeError Integer)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError Integer -> m (Either RuntimeError Integer))
-> (Value m -> Either RuntimeError Integer)
-> Value m
-> m (Either RuntimeError Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value m -> Either RuntimeError Integer
forall (m :: * -> *).
Text -> Value m -> Either RuntimeError Integer
asIntVal Text
"conversion to int"

instance Applicative m => FromValue Int m where
  fromValue :: Value m -> m (Either RuntimeError Int)
fromValue = (Either RuntimeError Integer -> Either RuntimeError Int)
-> m (Either RuntimeError Integer) -> m (Either RuntimeError Int)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Integer -> Int)
-> Either RuntimeError Integer -> Either RuntimeError Int
forall a b.
(a -> b) -> Either RuntimeError a -> Either RuntimeError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Int
forall a. Num a => Integer -> a
fromInteger) (m (Either RuntimeError Integer) -> m (Either RuntimeError Int))
-> (Value m -> m (Either RuntimeError Integer))
-> Value m
-> m (Either RuntimeError Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either RuntimeError Integer -> m (Either RuntimeError Integer)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError Integer -> m (Either RuntimeError Integer))
-> (Value m -> Either RuntimeError Integer)
-> Value m
-> m (Either RuntimeError Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value m -> Either RuntimeError Integer
forall (m :: * -> *).
Text -> Value m -> Either RuntimeError Integer
asIntVal Text
"conversion to int"

instance Applicative m => FromValue Double m where
  fromValue :: Value m -> m (Either RuntimeError Double)
fromValue = Either RuntimeError Double -> m (Either RuntimeError Double)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError Double -> m (Either RuntimeError Double))
-> (Value m -> Either RuntimeError Double)
-> Value m
-> m (Either RuntimeError Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value m -> Either RuntimeError Double
forall (m :: * -> *). Text -> Value m -> Either RuntimeError Double
asFloatVal Text
"conversion to float"

instance Applicative m => FromValue Bool m where
  fromValue :: Value m -> m (Either RuntimeError Bool)
fromValue = 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))
-> (Value m -> Either RuntimeError Bool)
-> Value m
-> m (Either RuntimeError Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value m -> Either RuntimeError Bool
forall (m :: * -> *). Text -> Value m -> Either RuntimeError Bool
asBoolVal Text
"conversion to bool"

instance Applicative m => FromValue () m where
  fromValue :: Value m -> m (Either RuntimeError ())
fromValue Value m
NoneV = Either RuntimeError () -> m (Either RuntimeError ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError () -> m (Either RuntimeError ()))
-> Either RuntimeError () -> m (Either RuntimeError ())
forall a b. (a -> b) -> a -> b
$ () -> Either RuntimeError ()
forall a b. b -> Either a b
Right ()
  fromValue Value m
x = Either RuntimeError () -> m (Either RuntimeError ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError () -> m (Either RuntimeError ()))
-> (RuntimeError -> Either RuntimeError ())
-> RuntimeError
-> m (Either RuntimeError ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuntimeError -> Either RuntimeError ()
forall a b. a -> Either a b
Left (RuntimeError -> m (Either RuntimeError ()))
-> RuntimeError -> m (Either RuntimeError ())
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> RuntimeError
TagError Text
"" Text
"fromValue" (Value m -> Text
forall (m :: * -> *). Value m -> Text
tagNameOf Value m
x)

instance (Applicative m, FromValue a m) => FromValue (Maybe a) m where
  fromValue :: Value m -> m (Either RuntimeError (Maybe a))
fromValue Value m
NoneV = Either RuntimeError (Maybe a) -> m (Either RuntimeError (Maybe a))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError (Maybe a)
 -> m (Either RuntimeError (Maybe a)))
-> Either RuntimeError (Maybe a)
-> m (Either RuntimeError (Maybe a))
forall a b. (a -> b) -> a -> b
$ Maybe a -> Either RuntimeError (Maybe a)
forall a b. b -> Either a b
Right Maybe a
forall a. Maybe a
Nothing
  fromValue Value m
x = (Either RuntimeError a -> Either RuntimeError (Maybe a))
-> m (Either RuntimeError a) -> m (Either RuntimeError (Maybe a))
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> Maybe a)
-> Either RuntimeError a -> Either RuntimeError (Maybe a)
forall a b.
(a -> b) -> Either RuntimeError a -> Either RuntimeError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just) (m (Either RuntimeError a) -> m (Either RuntimeError (Maybe a)))
-> m (Either RuntimeError a) -> m (Either RuntimeError (Maybe a))
forall a b. (a -> b) -> a -> b
$ Value m -> m (Either RuntimeError a)
forall a (m :: * -> *).
FromValue a m =>
Value m -> m (Either RuntimeError a)
fromValue Value m
x

instance (Monad m, FromValue l m, FromValue r m) => FromValue (Either l r) m where
  fromValue :: Value m -> m (Either RuntimeError (Either l r))
fromValue Value m
v = do
    Value m -> m (Either RuntimeError r)
forall a (m :: * -> *).
FromValue a m =>
Value m -> m (Either RuntimeError a)
fromValue Value m
v m (Either RuntimeError r)
-> (Either RuntimeError r -> m (Either RuntimeError (Either l r)))
-> m (Either RuntimeError (Either l r))
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Right r
r -> Either RuntimeError (Either l r)
-> m (Either RuntimeError (Either l r))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError (Either l r)
 -> m (Either RuntimeError (Either l r)))
-> (Either l r -> Either RuntimeError (Either l r))
-> Either l r
-> m (Either RuntimeError (Either l r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either l r -> Either RuntimeError (Either l r)
forall a b. b -> Either a b
Right (Either l r -> m (Either RuntimeError (Either l r)))
-> Either l r -> m (Either RuntimeError (Either l r))
forall a b. (a -> b) -> a -> b
$ r -> Either l r
forall a b. b -> Either a b
Right r
r
      Either RuntimeError r
_ -> do
        Value m -> m (Either RuntimeError l)
forall a (m :: * -> *).
FromValue a m =>
Value m -> m (Either RuntimeError a)
fromValue Value m
v m (Either RuntimeError l)
-> (Either RuntimeError l -> m (Either RuntimeError (Either l r)))
-> m (Either RuntimeError (Either l r))
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Left RuntimeError
e -> Either RuntimeError (Either l r)
-> m (Either RuntimeError (Either l r))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError (Either l r)
 -> m (Either RuntimeError (Either l r)))
-> Either RuntimeError (Either l r)
-> m (Either RuntimeError (Either l r))
forall a b. (a -> b) -> a -> b
$ RuntimeError -> Either RuntimeError (Either l r)
forall a b. a -> Either a b
Left RuntimeError
e
          Right l
l -> Either RuntimeError (Either l r)
-> m (Either RuntimeError (Either l r))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError (Either l r)
 -> m (Either RuntimeError (Either l r)))
-> (Either l r -> Either RuntimeError (Either l r))
-> Either l r
-> m (Either RuntimeError (Either l r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either l r -> Either RuntimeError (Either l r)
forall a b. b -> Either a b
Right (Either l r -> m (Either RuntimeError (Either l r)))
-> Either l r -> m (Either RuntimeError (Either l r))
forall a b. (a -> b) -> a -> b
$ l -> Either l r
forall a b. a -> Either a b
Left l
l

instance (Monad m, FromValue a m) => FromValue [a] m where
  fromValue :: Value m -> m (Either RuntimeError [a])
fromValue Value m
x = ExceptT RuntimeError m [a] -> m (Either RuntimeError [a])
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT RuntimeError m [a] -> m (Either RuntimeError [a]))
-> ExceptT RuntimeError m [a] -> m (Either RuntimeError [a])
forall a b. (a -> b) -> a -> b
$ do
    [Value m]
items :: [Value m] <- m (Either RuntimeError [Value m])
-> ExceptT RuntimeError m [Value m]
forall (m :: * -> *) e (t :: (* -> *) -> * -> *) a.
(Monad m, MonadError e (t m), MonadTrans t) =>
m (Either e a) -> t m a
eitherExceptM (Value m -> m (Either RuntimeError [Value m])
forall (m :: * -> *).
Monad m =>
Value m -> m (Either RuntimeError [Value m])
asListVal Value m
x)
    (Value m -> ExceptT RuntimeError m a)
-> [Value m] -> ExceptT RuntimeError m [a]
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 (m (Either RuntimeError a) -> ExceptT RuntimeError m a
forall (m :: * -> *) e (t :: (* -> *) -> * -> *) a.
(Monad m, MonadError e (t m), MonadTrans t) =>
m (Either e a) -> t m a
eitherExceptM (m (Either RuntimeError a) -> ExceptT RuntimeError m a)
-> (Value m -> m (Either RuntimeError a))
-> Value m
-> ExceptT RuntimeError m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value m -> m (Either RuntimeError a)
forall a (m :: * -> *).
FromValue a m =>
Value m -> m (Either RuntimeError a)
fromValue) [Value m]
items

instance (Monad m, FromValue a m) => FromValue (Vector a) m where
  fromValue :: Value m -> m (Either RuntimeError (Vector a))
fromValue Value m
x = ExceptT RuntimeError m (Vector a)
-> m (Either RuntimeError (Vector a))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT RuntimeError m (Vector a)
 -> m (Either RuntimeError (Vector a)))
-> ExceptT RuntimeError m (Vector a)
-> m (Either RuntimeError (Vector a))
forall a b. (a -> b) -> a -> b
$ do
    Vector (Value m)
items :: Vector (Value m) <- m (Either RuntimeError (Vector (Value m)))
-> ExceptT RuntimeError m (Vector (Value m))
forall (m :: * -> *) e (t :: (* -> *) -> * -> *) a.
(Monad m, MonadError e (t m), MonadTrans t) =>
m (Either e a) -> t m a
eitherExceptM (Value m -> m (Either RuntimeError (Vector (Value m)))
forall (m :: * -> *).
Monad m =>
Value m -> m (Either RuntimeError (Vector (Value m)))
asVectorVal Value m
x)
    (Value m -> ExceptT RuntimeError m a)
-> Vector (Value m) -> ExceptT RuntimeError m (Vector a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
V.mapM (m (Either RuntimeError a) -> ExceptT RuntimeError m a
forall (m :: * -> *) e (t :: (* -> *) -> * -> *) a.
(Monad m, MonadError e (t m), MonadTrans t) =>
m (Either e a) -> t m a
eitherExceptM (m (Either RuntimeError a) -> ExceptT RuntimeError m a)
-> (Value m -> m (Either RuntimeError a))
-> Value m
-> ExceptT RuntimeError m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value m -> m (Either RuntimeError a)
forall a (m :: * -> *).
FromValue a m =>
Value m -> m (Either RuntimeError a)
fromValue) Vector (Value m)
items

instance (Monad m, FromValue a m) => FromValue (Map Scalar a) m where
  fromValue :: Value m -> m (Either RuntimeError (Map Scalar a))
fromValue Value m
x = ExceptT RuntimeError m (Map Scalar a)
-> m (Either RuntimeError (Map Scalar a))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT RuntimeError m (Map Scalar a)
 -> m (Either RuntimeError (Map Scalar a)))
-> ExceptT RuntimeError m (Map Scalar a)
-> m (Either RuntimeError (Map Scalar a))
forall a b. (a -> b) -> a -> b
$ do
    Map Scalar (Value m)
items :: Map Scalar (Value m) <- m (Either RuntimeError (Map Scalar (Value m)))
-> ExceptT RuntimeError m (Map Scalar (Value m))
forall (m :: * -> *) e (t :: (* -> *) -> * -> *) a.
(Monad m, MonadError e (t m), MonadTrans t) =>
m (Either e a) -> t m a
eitherExceptM (Value m -> m (Either RuntimeError (Map Scalar (Value m)))
forall (m :: * -> *).
Monad m =>
Value m -> m (Either RuntimeError (Map Scalar (Value m)))
asDictVal Value m
x)
    [(Scalar, a)] -> Map Scalar a
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Scalar, a)] -> Map Scalar a)
-> ExceptT RuntimeError m [(Scalar, a)]
-> ExceptT RuntimeError m (Map Scalar a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Scalar, Value m) -> ExceptT RuntimeError m (Scalar, a))
-> [(Scalar, Value m)] -> ExceptT RuntimeError m [(Scalar, a)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\(Scalar
k, Value m
v) -> (Scalar
k,) (a -> (Scalar, a))
-> ExceptT RuntimeError m a -> ExceptT RuntimeError m (Scalar, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Either RuntimeError a) -> ExceptT RuntimeError m a
forall (m :: * -> *) e (t :: (* -> *) -> * -> *) a.
(Monad m, MonadError e (t m), MonadTrans t) =>
m (Either e a) -> t m a
eitherExceptM (Value m -> m (Either RuntimeError a)
forall a (m :: * -> *).
FromValue a m =>
Value m -> m (Either RuntimeError a)
fromValue Value m
v)) (Map Scalar (Value m) -> [(Scalar, Value m)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Scalar (Value m)
items)

--------------------------------------------------------------------------------
-- ToValue
--------------------------------------------------------------------------------

class ToValue a m where
  toValue :: a -> Value m

instance ToValue (Value m) m where
  toValue :: Value m -> Value m
toValue = Value m -> Value m
forall a. a -> a
id

class FnToValue a m where
  fnToValue :: ObjectID -> Maybe ProcedureDoc -> a -> Value m

--------------------------------------------------------------------------------
-- ToValue Scalar instances
--------------------------------------------------------------------------------

instance ToValue Scalar a where
  toValue :: Scalar -> Value a
toValue = Scalar -> Value a
forall (m :: * -> *). Scalar -> Value m
ScalarV

instance ToValue () a where
  toValue :: () -> Value a
toValue = Scalar -> Value a
forall (m :: * -> *). Scalar -> Value m
ScalarV (Scalar -> Value a) -> (() -> Scalar) -> () -> Value a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Scalar
forall a. ToScalar a => a -> Scalar
toScalar

instance ToValue Bool a where
  toValue :: Bool -> Value a
toValue = Scalar -> Value a
forall (m :: * -> *). Scalar -> Value m
ScalarV (Scalar -> Value a) -> (Bool -> Scalar) -> Bool -> Value a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Scalar
forall a. ToScalar a => a -> Scalar
toScalar

instance ToValue Integer a where
  toValue :: Integer -> Value a
toValue = Scalar -> Value a
forall (m :: * -> *). Scalar -> Value m
ScalarV (Scalar -> Value a) -> (Integer -> Scalar) -> Integer -> Value a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Scalar
forall a. ToScalar a => a -> Scalar
toScalar

instance ToValue Int a where
  toValue :: Int -> Value a
toValue = Scalar -> Value a
forall (m :: * -> *). Scalar -> Value m
ScalarV (Scalar -> Value a) -> (Int -> Scalar) -> Int -> Value a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Scalar
forall a. ToScalar a => a -> Scalar
toScalar

instance ToValue Int8 a where
  toValue :: Int8 -> Value a
toValue = Scalar -> Value a
forall (m :: * -> *). Scalar -> Value m
ScalarV (Scalar -> Value a) -> (Int8 -> Scalar) -> Int8 -> Value a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> Scalar
forall a. ToScalar a => a -> Scalar
toScalar

instance ToValue Int16 a where
  toValue :: Int16 -> Value a
toValue = Scalar -> Value a
forall (m :: * -> *). Scalar -> Value m
ScalarV (Scalar -> Value a) -> (Int16 -> Scalar) -> Int16 -> Value a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Scalar
forall a. ToScalar a => a -> Scalar
toScalar

instance ToValue Int32 a where
  toValue :: Int32 -> Value a
toValue = Scalar -> Value a
forall (m :: * -> *). Scalar -> Value m
ScalarV (Scalar -> Value a) -> (Int32 -> Scalar) -> Int32 -> Value a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Scalar
forall a. ToScalar a => a -> Scalar
toScalar

instance ToValue Int64 a where
  toValue :: Int64 -> Value a
toValue = Scalar -> Value a
forall (m :: * -> *). Scalar -> Value m
ScalarV (Scalar -> Value a) -> (Int64 -> Scalar) -> Int64 -> Value a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Scalar
forall a. ToScalar a => a -> Scalar
toScalar

instance ToValue Word a where
  toValue :: Word -> Value a
toValue = Scalar -> Value a
forall (m :: * -> *). Scalar -> Value m
ScalarV (Scalar -> Value a) -> (Word -> Scalar) -> Word -> Value a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Scalar
forall a. ToScalar a => a -> Scalar
toScalar

instance ToValue Word8 a where
  toValue :: Word8 -> Value a
toValue = Scalar -> Value a
forall (m :: * -> *). Scalar -> Value m
ScalarV (Scalar -> Value a) -> (Word8 -> Scalar) -> Word8 -> Value a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Scalar
forall a. ToScalar a => a -> Scalar
toScalar

instance ToValue Word16 a where
  toValue :: Word16 -> Value a
toValue = Scalar -> Value a
forall (m :: * -> *). Scalar -> Value m
ScalarV (Scalar -> Value a) -> (Word16 -> Scalar) -> Word16 -> Value a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Scalar
forall a. ToScalar a => a -> Scalar
toScalar

instance ToValue Word32 a where
  toValue :: Word32 -> Value a
toValue = Scalar -> Value a
forall (m :: * -> *). Scalar -> Value m
ScalarV (Scalar -> Value a) -> (Word32 -> Scalar) -> Word32 -> Value a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Scalar
forall a. ToScalar a => a -> Scalar
toScalar

instance ToValue Word64 a where
  toValue :: Word64 -> Value a
toValue = Scalar -> Value a
forall (m :: * -> *). Scalar -> Value m
ScalarV (Scalar -> Value a) -> (Word64 -> Scalar) -> Word64 -> Value a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Scalar
forall a. ToScalar a => a -> Scalar
toScalar

instance ToValue Double a where
  toValue :: Double -> Value a
toValue = Scalar -> Value a
forall (m :: * -> *). Scalar -> Value m
ScalarV (Scalar -> Value a) -> (Double -> Scalar) -> Double -> Value a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Scalar
forall a. ToScalar a => a -> Scalar
toScalar

instance ToValue Float a where
  toValue :: Float -> Value a
toValue = Scalar -> Value a
forall (m :: * -> *). Scalar -> Value m
ScalarV (Scalar -> Value a) -> (Float -> Scalar) -> Float -> Value a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Scalar
forall a. ToScalar a => a -> Scalar
toScalar

instance ToValue Text a where
  toValue :: Text -> Value a
toValue = Scalar -> Value a
forall (m :: * -> *). Scalar -> Value m
ScalarV (Scalar -> Value a) -> (Text -> Scalar) -> Text -> Value a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Scalar
forall a. ToScalar a => a -> Scalar
toScalar

instance ToValue LText.Text a where
  toValue :: Text -> Value a
toValue = Scalar -> Value a
forall (m :: * -> *). Scalar -> Value m
ScalarV (Scalar -> Value a) -> (Text -> Scalar) -> Text -> Value a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Scalar
forall a. ToScalar a => a -> Scalar
toScalar

instance ToValue ByteString a where
  toValue :: ByteString -> Value a
toValue = Scalar -> Value a
forall (m :: * -> *). Scalar -> Value m
ScalarV (Scalar -> Value a)
-> (ByteString -> Scalar) -> ByteString -> Value a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Scalar
forall a. ToScalar a => a -> Scalar
toScalar

instance ToValue LBS.ByteString a where
  toValue :: ByteString -> Value a
toValue = Scalar -> Value a
forall (m :: * -> *). Scalar -> Value m
ScalarV (Scalar -> Value a)
-> (ByteString -> Scalar) -> ByteString -> Value a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Scalar
forall a. ToScalar a => a -> Scalar
toScalar

instance ToValue Identifier a where
  toValue :: Identifier -> Value a
toValue = Scalar -> Value a
forall (m :: * -> *). Scalar -> Value m
ScalarV (Scalar -> Value a)
-> (Identifier -> Scalar) -> Identifier -> Value a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Scalar
forall a. ToScalar a => a -> Scalar
toScalar

--------------------------------------------------------------------------------
-- Compound / derived instances
--------------------------------------------------------------------------------

instance ToValue a m => ToValue (Maybe a) m where
  toValue :: Maybe a -> Value m
toValue Maybe a
Nothing = Scalar -> Value m
forall (m :: * -> *). Scalar -> Value m
ScalarV Scalar
NoneScalar
  toValue (Just a
x) = a -> Value m
forall a (m :: * -> *). ToValue a m => a -> Value m
toValue a
x

instance (ToValue a m, ToValue b m) => ToValue (Either a b) m where
  toValue :: Either a b -> Value m
toValue (Left a
x) = a -> Value m
forall a (m :: * -> *). ToValue a m => a -> Value m
toValue a
x
  toValue (Right b
x) = b -> Value m
forall a (m :: * -> *). ToValue a m => a -> Value m
toValue b
x

instance ToValue a m => ToValue (Vector a) m where
  toValue :: Vector a -> Value m
toValue = Vector (Value m) -> Value m
forall (m :: * -> *). Vector (Value m) -> Value m
ListV (Vector (Value m) -> Value m)
-> (Vector a -> Vector (Value m)) -> Vector a -> Value m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Value m) -> Vector a -> Vector (Value m)
forall a b. (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Value m
forall a (m :: * -> *). ToValue a m => a -> Value m
toValue

instance ToValue a m => ToValue [a] m where
  toValue :: [a] -> Value m
toValue = Vector (Value m) -> Value m
forall (m :: * -> *). Vector (Value m) -> Value m
ListV (Vector (Value m) -> Value m)
-> ([a] -> Vector (Value m)) -> [a] -> 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] -> Vector (Value m))
-> ([a] -> [Value m]) -> [a] -> Vector (Value m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Value m) -> [a] -> [Value m]
forall a b. (a -> b) -> [a] -> [b]
map a -> Value m
forall a (m :: * -> *). ToValue a m => a -> Value m
toValue

instance (ToValue a1 m, ToValue a2 m)
         => ToValue (a1, a2) m where
  toValue :: (a1, a2) -> Value m
toValue (a1
x1, a2
x2) =
    Vector (Value m) -> Value m
forall (m :: * -> *). Vector (Value m) -> Value m
ListV (Vector (Value m) -> Value m) -> Vector (Value m) -> Value m
forall a b. (a -> b) -> a -> b
$ [Value m] -> Vector (Value m)
forall a. [a] -> Vector a
V.fromList [a1 -> Value m
forall a (m :: * -> *). ToValue a m => a -> Value m
toValue a1
x1, a2 -> Value m
forall a (m :: * -> *). ToValue a m => a -> Value m
toValue a2
x2]

instance (ToValue a1 m, ToValue a2 m, ToValue a3 m)
         => ToValue (a1, a2, a3) m where
  toValue :: (a1, a2, a3) -> Value m
toValue (a1
x1, a2
x2, a3
x3) =
    Vector (Value m) -> Value m
forall (m :: * -> *). Vector (Value m) -> Value m
ListV (Vector (Value m) -> Value m) -> Vector (Value m) -> Value m
forall a b. (a -> b) -> a -> b
$ [Value m] -> Vector (Value m)
forall a. [a] -> Vector a
V.fromList [a1 -> Value m
forall a (m :: * -> *). ToValue a m => a -> Value m
toValue a1
x1, a2 -> Value m
forall a (m :: * -> *). ToValue a m => a -> Value m
toValue a2
x2, a3 -> Value m
forall a (m :: * -> *). ToValue a m => a -> Value m
toValue a3
x3]

instance (ToValue a1 m, ToValue a2 m, ToValue a3 m, ToValue a4 m)
         => ToValue (a1, a2, a3, a4) m where
  toValue :: (a1, a2, a3, a4) -> Value m
toValue (a1
x1, a2
x2, a3
x3, a4
x4) =
    Vector (Value m) -> Value m
forall (m :: * -> *). Vector (Value m) -> Value m
ListV (Vector (Value m) -> Value m) -> Vector (Value m) -> Value m
forall a b. (a -> b) -> a -> b
$ [Value m] -> Vector (Value m)
forall a. [a] -> Vector a
V.fromList [a1 -> Value m
forall a (m :: * -> *). ToValue a m => a -> Value m
toValue a1
x1, a2 -> Value m
forall a (m :: * -> *). ToValue a m => a -> Value m
toValue a2
x2, a3 -> Value m
forall a (m :: * -> *). ToValue a m => a -> Value m
toValue a3
x3, a4 -> Value m
forall a (m :: * -> *). ToValue a m => a -> Value m
toValue a4
x4]

instance (ToValue a1 m, ToValue a2 m, ToValue a3 m, ToValue a4 m, ToValue a5 m)
         => ToValue (a1, a2, a3, a4, a5) m where
  toValue :: (a1, a2, a3, a4, a5) -> Value m
toValue (a1
x1, a2
x2, a3
x3, a4
x4, a5
x5) =
    Vector (Value m) -> Value m
forall (m :: * -> *). Vector (Value m) -> Value m
ListV (Vector (Value m) -> Value m) -> Vector (Value m) -> Value m
forall a b. (a -> b) -> a -> b
$ [Value m] -> Vector (Value m)
forall a. [a] -> Vector a
V.fromList [a1 -> Value m
forall a (m :: * -> *). ToValue a m => a -> Value m
toValue a1
x1, a2 -> Value m
forall a (m :: * -> *). ToValue a m => a -> Value m
toValue a2
x2, a3 -> Value m
forall a (m :: * -> *). ToValue a m => a -> Value m
toValue a3
x3, a4 -> Value m
forall a (m :: * -> *). ToValue a m => a -> Value m
toValue a4
x4, a5 -> Value m
forall a (m :: * -> *). ToValue a m => a -> Value m
toValue a5
x5]

instance (ToValue a1 m, ToValue a2 m, ToValue a3 m, ToValue a4 m, ToValue a5 m, ToValue a6 m)
         => ToValue (a1, a2, a3, a4, a5, a6) m where
  toValue :: (a1, a2, a3, a4, a5, a6) -> Value m
toValue (a1
x1, a2
x2, a3
x3, a4
x4, a5
x5, a6
x6) =
    Vector (Value m) -> Value m
forall (m :: * -> *). Vector (Value m) -> Value m
ListV (Vector (Value m) -> Value m) -> Vector (Value m) -> Value m
forall a b. (a -> b) -> a -> b
$ [Value m] -> Vector (Value m)
forall a. [a] -> Vector a
V.fromList [a1 -> Value m
forall a (m :: * -> *). ToValue a m => a -> Value m
toValue a1
x1, a2 -> Value m
forall a (m :: * -> *). ToValue a m => a -> Value m
toValue a2
x2, a3 -> Value m
forall a (m :: * -> *). ToValue a m => a -> Value m
toValue a3
x3, a4 -> Value m
forall a (m :: * -> *). ToValue a m => a -> Value m
toValue a4
x4, a5 -> Value m
forall a (m :: * -> *). ToValue a m => a -> Value m
toValue a5
x5, a6 -> Value m
forall a (m :: * -> *). ToValue a m => a -> Value m
toValue a6
x6]

instance (ToValue a1 m, ToValue a2 m, ToValue a3 m, ToValue a4 m, ToValue a5 m, ToValue a6 m, ToValue a7 m)
         => ToValue (a1, a2, a3, a4, a5, a6, a7) m where
  toValue :: (a1, a2, a3, a4, a5, a6, a7) -> Value m
toValue (a1
x1, a2
x2, a3
x3, a4
x4, a5
x5, a6
x6, a7
x7) =
    Vector (Value m) -> Value m
forall (m :: * -> *). Vector (Value m) -> Value m
ListV (Vector (Value m) -> Value m) -> Vector (Value m) -> Value m
forall a b. (a -> b) -> a -> b
$ [Value m] -> Vector (Value m)
forall a. [a] -> Vector a
V.fromList [a1 -> Value m
forall a (m :: * -> *). ToValue a m => a -> Value m
toValue a1
x1, a2 -> Value m
forall a (m :: * -> *). ToValue a m => a -> Value m
toValue a2
x2, a3 -> Value m
forall a (m :: * -> *). ToValue a m => a -> Value m
toValue a3
x3, a4 -> Value m
forall a (m :: * -> *). ToValue a m => a -> Value m
toValue a4
x4, a5 -> Value m
forall a (m :: * -> *). ToValue a m => a -> Value m
toValue a5
x5, a6 -> Value m
forall a (m :: * -> *). ToValue a m => a -> Value m
toValue a6
x6, a7 -> Value m
forall a (m :: * -> *). ToValue a m => a -> Value m
toValue a7
x7]

instance (ToScalar k, ToValue v m) => ToValue (Map k v) m where
  toValue :: Map k v -> Value m
toValue = Map Scalar (Value m) -> Value m
forall (m :: * -> *). Map Scalar (Value m) -> Value m
DictV (Map Scalar (Value m) -> Value m)
-> (Map k v -> Map Scalar (Value m)) -> Map k v -> Value m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> Scalar) -> Map k (Value m) -> Map Scalar (Value m)
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys k -> Scalar
forall a. ToScalar a => a -> Scalar
toScalar (Map k (Value m) -> Map Scalar (Value m))
-> (Map k v -> Map k (Value m)) -> Map k v -> Map Scalar (Value m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v -> Value m) -> Map k v -> Map k (Value m)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map v -> Value m
forall a (m :: * -> *). ToValue a m => a -> Value m
toValue

instance ToValue v m => ToValue (Map LText.Text v) m where
  toValue :: Map Text v -> Value m
toValue = Map Text v -> Value m
forall a (m :: * -> *). ToValue a m => a -> Value m
toValue (Map Text v -> Value m)
-> (Map Text v -> Map Text v) -> Map Text v -> Value m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> Map Text v -> Map Text v
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys Text -> Text
LText.toStrict

instance ToValue v m => ToValue (Map String v) m where
  toValue :: Map String v -> Value m
toValue = Map Text v -> Value m
forall a (m :: * -> *). ToValue a m => a -> Value m
toValue (Map Text v -> Value m)
-> (Map String v -> Map Text v) -> Map String v -> Value m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Text) -> Map String v -> Map Text v
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys String -> Text
Text.pack

--------------------------------------------------------------------------------
-- Function instances
--------------------------------------------------------------------------------

class ToNativeProcedure m a where
  toNativeProcedure :: a
                    -> [(Maybe Identifier, Value m)]
                    -> Context m
                    -> SomePRNG
                    -> m (Either RuntimeError (Value m))

instance Applicative m => ToNativeProcedure m (Value m) where
  toNativeProcedure :: Value m
-> [(Maybe Identifier, Value m)]
-> Context m
-> SomePRNG
-> m (Either RuntimeError (Value m))
toNativeProcedure Value m
val [] Context m
_ SomePRNG
_ =
    Either RuntimeError (Value m) -> m (Either RuntimeError (Value m))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value m -> Either RuntimeError (Value m)
forall a b. b -> Either a b
Right Value m
val)
  toNativeProcedure Value m
_ [(Maybe Identifier, Value m)]
_ Context m
_ SomePRNG
_ =
    Either RuntimeError (Value m) -> m (Either RuntimeError (Value m))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError (Value m)
 -> m (Either RuntimeError (Value m)))
-> (RuntimeError -> Either RuntimeError (Value m))
-> RuntimeError
-> m (Either RuntimeError (Value m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuntimeError -> Either RuntimeError (Value m)
forall a b. a -> Either a b
Left (RuntimeError -> m (Either RuntimeError (Value m)))
-> RuntimeError -> m (Either RuntimeError (Value m))
forall a b. (a -> b) -> a -> b
$
      Text -> Text -> Text -> Text -> RuntimeError
ArgumentError Text
"<native function>" Text
"<positional argument>" Text
"end of arguments" Text
"value"

instance Applicative m => ToNativeProcedure m (m (Value m)) where
  toNativeProcedure :: m (Value m)
-> [(Maybe Identifier, Value m)]
-> Context m
-> SomePRNG
-> m (Either RuntimeError (Value m))
toNativeProcedure m (Value m)
action [] Context m
_ SomePRNG
_ =
    Value m -> Either RuntimeError (Value m)
forall a b. b -> Either a b
Right (Value m -> Either RuntimeError (Value m))
-> m (Value m) -> m (Either RuntimeError (Value m))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Value m)
action
  toNativeProcedure m (Value m)
_ [(Maybe Identifier, Value m)]
_ Context m
_ SomePRNG
_ =
    Either RuntimeError (Value m) -> m (Either RuntimeError (Value m))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError (Value m)
 -> m (Either RuntimeError (Value m)))
-> (RuntimeError -> Either RuntimeError (Value m))
-> RuntimeError
-> m (Either RuntimeError (Value m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuntimeError -> Either RuntimeError (Value m)
forall a b. a -> Either a b
Left (RuntimeError -> m (Either RuntimeError (Value m)))
-> RuntimeError -> m (Either RuntimeError (Value m))
forall a b. (a -> b) -> a -> b
$
      Text -> Text -> Text -> Text -> RuntimeError
ArgumentError Text
"<native function>" Text
"<positional argument>" Text
"end of arguments" Text
"value"

instance Applicative m => ToNativeProcedure m (m (Either RuntimeError (Value m))) where
  toNativeProcedure :: m (Either RuntimeError (Value m))
-> [(Maybe Identifier, Value m)]
-> Context m
-> SomePRNG
-> m (Either RuntimeError (Value m))
toNativeProcedure m (Either RuntimeError (Value m))
action [] Context m
_ SomePRNG
_ =
    m (Either RuntimeError (Value m))
action
  toNativeProcedure m (Either RuntimeError (Value m))
_ [(Maybe Identifier, Value m)]
_ Context m
_ SomePRNG
_ =
    Either RuntimeError (Value m) -> m (Either RuntimeError (Value m))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError (Value m)
 -> m (Either RuntimeError (Value m)))
-> (RuntimeError -> Either RuntimeError (Value m))
-> RuntimeError
-> m (Either RuntimeError (Value m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuntimeError -> Either RuntimeError (Value m)
forall a b. a -> Either a b
Left (RuntimeError -> m (Either RuntimeError (Value m)))
-> RuntimeError -> m (Either RuntimeError (Value m))
forall a b. (a -> b) -> a -> b
$
      Text -> Text -> Text -> Text -> RuntimeError
ArgumentError Text
"<native function>" Text
"<positional argument>" Text
"end of arguments" Text
"value"

instance (Applicative m, ToNativeProcedure m a) => ToNativeProcedure m (Value m -> a) where
  toNativeProcedure :: (Value m -> a)
-> [(Maybe Identifier, Value m)]
-> Context m
-> SomePRNG
-> m (Either RuntimeError (Value m))
toNativeProcedure Value m -> a
_ [] Context m
_ SomePRNG
_ =
    Either RuntimeError (Value m) -> m (Either RuntimeError (Value m))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError (Value m)
 -> m (Either RuntimeError (Value m)))
-> (RuntimeError -> Either RuntimeError (Value m))
-> RuntimeError
-> m (Either RuntimeError (Value m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuntimeError -> Either RuntimeError (Value m)
forall a b. a -> Either a b
Left (RuntimeError -> m (Either RuntimeError (Value m)))
-> RuntimeError -> m (Either RuntimeError (Value m))
forall a b. (a -> b) -> a -> b
$
      Text -> Text -> Text -> Text -> RuntimeError
ArgumentError Text
"<native function>" Text
"<positional argument>" Text
"value" Text
"end of arguments"
  toNativeProcedure Value m -> a
_ ((Just Identifier
_, Value m
_):[(Maybe Identifier, Value m)]
_) Context m
_ SomePRNG
_ =
    Either RuntimeError (Value m) -> m (Either RuntimeError (Value m))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError (Value m)
 -> m (Either RuntimeError (Value m)))
-> (RuntimeError -> Either RuntimeError (Value m))
-> RuntimeError
-> m (Either RuntimeError (Value m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuntimeError -> Either RuntimeError (Value m)
forall a b. a -> Either a b
Left (RuntimeError -> m (Either RuntimeError (Value m)))
-> RuntimeError -> m (Either RuntimeError (Value m))
forall a b. (a -> b) -> a -> b
$
      Text -> Text -> Text -> Text -> RuntimeError
ArgumentError Text
"<native function>" Text
"<positional argument>" Text
"positional argument" Text
"named argument"
  toNativeProcedure Value m -> a
f ((Maybe Identifier
Nothing, Value m
v):[(Maybe Identifier, Value m)]
xs) Context m
ctx SomePRNG
rng =
    a
-> [(Maybe Identifier, Value m)]
-> Context m
-> SomePRNG
-> m (Either RuntimeError (Value m))
forall (m :: * -> *) a.
ToNativeProcedure m a =>
a
-> [(Maybe Identifier, Value m)]
-> Context m
-> SomePRNG
-> m (Either RuntimeError (Value m))
toNativeProcedure (Value m -> a
f Value m
v) [(Maybe Identifier, Value m)]
xs Context m
ctx SomePRNG
rng


instance Applicative m => FnToValue (Value m -> Value m) m where
  fnToValue :: ObjectID -> Maybe ProcedureDoc -> (Value m -> Value m) -> Value m
fnToValue ObjectID
oid Maybe ProcedureDoc
doc Value m -> Value m
f = Procedure m -> Value m
forall (m :: * -> *). Procedure m -> Value m
ProcedureV (Procedure m -> Value m)
-> ((Value m -> Value m) -> Procedure m)
-> (Value m -> Value m)
-> Value m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectID
-> Maybe ProcedureDoc
-> ([(Maybe Identifier, Value m)]
    -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
-> Procedure m
forall (m :: * -> *).
ObjectID
-> Maybe ProcedureDoc
-> ([(Maybe Identifier, Value m)]
    -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
-> Procedure m
NativeProcedure ObjectID
oid Maybe ProcedureDoc
doc (([(Maybe Identifier, Value m)]
  -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
 -> Procedure m)
-> ((Value m -> Value m)
    -> [(Maybe Identifier, Value m)]
    -> Context m
    -> SomePRNG
    -> m (Either RuntimeError (Value m)))
-> (Value m -> Value m)
-> Procedure m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value m -> Value m)
-> [(Maybe Identifier, Value m)]
-> Context m
-> SomePRNG
-> m (Either RuntimeError (Value m))
forall (m :: * -> *) a.
ToNativeProcedure m a =>
a
-> [(Maybe Identifier, Value m)]
-> Context m
-> SomePRNG
-> m (Either RuntimeError (Value m))
toNativeProcedure ((Value m -> Value m) -> Value m)
-> (Value m -> Value m) -> Value m
forall a b. (a -> b) -> a -> b
$ Value m -> Value m
f

instance Applicative m => FnToValue (Value m -> Value m -> Value m) m where
  fnToValue :: ObjectID
-> Maybe ProcedureDoc -> (Value m -> Value m -> Value m) -> Value m
fnToValue ObjectID
oid Maybe ProcedureDoc
doc Value m -> Value m -> Value m
f = Procedure m -> Value m
forall (m :: * -> *). Procedure m -> Value m
ProcedureV (Procedure m -> Value m)
-> ((Value m -> Value m -> Value m) -> Procedure m)
-> (Value m -> Value m -> Value m)
-> Value m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectID
-> Maybe ProcedureDoc
-> ([(Maybe Identifier, Value m)]
    -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
-> Procedure m
forall (m :: * -> *).
ObjectID
-> Maybe ProcedureDoc
-> ([(Maybe Identifier, Value m)]
    -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
-> Procedure m
NativeProcedure ObjectID
oid Maybe ProcedureDoc
doc (([(Maybe Identifier, Value m)]
  -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
 -> Procedure m)
-> ((Value m -> Value m -> Value m)
    -> [(Maybe Identifier, Value m)]
    -> Context m
    -> SomePRNG
    -> m (Either RuntimeError (Value m)))
-> (Value m -> Value m -> Value m)
-> Procedure m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value m -> Value m -> Value m)
-> [(Maybe Identifier, Value m)]
-> Context m
-> SomePRNG
-> m (Either RuntimeError (Value m))
forall (m :: * -> *) a.
ToNativeProcedure m a =>
a
-> [(Maybe Identifier, Value m)]
-> Context m
-> SomePRNG
-> m (Either RuntimeError (Value m))
toNativeProcedure ((Value m -> Value m -> Value m) -> Value m)
-> (Value m -> Value m -> Value m) -> Value m
forall a b. (a -> b) -> a -> b
$ Value m -> Value m -> Value m
f

instance Applicative m => FnToValue (Value m -> Value m -> Value m -> Value m) m where
  fnToValue :: ObjectID
-> Maybe ProcedureDoc
-> (Value m -> Value m -> Value m -> Value m)
-> Value m
fnToValue ObjectID
oid Maybe ProcedureDoc
doc Value m -> Value m -> Value m -> Value m
f = Procedure m -> Value m
forall (m :: * -> *). Procedure m -> Value m
ProcedureV (Procedure m -> Value m)
-> ((Value m -> Value m -> Value m -> Value m) -> Procedure m)
-> (Value m -> Value m -> Value m -> Value m)
-> Value m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectID
-> Maybe ProcedureDoc
-> ([(Maybe Identifier, Value m)]
    -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
-> Procedure m
forall (m :: * -> *).
ObjectID
-> Maybe ProcedureDoc
-> ([(Maybe Identifier, Value m)]
    -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
-> Procedure m
NativeProcedure ObjectID
oid Maybe ProcedureDoc
doc (([(Maybe Identifier, Value m)]
  -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
 -> Procedure m)
-> ((Value m -> Value m -> Value m -> Value m)
    -> [(Maybe Identifier, Value m)]
    -> Context m
    -> SomePRNG
    -> m (Either RuntimeError (Value m)))
-> (Value m -> Value m -> Value m -> Value m)
-> Procedure m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value m -> Value m -> Value m -> Value m)
-> [(Maybe Identifier, Value m)]
-> Context m
-> SomePRNG
-> m (Either RuntimeError (Value m))
forall (m :: * -> *) a.
ToNativeProcedure m a =>
a
-> [(Maybe Identifier, Value m)]
-> Context m
-> SomePRNG
-> m (Either RuntimeError (Value m))
toNativeProcedure ((Value m -> Value m -> Value m -> Value m) -> Value m)
-> (Value m -> Value m -> Value m -> Value m) -> Value m
forall a b. (a -> b) -> a -> b
$ Value m -> Value m -> Value m -> Value m
f

instance Applicative m => FnToValue (Value m -> Value m -> Value m -> Value m -> Value m) m where
  fnToValue :: ObjectID
-> Maybe ProcedureDoc
-> (Value m -> Value m -> Value m -> Value m -> Value m)
-> Value m
fnToValue ObjectID
oid Maybe ProcedureDoc
doc Value m -> Value m -> Value m -> Value m -> Value m
f = Procedure m -> Value m
forall (m :: * -> *). Procedure m -> Value m
ProcedureV (Procedure m -> Value m)
-> ((Value m -> Value m -> Value m -> Value m -> Value m)
    -> Procedure m)
-> (Value m -> Value m -> Value m -> Value m -> Value m)
-> Value m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectID
-> Maybe ProcedureDoc
-> ([(Maybe Identifier, Value m)]
    -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
-> Procedure m
forall (m :: * -> *).
ObjectID
-> Maybe ProcedureDoc
-> ([(Maybe Identifier, Value m)]
    -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
-> Procedure m
NativeProcedure ObjectID
oid Maybe ProcedureDoc
doc (([(Maybe Identifier, Value m)]
  -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
 -> Procedure m)
-> ((Value m -> Value m -> Value m -> Value m -> Value m)
    -> [(Maybe Identifier, Value m)]
    -> Context m
    -> SomePRNG
    -> m (Either RuntimeError (Value m)))
-> (Value m -> Value m -> Value m -> Value m -> Value m)
-> Procedure m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value m -> Value m -> Value m -> Value m -> Value m)
-> [(Maybe Identifier, Value m)]
-> Context m
-> SomePRNG
-> m (Either RuntimeError (Value m))
forall (m :: * -> *) a.
ToNativeProcedure m a =>
a
-> [(Maybe Identifier, Value m)]
-> Context m
-> SomePRNG
-> m (Either RuntimeError (Value m))
toNativeProcedure ((Value m -> Value m -> Value m -> Value m -> Value m) -> Value m)
-> (Value m -> Value m -> Value m -> Value m -> Value m) -> Value m
forall a b. (a -> b) -> a -> b
$ Value m -> Value m -> Value m -> Value m -> Value m
f

instance Applicative m => FnToValue (Value m -> Value m -> Value m -> Value m -> Value m -> Value m) m where
  fnToValue :: ObjectID
-> Maybe ProcedureDoc
-> (Value m -> Value m -> Value m -> Value m -> Value m -> Value m)
-> Value m
fnToValue ObjectID
oid Maybe ProcedureDoc
doc Value m -> Value m -> Value m -> Value m -> Value m -> Value m
f = Procedure m -> Value m
forall (m :: * -> *). Procedure m -> Value m
ProcedureV (Procedure m -> Value m)
-> ((Value m
     -> Value m -> Value m -> Value m -> Value m -> Value m)
    -> Procedure m)
-> (Value m -> Value m -> Value m -> Value m -> Value m -> Value m)
-> Value m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectID
-> Maybe ProcedureDoc
-> ([(Maybe Identifier, Value m)]
    -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
-> Procedure m
forall (m :: * -> *).
ObjectID
-> Maybe ProcedureDoc
-> ([(Maybe Identifier, Value m)]
    -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
-> Procedure m
NativeProcedure ObjectID
oid Maybe ProcedureDoc
doc (([(Maybe Identifier, Value m)]
  -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
 -> Procedure m)
-> ((Value m
     -> Value m -> Value m -> Value m -> Value m -> Value m)
    -> [(Maybe Identifier, Value m)]
    -> Context m
    -> SomePRNG
    -> m (Either RuntimeError (Value m)))
-> (Value m -> Value m -> Value m -> Value m -> Value m -> Value m)
-> Procedure m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value m -> Value m -> Value m -> Value m -> Value m -> Value m)
-> [(Maybe Identifier, Value m)]
-> Context m
-> SomePRNG
-> m (Either RuntimeError (Value m))
forall (m :: * -> *) a.
ToNativeProcedure m a =>
a
-> [(Maybe Identifier, Value m)]
-> Context m
-> SomePRNG
-> m (Either RuntimeError (Value m))
toNativeProcedure ((Value m -> Value m -> Value m -> Value m -> Value m -> Value m)
 -> Value m)
-> (Value m -> Value m -> Value m -> Value m -> Value m -> Value m)
-> Value m
forall a b. (a -> b) -> a -> b
$ Value m -> Value m -> Value m -> Value m -> Value m -> Value m
f


instance Applicative m => FnToValue (Value m -> m (Value m)) m where
  fnToValue :: ObjectID
-> Maybe ProcedureDoc -> (Value m -> m (Value m)) -> Value m
fnToValue ObjectID
oid Maybe ProcedureDoc
doc Value m -> m (Value m)
f = Procedure m -> Value m
forall (m :: * -> *). Procedure m -> Value m
ProcedureV (Procedure m -> Value m)
-> ((Value m -> m (Value m)) -> Procedure m)
-> (Value m -> m (Value m))
-> Value m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectID
-> Maybe ProcedureDoc
-> ([(Maybe Identifier, Value m)]
    -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
-> Procedure m
forall (m :: * -> *).
ObjectID
-> Maybe ProcedureDoc
-> ([(Maybe Identifier, Value m)]
    -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
-> Procedure m
NativeProcedure ObjectID
oid Maybe ProcedureDoc
doc (([(Maybe Identifier, Value m)]
  -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
 -> Procedure m)
-> ((Value m -> m (Value m))
    -> [(Maybe Identifier, Value m)]
    -> Context m
    -> SomePRNG
    -> m (Either RuntimeError (Value m)))
-> (Value m -> m (Value m))
-> Procedure m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value m -> m (Value m))
-> [(Maybe Identifier, Value m)]
-> Context m
-> SomePRNG
-> m (Either RuntimeError (Value m))
forall (m :: * -> *) a.
ToNativeProcedure m a =>
a
-> [(Maybe Identifier, Value m)]
-> Context m
-> SomePRNG
-> m (Either RuntimeError (Value m))
toNativeProcedure ((Value m -> m (Value m)) -> Value m)
-> (Value m -> m (Value m)) -> Value m
forall a b. (a -> b) -> a -> b
$ Value m -> m (Value m)
f

instance Applicative m => FnToValue (Value m -> Value m -> m (Value m)) m where
  fnToValue :: ObjectID
-> Maybe ProcedureDoc
-> (Value m -> Value m -> m (Value m))
-> Value m
fnToValue ObjectID
oid Maybe ProcedureDoc
doc Value m -> Value m -> m (Value m)
f = Procedure m -> Value m
forall (m :: * -> *). Procedure m -> Value m
ProcedureV (Procedure m -> Value m)
-> ((Value m -> Value m -> m (Value m)) -> Procedure m)
-> (Value m -> Value m -> m (Value m))
-> Value m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectID
-> Maybe ProcedureDoc
-> ([(Maybe Identifier, Value m)]
    -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
-> Procedure m
forall (m :: * -> *).
ObjectID
-> Maybe ProcedureDoc
-> ([(Maybe Identifier, Value m)]
    -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
-> Procedure m
NativeProcedure ObjectID
oid Maybe ProcedureDoc
doc (([(Maybe Identifier, Value m)]
  -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
 -> Procedure m)
-> ((Value m -> Value m -> m (Value m))
    -> [(Maybe Identifier, Value m)]
    -> Context m
    -> SomePRNG
    -> m (Either RuntimeError (Value m)))
-> (Value m -> Value m -> m (Value m))
-> Procedure m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value m -> Value m -> m (Value m))
-> [(Maybe Identifier, Value m)]
-> Context m
-> SomePRNG
-> m (Either RuntimeError (Value m))
forall (m :: * -> *) a.
ToNativeProcedure m a =>
a
-> [(Maybe Identifier, Value m)]
-> Context m
-> SomePRNG
-> m (Either RuntimeError (Value m))
toNativeProcedure ((Value m -> Value m -> m (Value m)) -> Value m)
-> (Value m -> Value m -> m (Value m)) -> Value m
forall a b. (a -> b) -> a -> b
$ Value m -> Value m -> m (Value m)
f

instance Applicative m => FnToValue (Value m -> Value m -> Value m -> m (Value m)) m where
  fnToValue :: ObjectID
-> Maybe ProcedureDoc
-> (Value m -> Value m -> Value m -> m (Value m))
-> Value m
fnToValue ObjectID
oid Maybe ProcedureDoc
doc Value m -> Value m -> Value m -> m (Value m)
f = Procedure m -> Value m
forall (m :: * -> *). Procedure m -> Value m
ProcedureV (Procedure m -> Value m)
-> ((Value m -> Value m -> Value m -> m (Value m)) -> Procedure m)
-> (Value m -> Value m -> Value m -> m (Value m))
-> Value m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectID
-> Maybe ProcedureDoc
-> ([(Maybe Identifier, Value m)]
    -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
-> Procedure m
forall (m :: * -> *).
ObjectID
-> Maybe ProcedureDoc
-> ([(Maybe Identifier, Value m)]
    -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
-> Procedure m
NativeProcedure ObjectID
oid Maybe ProcedureDoc
doc (([(Maybe Identifier, Value m)]
  -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
 -> Procedure m)
-> ((Value m -> Value m -> Value m -> m (Value m))
    -> [(Maybe Identifier, Value m)]
    -> Context m
    -> SomePRNG
    -> m (Either RuntimeError (Value m)))
-> (Value m -> Value m -> Value m -> m (Value m))
-> Procedure m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value m -> Value m -> Value m -> m (Value m))
-> [(Maybe Identifier, Value m)]
-> Context m
-> SomePRNG
-> m (Either RuntimeError (Value m))
forall (m :: * -> *) a.
ToNativeProcedure m a =>
a
-> [(Maybe Identifier, Value m)]
-> Context m
-> SomePRNG
-> m (Either RuntimeError (Value m))
toNativeProcedure ((Value m -> Value m -> Value m -> m (Value m)) -> Value m)
-> (Value m -> Value m -> Value m -> m (Value m)) -> Value m
forall a b. (a -> b) -> a -> b
$ Value m -> Value m -> Value m -> m (Value m)
f

instance Applicative m => FnToValue (Value m -> Value m -> Value m -> Value m -> m (Value m)) m where
  fnToValue :: ObjectID
-> Maybe ProcedureDoc
-> (Value m -> Value m -> Value m -> Value m -> m (Value m))
-> Value m
fnToValue ObjectID
oid Maybe ProcedureDoc
doc Value m -> Value m -> Value m -> Value m -> m (Value m)
f = Procedure m -> Value m
forall (m :: * -> *). Procedure m -> Value m
ProcedureV (Procedure m -> Value m)
-> ((Value m -> Value m -> Value m -> Value m -> m (Value m))
    -> Procedure m)
-> (Value m -> Value m -> Value m -> Value m -> m (Value m))
-> Value m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectID
-> Maybe ProcedureDoc
-> ([(Maybe Identifier, Value m)]
    -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
-> Procedure m
forall (m :: * -> *).
ObjectID
-> Maybe ProcedureDoc
-> ([(Maybe Identifier, Value m)]
    -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
-> Procedure m
NativeProcedure ObjectID
oid Maybe ProcedureDoc
doc (([(Maybe Identifier, Value m)]
  -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
 -> Procedure m)
-> ((Value m -> Value m -> Value m -> Value m -> m (Value m))
    -> [(Maybe Identifier, Value m)]
    -> Context m
    -> SomePRNG
    -> m (Either RuntimeError (Value m)))
-> (Value m -> Value m -> Value m -> Value m -> m (Value m))
-> Procedure m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value m -> Value m -> Value m -> Value m -> m (Value m))
-> [(Maybe Identifier, Value m)]
-> Context m
-> SomePRNG
-> m (Either RuntimeError (Value m))
forall (m :: * -> *) a.
ToNativeProcedure m a =>
a
-> [(Maybe Identifier, Value m)]
-> Context m
-> SomePRNG
-> m (Either RuntimeError (Value m))
toNativeProcedure ((Value m -> Value m -> Value m -> Value m -> m (Value m))
 -> Value m)
-> (Value m -> Value m -> Value m -> Value m -> m (Value m))
-> Value m
forall a b. (a -> b) -> a -> b
$ Value m -> Value m -> Value m -> Value m -> m (Value m)
f

instance Applicative m => FnToValue (Value m -> Value m -> Value m -> Value m -> Value m -> m (Value m)) m where
  fnToValue :: ObjectID
-> Maybe ProcedureDoc
-> (Value m
    -> Value m -> Value m -> Value m -> Value m -> m (Value m))
-> Value m
fnToValue ObjectID
oid Maybe ProcedureDoc
doc Value m -> Value m -> Value m -> Value m -> Value m -> m (Value m)
f = Procedure m -> Value m
forall (m :: * -> *). Procedure m -> Value m
ProcedureV (Procedure m -> Value m)
-> ((Value m
     -> Value m -> Value m -> Value m -> Value m -> m (Value m))
    -> Procedure m)
-> (Value m
    -> Value m -> Value m -> Value m -> Value m -> m (Value m))
-> Value m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectID
-> Maybe ProcedureDoc
-> ([(Maybe Identifier, Value m)]
    -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
-> Procedure m
forall (m :: * -> *).
ObjectID
-> Maybe ProcedureDoc
-> ([(Maybe Identifier, Value m)]
    -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
-> Procedure m
NativeProcedure ObjectID
oid Maybe ProcedureDoc
doc (([(Maybe Identifier, Value m)]
  -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
 -> Procedure m)
-> ((Value m
     -> Value m -> Value m -> Value m -> Value m -> m (Value m))
    -> [(Maybe Identifier, Value m)]
    -> Context m
    -> SomePRNG
    -> m (Either RuntimeError (Value m)))
-> (Value m
    -> Value m -> Value m -> Value m -> Value m -> m (Value m))
-> Procedure m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value m
 -> Value m -> Value m -> Value m -> Value m -> m (Value m))
-> [(Maybe Identifier, Value m)]
-> Context m
-> SomePRNG
-> m (Either RuntimeError (Value m))
forall (m :: * -> *) a.
ToNativeProcedure m a =>
a
-> [(Maybe Identifier, Value m)]
-> Context m
-> SomePRNG
-> m (Either RuntimeError (Value m))
toNativeProcedure ((Value m
  -> Value m -> Value m -> Value m -> Value m -> m (Value m))
 -> Value m)
-> (Value m
    -> Value m -> Value m -> Value m -> Value m -> m (Value m))
-> Value m
forall a b. (a -> b) -> a -> b
$ Value m -> Value m -> Value m -> Value m -> Value m -> m (Value m)
f


instance Applicative m => FnToValue (Value m -> m (Either RuntimeError (Value m))) m where
  fnToValue :: ObjectID
-> Maybe ProcedureDoc
-> (Value m -> m (Either RuntimeError (Value m)))
-> Value m
fnToValue ObjectID
oid Maybe ProcedureDoc
doc Value m -> m (Either RuntimeError (Value m))
f = Procedure m -> Value m
forall (m :: * -> *). Procedure m -> Value m
ProcedureV (Procedure m -> Value m)
-> ((Value m -> m (Either RuntimeError (Value m))) -> Procedure m)
-> (Value m -> m (Either RuntimeError (Value m)))
-> Value m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectID
-> Maybe ProcedureDoc
-> ([(Maybe Identifier, Value m)]
    -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
-> Procedure m
forall (m :: * -> *).
ObjectID
-> Maybe ProcedureDoc
-> ([(Maybe Identifier, Value m)]
    -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
-> Procedure m
NativeProcedure ObjectID
oid Maybe ProcedureDoc
doc (([(Maybe Identifier, Value m)]
  -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
 -> Procedure m)
-> ((Value m -> m (Either RuntimeError (Value m)))
    -> [(Maybe Identifier, Value m)]
    -> Context m
    -> SomePRNG
    -> m (Either RuntimeError (Value m)))
-> (Value m -> m (Either RuntimeError (Value m)))
-> Procedure m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value m -> m (Either RuntimeError (Value m)))
-> [(Maybe Identifier, Value m)]
-> Context m
-> SomePRNG
-> m (Either RuntimeError (Value m))
forall (m :: * -> *) a.
ToNativeProcedure m a =>
a
-> [(Maybe Identifier, Value m)]
-> Context m
-> SomePRNG
-> m (Either RuntimeError (Value m))
toNativeProcedure ((Value m -> m (Either RuntimeError (Value m))) -> Value m)
-> (Value m -> m (Either RuntimeError (Value m))) -> Value m
forall a b. (a -> b) -> a -> b
$ Value m -> m (Either RuntimeError (Value m))
f

instance Applicative m => FnToValue (Value m -> Value m -> m (Either RuntimeError (Value m))) m where
  fnToValue :: ObjectID
-> Maybe ProcedureDoc
-> (Value m -> Value m -> m (Either RuntimeError (Value m)))
-> Value m
fnToValue ObjectID
oid Maybe ProcedureDoc
doc Value m -> Value m -> m (Either RuntimeError (Value m))
f = Procedure m -> Value m
forall (m :: * -> *). Procedure m -> Value m
ProcedureV (Procedure m -> Value m)
-> ((Value m -> Value m -> m (Either RuntimeError (Value m)))
    -> Procedure m)
-> (Value m -> Value m -> m (Either RuntimeError (Value m)))
-> Value m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectID
-> Maybe ProcedureDoc
-> ([(Maybe Identifier, Value m)]
    -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
-> Procedure m
forall (m :: * -> *).
ObjectID
-> Maybe ProcedureDoc
-> ([(Maybe Identifier, Value m)]
    -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
-> Procedure m
NativeProcedure ObjectID
oid Maybe ProcedureDoc
doc (([(Maybe Identifier, Value m)]
  -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
 -> Procedure m)
-> ((Value m -> Value m -> m (Either RuntimeError (Value m)))
    -> [(Maybe Identifier, Value m)]
    -> Context m
    -> SomePRNG
    -> m (Either RuntimeError (Value m)))
-> (Value m -> Value m -> m (Either RuntimeError (Value m)))
-> Procedure m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value m -> Value m -> m (Either RuntimeError (Value m)))
-> [(Maybe Identifier, Value m)]
-> Context m
-> SomePRNG
-> m (Either RuntimeError (Value m))
forall (m :: * -> *) a.
ToNativeProcedure m a =>
a
-> [(Maybe Identifier, Value m)]
-> Context m
-> SomePRNG
-> m (Either RuntimeError (Value m))
toNativeProcedure ((Value m -> Value m -> m (Either RuntimeError (Value m)))
 -> Value m)
-> (Value m -> Value m -> m (Either RuntimeError (Value m)))
-> Value m
forall a b. (a -> b) -> a -> b
$ Value m -> Value m -> m (Either RuntimeError (Value m))
f

instance Applicative m => FnToValue (Value m -> Value m -> Value m -> m (Either RuntimeError (Value m))) m where
  fnToValue :: ObjectID
-> Maybe ProcedureDoc
-> (Value m
    -> Value m -> Value m -> m (Either RuntimeError (Value m)))
-> Value m
fnToValue ObjectID
oid Maybe ProcedureDoc
doc Value m -> Value m -> Value m -> m (Either RuntimeError (Value m))
f = Procedure m -> Value m
forall (m :: * -> *). Procedure m -> Value m
ProcedureV (Procedure m -> Value m)
-> ((Value m
     -> Value m -> Value m -> m (Either RuntimeError (Value m)))
    -> Procedure m)
-> (Value m
    -> Value m -> Value m -> m (Either RuntimeError (Value m)))
-> Value m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectID
-> Maybe ProcedureDoc
-> ([(Maybe Identifier, Value m)]
    -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
-> Procedure m
forall (m :: * -> *).
ObjectID
-> Maybe ProcedureDoc
-> ([(Maybe Identifier, Value m)]
    -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
-> Procedure m
NativeProcedure ObjectID
oid Maybe ProcedureDoc
doc (([(Maybe Identifier, Value m)]
  -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
 -> Procedure m)
-> ((Value m
     -> Value m -> Value m -> m (Either RuntimeError (Value m)))
    -> [(Maybe Identifier, Value m)]
    -> Context m
    -> SomePRNG
    -> m (Either RuntimeError (Value m)))
-> (Value m
    -> Value m -> Value m -> m (Either RuntimeError (Value m)))
-> Procedure m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value m
 -> Value m -> Value m -> m (Either RuntimeError (Value m)))
-> [(Maybe Identifier, Value m)]
-> Context m
-> SomePRNG
-> m (Either RuntimeError (Value m))
forall (m :: * -> *) a.
ToNativeProcedure m a =>
a
-> [(Maybe Identifier, Value m)]
-> Context m
-> SomePRNG
-> m (Either RuntimeError (Value m))
toNativeProcedure ((Value m
  -> Value m -> Value m -> m (Either RuntimeError (Value m)))
 -> Value m)
-> (Value m
    -> Value m -> Value m -> m (Either RuntimeError (Value m)))
-> Value m
forall a b. (a -> b) -> a -> b
$ Value m -> Value m -> Value m -> m (Either RuntimeError (Value m))
f

instance Applicative m => FnToValue (Value m -> Value m -> Value m -> Value m -> m (Either RuntimeError (Value m))) m where
  fnToValue :: ObjectID
-> Maybe ProcedureDoc
-> (Value m
    -> Value m
    -> Value m
    -> Value m
    -> m (Either RuntimeError (Value m)))
-> Value m
fnToValue ObjectID
oid Maybe ProcedureDoc
doc Value m
-> Value m
-> Value m
-> Value m
-> m (Either RuntimeError (Value m))
f = Procedure m -> Value m
forall (m :: * -> *). Procedure m -> Value m
ProcedureV (Procedure m -> Value m)
-> ((Value m
     -> Value m
     -> Value m
     -> Value m
     -> m (Either RuntimeError (Value m)))
    -> Procedure m)
-> (Value m
    -> Value m
    -> Value m
    -> Value m
    -> m (Either RuntimeError (Value m)))
-> Value m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectID
-> Maybe ProcedureDoc
-> ([(Maybe Identifier, Value m)]
    -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
-> Procedure m
forall (m :: * -> *).
ObjectID
-> Maybe ProcedureDoc
-> ([(Maybe Identifier, Value m)]
    -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
-> Procedure m
NativeProcedure ObjectID
oid Maybe ProcedureDoc
doc (([(Maybe Identifier, Value m)]
  -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
 -> Procedure m)
-> ((Value m
     -> Value m
     -> Value m
     -> Value m
     -> m (Either RuntimeError (Value m)))
    -> [(Maybe Identifier, Value m)]
    -> Context m
    -> SomePRNG
    -> m (Either RuntimeError (Value m)))
-> (Value m
    -> Value m
    -> Value m
    -> Value m
    -> m (Either RuntimeError (Value m)))
-> Procedure m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value m
 -> Value m
 -> Value m
 -> Value m
 -> m (Either RuntimeError (Value m)))
-> [(Maybe Identifier, Value m)]
-> Context m
-> SomePRNG
-> m (Either RuntimeError (Value m))
forall (m :: * -> *) a.
ToNativeProcedure m a =>
a
-> [(Maybe Identifier, Value m)]
-> Context m
-> SomePRNG
-> m (Either RuntimeError (Value m))
toNativeProcedure ((Value m
  -> Value m
  -> Value m
  -> Value m
  -> m (Either RuntimeError (Value m)))
 -> Value m)
-> (Value m
    -> Value m
    -> Value m
    -> Value m
    -> m (Either RuntimeError (Value m)))
-> Value m
forall a b. (a -> b) -> a -> b
$ Value m
-> Value m
-> Value m
-> Value m
-> m (Either RuntimeError (Value m))
f

instance Applicative m => FnToValue (Value m -> Value m -> Value m -> Value m -> Value m -> m (Either RuntimeError (Value m))) m where
  fnToValue :: ObjectID
-> Maybe ProcedureDoc
-> (Value m
    -> Value m
    -> Value m
    -> Value m
    -> Value m
    -> m (Either RuntimeError (Value m)))
-> Value m
fnToValue ObjectID
oid Maybe ProcedureDoc
doc Value m
-> Value m
-> Value m
-> Value m
-> Value m
-> m (Either RuntimeError (Value m))
f = Procedure m -> Value m
forall (m :: * -> *). Procedure m -> Value m
ProcedureV (Procedure m -> Value m)
-> ((Value m
     -> Value m
     -> Value m
     -> Value m
     -> Value m
     -> m (Either RuntimeError (Value m)))
    -> Procedure m)
-> (Value m
    -> Value m
    -> Value m
    -> Value m
    -> Value m
    -> m (Either RuntimeError (Value m)))
-> Value m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectID
-> Maybe ProcedureDoc
-> ([(Maybe Identifier, Value m)]
    -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
-> Procedure m
forall (m :: * -> *).
ObjectID
-> Maybe ProcedureDoc
-> ([(Maybe Identifier, Value m)]
    -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
-> Procedure m
NativeProcedure ObjectID
oid Maybe ProcedureDoc
doc (([(Maybe Identifier, Value m)]
  -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
 -> Procedure m)
-> ((Value m
     -> Value m
     -> Value m
     -> Value m
     -> Value m
     -> m (Either RuntimeError (Value m)))
    -> [(Maybe Identifier, Value m)]
    -> Context m
    -> SomePRNG
    -> m (Either RuntimeError (Value m)))
-> (Value m
    -> Value m
    -> Value m
    -> Value m
    -> Value m
    -> m (Either RuntimeError (Value m)))
-> Procedure m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value m
 -> Value m
 -> Value m
 -> Value m
 -> Value m
 -> m (Either RuntimeError (Value m)))
-> [(Maybe Identifier, Value m)]
-> Context m
-> SomePRNG
-> m (Either RuntimeError (Value m))
forall (m :: * -> *) a.
ToNativeProcedure m a =>
a
-> [(Maybe Identifier, Value m)]
-> Context m
-> SomePRNG
-> m (Either RuntimeError (Value m))
toNativeProcedure ((Value m
  -> Value m
  -> Value m
  -> Value m
  -> Value m
  -> m (Either RuntimeError (Value m)))
 -> Value m)
-> (Value m
    -> Value m
    -> Value m
    -> Value m
    -> Value m
    -> m (Either RuntimeError (Value m)))
-> Value m
forall a b. (a -> b) -> a -> b
$ Value m
-> Value m
-> Value m
-> Value m
-> Value m
-> m (Either RuntimeError (Value m))
f

--------------------------------------------------------------------------------
-- Procedure helpers
--------------------------------------------------------------------------------

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

eitherExceptM :: (Monad m, MonadError e (t m), MonadTrans t)
              => m (Either e a) -> t m a
eitherExceptM :: forall (m :: * -> *) e (t :: (* -> *) -> * -> *) a.
(Monad m, MonadError e (t m), MonadTrans t) =>
m (Either e a) -> t m a
eitherExceptM = (t m (Either e a) -> (Either e a -> t m a) -> t m a
forall a b. t m a -> (a -> t m b) -> t m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either e a -> t m a
forall (m :: * -> *) e (t :: (* -> *) -> * -> *) a.
(Monad m, MonadError e (t m)) =>
Either e a -> t m a
eitherExcept) (t m (Either e a) -> t m a)
-> (m (Either e a) -> t m (Either e a)) -> m (Either e a) -> t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Either e a) -> t m (Either e a)
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

resolveArgs :: Text
            -> [(Identifier, Maybe (Value m))]
            -> [(Maybe Identifier, Value m)]
            -> Either RuntimeError (Map Identifier (Value m))
resolveArgs :: forall (m :: * -> *).
Text
-> [(Identifier, Maybe (Value m))]
-> [(Maybe Identifier, Value m)]
-> Either RuntimeError (Map Identifier (Value m))
resolveArgs Text
context [(Identifier, Maybe (Value m))]
specs [(Maybe Identifier, Value m)]
args =
  let kwargs0 :: Map Identifier (Value m)
kwargs0 = [(Identifier, Value m)] -> Map Identifier (Value m)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Identifier
k, Value m
v) | (Just Identifier
k, Value m
v) <- [(Maybe Identifier, Value m)]
args]
      varargs0 :: [Value m]
varargs0 = [Value m
v | (Maybe Identifier
Nothing, Value m
v) <- [(Maybe Identifier, Value m)]
args]
  in [(Identifier, Maybe (Value m))]
-> Map Identifier (Value m)
-> [Value m]
-> Either RuntimeError (Map Identifier (Value m))
forall {m :: * -> *}.
[(Identifier, Maybe (Value m))]
-> Map Identifier (Value m)
-> [Value m]
-> Either RuntimeError (Map Identifier (Value m))
go [(Identifier, Maybe (Value m))]
specs Map Identifier (Value m)
kwargs0 [Value m]
varargs0
  where
    go :: [(Identifier, Maybe (Value m))]
-> Map Identifier (Value m)
-> [Value m]
-> Either RuntimeError (Map Identifier (Value m))
go ((Identifier
argName, Maybe (Value m)
defVal):[(Identifier, Maybe (Value m))]
xs) Map Identifier (Value m)
kwargs [Value m]
varargs =
      case Identifier -> Map Identifier (Value m) -> Maybe (Value m)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Identifier
argName Map Identifier (Value m)
kwargs of
        Maybe (Value m)
Nothing ->
          -- positional argument
          case [Value m]
varargs of
            [] ->
              -- No more arguments passed, look for default value
              Either RuntimeError (Map Identifier (Value m))
-> (Value m -> Either RuntimeError (Map Identifier (Value m)))
-> Maybe (Value m)
-> Either RuntimeError (Map Identifier (Value m))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                -- No default, argument required
                (RuntimeError -> Either RuntimeError (Map Identifier (Value m))
forall a b. a -> Either a b
Left (RuntimeError -> Either RuntimeError (Map Identifier (Value m)))
-> RuntimeError -> Either RuntimeError (Map Identifier (Value m))
forall a b. (a -> b) -> a -> b
$
                  Text -> Text -> Text -> Text -> RuntimeError
ArgumentError
                    Text
context
                    (Identifier -> Text
identifierName Identifier
argName)
                    Text
"argument"
                    Text
"end of arguments"
                )
                -- Default exists, use it.
                (\Value m
val ->
                  Identifier
-> Value m -> Map Identifier (Value m) -> Map Identifier (Value m)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Identifier
argName Value m
val (Map Identifier (Value m) -> Map Identifier (Value m))
-> Either RuntimeError (Map Identifier (Value m))
-> Either RuntimeError (Map Identifier (Value m))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Identifier, Maybe (Value m))]
-> Map Identifier (Value m)
-> [Value m]
-> Either RuntimeError (Map Identifier (Value m))
go [(Identifier, Maybe (Value m))]
xs Map Identifier (Value m)
kwargs [Value m]
varargs
                )
                Maybe (Value m)
defVal
            (Value m
v:[Value m]
varargs') ->
              -- Argument passed, use it.
              Identifier
-> Value m -> Map Identifier (Value m) -> Map Identifier (Value m)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Identifier
argName Value m
v (Map Identifier (Value m) -> Map Identifier (Value m))
-> Either RuntimeError (Map Identifier (Value m))
-> Either RuntimeError (Map Identifier (Value m))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Identifier, Maybe (Value m))]
-> Map Identifier (Value m)
-> [Value m]
-> Either RuntimeError (Map Identifier (Value m))
go [(Identifier, Maybe (Value m))]
xs Map Identifier (Value m)
kwargs [Value m]
varargs'
        Just Value m
v ->
          -- Keyword argument found.
          Identifier
-> Value m -> Map Identifier (Value m) -> Map Identifier (Value m)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Identifier
argName Value m
v (Map Identifier (Value m) -> Map Identifier (Value m))
-> Either RuntimeError (Map Identifier (Value m))
-> Either RuntimeError (Map Identifier (Value m))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Identifier, Maybe (Value m))]
-> Map Identifier (Value m)
-> [Value m]
-> Either RuntimeError (Map Identifier (Value m))
go [(Identifier, Maybe (Value m))]
xs (Identifier -> Map Identifier (Value m) -> Map Identifier (Value m)
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Identifier
argName Map Identifier (Value m)
kwargs) [Value m]
varargs

    go [] Map Identifier (Value m)
kwargs [Value m]
varargs =
        -- Map remaining arguments to @varargs@ and @kwargs@.
        Map Identifier (Value m)
-> Either RuntimeError (Map Identifier (Value m))
forall a b. b -> Either a b
Right (Map Identifier (Value m)
 -> Either RuntimeError (Map Identifier (Value m)))
-> Map Identifier (Value m)
-> Either RuntimeError (Map Identifier (Value m))
forall a b. (a -> b) -> a -> b
$ [(Identifier, Value m)] -> Map Identifier (Value m)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
          [ (Identifier
"varargs", Vector (Value m) -> Value m
forall (m :: * -> *). Vector (Value m) -> Value m
ListV (Vector (Value m) -> Value m) -> Vector (Value m) -> Value m
forall a b. (a -> b) -> a -> b
$ [Value m] -> Vector (Value m)
forall a. [a] -> Vector a
V.fromList [Value m]
varargs)
          , (Identifier
"kwargs", Map Scalar (Value m) -> Value m
forall (m :: * -> *). Map Scalar (Value m) -> Value m
DictV ((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) Map Identifier (Value m)
kwargs))
          ]

leftNaN :: Double -> Either RuntimeError Double
leftNaN :: Double -> Either RuntimeError Double
leftNaN Double
c | Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
c = RuntimeError -> Either RuntimeError Double
forall a b. a -> Either a b
Left (RuntimeError -> Either RuntimeError Double)
-> RuntimeError -> Either RuntimeError Double
forall a b. (a -> b) -> a -> b
$ Text -> Text -> RuntimeError
NumericError Text
"<unknown>" Text
"not a number"
leftNaN Double
c | Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Double
c = RuntimeError -> Either RuntimeError Double
forall a b. a -> Either a b
Left (RuntimeError -> Either RuntimeError Double)
-> RuntimeError -> Either RuntimeError Double
forall a b. (a -> b) -> a -> b
$ Text -> Text -> RuntimeError
NumericError Text
"<unknown>" Text
"infinity"
leftNaN Double
c = Double -> Either RuntimeError Double
forall a b. b -> Either a b
Right Double
c

numericFunc :: Monad m
             => (Integer -> Integer)
             -> (Double -> Double)
             -> Value m
             -> Either RuntimeError (Value m)
numericFunc :: forall (m :: * -> *).
Monad m =>
(Integer -> Integer)
-> (Double -> Double) -> Value m -> Either RuntimeError (Value m)
numericFunc Integer -> Integer
f Double -> Double
g =
  (Integer -> Either RuntimeError Integer)
-> (Double -> Either RuntimeError Double)
-> Value m
-> Either RuntimeError (Value m)
forall (m :: * -> *).
Monad m =>
(Integer -> Either RuntimeError Integer)
-> (Double -> Either RuntimeError Double)
-> Value m
-> Either RuntimeError (Value m)
numericFuncCatch Integer -> Either RuntimeError Integer
forall {a}. Integer -> Either a Integer
f' Double -> Either RuntimeError Double
forall {a}. Double -> Either a Double
g'
  where
    f' :: Integer -> Either a Integer
f' Integer
x = Integer -> Either a Integer
forall a b. b -> Either a b
Right (Integer -> Integer
f Integer
x)
    g' :: Double -> Either a Double
g' Double
x = Double -> Either a Double
forall a b. b -> Either a b
Right (Double -> Double
g Double
x)

numericFuncCatch :: Monad m
                  => (Integer -> Either RuntimeError Integer)
                  -> (Double -> Either RuntimeError Double)
                  -> Value m
                  -> Either RuntimeError (Value m)
numericFuncCatch :: forall (m :: * -> *).
Monad m =>
(Integer -> Either RuntimeError Integer)
-> (Double -> Either RuntimeError Double)
-> Value m
-> Either RuntimeError (Value m)
numericFuncCatch Integer -> Either RuntimeError Integer
f Double -> Either RuntimeError Double
_ (IntV Integer
a) = Integer -> Value m
forall (m :: * -> *). Integer -> Value m
IntV (Integer -> Value m)
-> Either RuntimeError Integer -> Either RuntimeError (Value m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> Either RuntimeError Integer
f Integer
a
numericFuncCatch Integer -> Either RuntimeError Integer
_ Double -> Either RuntimeError Double
f (FloatV Double
a) = Double -> Value m
forall (m :: * -> *). Double -> Value m
FloatV (Double -> Value m)
-> Either RuntimeError Double -> Either RuntimeError (Value m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Double -> Either RuntimeError Double
leftNaN (Double -> Either RuntimeError Double)
-> Either RuntimeError Double -> Either RuntimeError Double
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Double -> Either RuntimeError Double
f Double
a)
numericFuncCatch Integer -> Either RuntimeError Integer
_ Double -> Either RuntimeError Double
_ Value m
a = RuntimeError -> Either RuntimeError (Value m)
forall a b. a -> Either a b
Left (Text -> Text -> Text -> RuntimeError
TagError Text
"<unknown>" Text
"number" (Value m -> Text
forall (m :: * -> *). Value m -> Text
tagNameOf Value m
a))

asOptionalVal :: (Value m -> Either RuntimeError a) -> Value m -> Either RuntimeError (Maybe a)
asOptionalVal :: forall (m :: * -> *) a.
(Value m -> Either RuntimeError a)
-> Value m -> Either RuntimeError (Maybe a)
asOptionalVal Value m -> Either RuntimeError a
_ Value m
NoneV = Maybe a -> Either RuntimeError (Maybe a)
forall a b. b -> Either a b
Right Maybe a
forall a. Maybe a
Nothing
asOptionalVal Value m -> Either RuntimeError a
asVal Value m
x = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a)
-> Either RuntimeError a -> Either RuntimeError (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value m -> Either RuntimeError a
asVal Value m
x

asIntVal :: Text -> Value m -> Either RuntimeError Integer
asIntVal :: forall (m :: * -> *).
Text -> Value m -> Either RuntimeError Integer
asIntVal Text
_ (IntV Integer
a) = Integer -> Either RuntimeError Integer
forall a b. b -> Either a b
Right Integer
a
asIntVal Text
context Value m
x = RuntimeError -> Either RuntimeError Integer
forall a b. a -> Either a b
Left (RuntimeError -> Either RuntimeError Integer)
-> RuntimeError -> Either RuntimeError Integer
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> RuntimeError
TagError Text
context Text
"int" (Value m -> Text
forall (m :: * -> *). Value m -> Text
tagNameOf Value m
x)

asFloatVal :: Text -> Value m -> Either RuntimeError Double
asFloatVal :: forall (m :: * -> *). Text -> Value m -> Either RuntimeError Double
asFloatVal Text
_ (FloatV Double
a) = Double -> Either RuntimeError Double
forall a b. b -> Either a b
Right Double
a
asFloatVal Text
_ (IntV Integer
a) = Double -> Either RuntimeError Double
forall a b. b -> Either a b
Right (Integer -> Double
forall a. Num a => Integer -> a
fromInteger Integer
a)
asFloatVal Text
context Value m
x = RuntimeError -> Either RuntimeError Double
forall a b. a -> Either a b
Left (RuntimeError -> Either RuntimeError Double)
-> RuntimeError -> Either RuntimeError Double
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> RuntimeError
TagError Text
context Text
"float" (Value m -> Text
forall (m :: * -> *). Value m -> Text
tagNameOf Value m
x)

asFloatValLenient :: Double -> Value m -> Double
asFloatValLenient :: forall (m :: * -> *). Double -> Value m -> Double
asFloatValLenient Double
_ (FloatV Double
a) = Double
a
asFloatValLenient Double
_ (IntV Integer
a) = Integer -> Double
forall a. Num a => Integer -> a
fromInteger Integer
a
asFloatValLenient Double
def (StringV Text
a) = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
def (Maybe Double -> Double) -> Maybe Double -> Double
forall a b. (a -> b) -> a -> b
$ String -> Maybe Double
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
Text.unpack Text
a)
asFloatValLenient Double
def Value m
_ = Double
def

asBoolVal :: Text -> Value m -> Either RuntimeError Bool
asBoolVal :: forall (m :: * -> *). Text -> Value m -> Either RuntimeError Bool
asBoolVal Text
_ (BoolV Bool
a) = Bool -> Either RuntimeError Bool
forall a b. b -> Either a b
Right Bool
a
asBoolVal Text
_ Value m
NoneV = Bool -> Either RuntimeError Bool
forall a b. b -> Either a b
Right Bool
False
asBoolVal Text
context Value m
x = 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 -> RuntimeError
TagError Text
context Text
"bool" (Value m -> Text
forall (m :: * -> *). Value m -> Text
tagNameOf Value m
x)

-- | Lenient version of 'asBoolVal', will also work on strings, numbers, lists,
-- and dicts.
asTruthVal :: Text -> Value m -> Either RuntimeError Bool
asTruthVal :: forall (m :: * -> *). Text -> Value m -> Either RuntimeError Bool
asTruthVal Text
_ (BoolV Bool
a) = Bool -> Either RuntimeError Bool
forall a b. b -> Either a b
Right Bool
a
asTruthVal Text
_ Value m
NoneV = Bool -> Either RuntimeError Bool
forall a b. b -> Either a b
Right Bool
False
asTruthVal Text
_ (StringV Text
t) = Bool -> Either RuntimeError Bool
forall a b. b -> Either a b
Right (Bool -> Either RuntimeError Bool)
-> (Text -> Bool) -> Text -> Either RuntimeError Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
Text.null (Text -> Either RuntimeError Bool)
-> Text -> Either RuntimeError Bool
forall a b. (a -> b) -> a -> b
$ Text
t
asTruthVal Text
_ (BytesV ByteString
t) = Bool -> Either RuntimeError Bool
forall a b. b -> Either a b
Right (Bool -> Either RuntimeError Bool)
-> (ByteString -> Bool) -> ByteString -> Either RuntimeError Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not (Bool -> Bool) -> (ByteString -> Bool) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bool
BS.null (ByteString -> Either RuntimeError Bool)
-> ByteString -> Either RuntimeError Bool
forall a b. (a -> b) -> a -> b
$ ByteString
t
asTruthVal Text
_ (EncodedV (Encoded Text
t)) = Bool -> Either RuntimeError Bool
forall a b. b -> Either a b
Right (Bool -> Either RuntimeError Bool)
-> (Text -> Bool) -> Text -> Either RuntimeError Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
Text.null (Text -> Either RuntimeError Bool)
-> Text -> Either RuntimeError Bool
forall a b. (a -> b) -> a -> b
$ Text
t
asTruthVal Text
_ (IntV Integer
i) = Bool -> Either RuntimeError Bool
forall a b. b -> Either a b
Right (Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0)
asTruthVal Text
_ (FloatV Double
i) = Bool -> Either RuntimeError Bool
forall a b. b -> Either a b
Right (Double
i Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
/= Double
0)
asTruthVal Text
_ (ListV Vector (Value m)
xs) = Bool -> Either RuntimeError Bool
forall a b. b -> Either a b
Right (Bool -> Either RuntimeError Bool)
-> (Vector (Value m) -> Bool)
-> Vector (Value m)
-> Either RuntimeError Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not (Bool -> Bool)
-> (Vector (Value m) -> Bool) -> Vector (Value m) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (Value m) -> Bool
forall a. Vector a -> Bool
V.null (Vector (Value m) -> Either RuntimeError Bool)
-> Vector (Value m) -> Either RuntimeError Bool
forall a b. (a -> b) -> a -> b
$ Vector (Value m)
xs
asTruthVal Text
_ (DictV Map Scalar (Value m)
xs) = Bool -> Either RuntimeError Bool
forall a b. b -> Either a b
Right (Bool -> Either RuntimeError Bool)
-> (Map Scalar (Value m) -> Bool)
-> Map Scalar (Value m)
-> Either RuntimeError Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not (Bool -> Bool)
-> (Map Scalar (Value m) -> Bool) -> Map Scalar (Value m) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Scalar (Value m) -> Bool
forall k a. Map k a -> Bool
Map.null (Map Scalar (Value m) -> Either RuntimeError Bool)
-> Map Scalar (Value m) -> Either RuntimeError Bool
forall a b. (a -> b) -> a -> b
$ Map Scalar (Value m)
xs
asTruthVal Text
context Value m
x = 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 -> RuntimeError
TagError Text
contextText
"bool" (Value m -> Text
forall (m :: * -> *). Value m -> Text
tagNameOf Value m
x)

asVectorVal :: Monad m => Value m -> m (Either RuntimeError (Vector (Value m)))
asVectorVal :: forall (m :: * -> *).
Monad m =>
Value m -> m (Either RuntimeError (Vector (Value m)))
asVectorVal (ListV Vector (Value m)
a) = Either RuntimeError (Vector (Value m))
-> m (Either RuntimeError (Vector (Value m)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError (Vector (Value m))
 -> m (Either RuntimeError (Vector (Value m))))
-> (Vector (Value m) -> Either RuntimeError (Vector (Value m)))
-> Vector (Value m)
-> m (Either RuntimeError (Vector (Value m)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (Value m) -> Either RuntimeError (Vector (Value m))
forall a b. b -> Either a b
Right (Vector (Value m) -> m (Either RuntimeError (Vector (Value m))))
-> Vector (Value m) -> m (Either RuntimeError (Vector (Value m)))
forall a b. (a -> b) -> a -> b
$ Vector (Value m)
a
asVectorVal (NativeV NativeObject m
n) =
  Either RuntimeError (Vector (Value m))
-> (Vector (Value m) -> Either RuntimeError (Vector (Value m)))
-> Maybe (Vector (Value m))
-> Either RuntimeError (Vector (Value m))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (RuntimeError -> Either RuntimeError (Vector (Value m))
forall a b. a -> Either a b
Left (RuntimeError -> Either RuntimeError (Vector (Value m)))
-> RuntimeError -> Either RuntimeError (Vector (Value m))
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> RuntimeError
TagError Text
"conversion to list" Text
"list" Text
"non-list native object")
    Vector (Value m) -> Either RuntimeError (Vector (Value m))
forall a b. b -> Either a b
Right (Maybe (Vector (Value m))
 -> Either RuntimeError (Vector (Value m)))
-> m (Maybe (Vector (Value m)))
-> m (Either RuntimeError (Vector (Value m)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    NativeObject m -> m (Maybe (Vector (Value m)))
forall (m :: * -> *).
NativeObject m -> m (Maybe (Vector (Value m)))
nativeObjectAsList NativeObject m
n
asVectorVal Value m
x = Either RuntimeError (Vector (Value m))
-> m (Either RuntimeError (Vector (Value m)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError (Vector (Value m))
 -> m (Either RuntimeError (Vector (Value m))))
-> (RuntimeError -> Either RuntimeError (Vector (Value m)))
-> RuntimeError
-> m (Either RuntimeError (Vector (Value m)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuntimeError -> Either RuntimeError (Vector (Value m))
forall a b. a -> Either a b
Left (RuntimeError -> m (Either RuntimeError (Vector (Value m))))
-> RuntimeError -> m (Either RuntimeError (Vector (Value m)))
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> RuntimeError
TagError Text
"conversion to list" Text
"list" (Value m -> Text
forall (m :: * -> *). Value m -> Text
tagNameOf Value m
x)

asListVal :: Monad m => Value m -> m (Either RuntimeError [Value m])
asListVal :: forall (m :: * -> *).
Monad m =>
Value m -> m (Either RuntimeError [Value m])
asListVal (ListV Vector (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
$ Vector (Value m) -> [Value m]
forall a. Vector a -> [a]
V.toList Vector (Value m)
a
asListVal (NativeV NativeObject m
n) =
  Either RuntimeError [Value m]
-> (Vector (Value m) -> Either RuntimeError [Value m])
-> Maybe (Vector (Value m))
-> Either RuntimeError [Value m]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (RuntimeError -> Either RuntimeError [Value m]
forall a b. a -> Either a b
Left (RuntimeError -> Either RuntimeError [Value m])
-> RuntimeError -> Either RuntimeError [Value m]
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> RuntimeError
TagError Text
"conversion to list" Text
"list" Text
"non-list native object")
    ([Value m] -> Either RuntimeError [Value m]
forall a b. b -> Either a b
Right ([Value m] -> Either RuntimeError [Value m])
-> (Vector (Value m) -> [Value m])
-> Vector (Value m)
-> Either RuntimeError [Value m]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (Value m) -> [Value m]
forall a. Vector a -> [a]
V.toList) (Maybe (Vector (Value m)) -> Either RuntimeError [Value m])
-> m (Maybe (Vector (Value m)))
-> m (Either RuntimeError [Value m])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    NativeObject m -> m (Maybe (Vector (Value m)))
forall (m :: * -> *).
NativeObject m -> m (Maybe (Vector (Value m)))
nativeObjectAsList NativeObject m
n
asListVal Value m
x = Either RuntimeError [Value m] -> m (Either RuntimeError [Value m])
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError [Value m]
 -> m (Either RuntimeError [Value m]))
-> (RuntimeError -> Either RuntimeError [Value m])
-> RuntimeError
-> m (Either RuntimeError [Value m])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuntimeError -> Either RuntimeError [Value m]
forall a b. a -> Either a b
Left (RuntimeError -> m (Either RuntimeError [Value m]))
-> RuntimeError -> m (Either RuntimeError [Value m])
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> RuntimeError
TagError Text
"conversion to list" Text
"list" (Value m -> Text
forall (m :: * -> *). Value m -> Text
tagNameOf Value m
x)

asDictVal :: Monad m => Value m -> m (Either RuntimeError (Map Scalar (Value m)))
asDictVal :: forall (m :: * -> *).
Monad m =>
Value m -> m (Either RuntimeError (Map Scalar (Value m)))
asDictVal (DictV Map Scalar (Value m)
a) = Either RuntimeError (Map Scalar (Value m))
-> m (Either RuntimeError (Map Scalar (Value m)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError (Map Scalar (Value m))
 -> m (Either RuntimeError (Map Scalar (Value m))))
-> Either RuntimeError (Map Scalar (Value m))
-> m (Either RuntimeError (Map Scalar (Value m)))
forall a b. (a -> b) -> a -> b
$ Map Scalar (Value m) -> Either RuntimeError (Map Scalar (Value m))
forall a b. b -> Either a b
Right Map Scalar (Value m)
a
asDictVal (NativeV NativeObject m
n) =
  Either RuntimeError (Map Scalar (Value m))
-> (Map Scalar (Value m)
    -> Either RuntimeError (Map Scalar (Value m)))
-> Maybe (Map Scalar (Value m))
-> Either RuntimeError (Map Scalar (Value m))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (RuntimeError -> Either RuntimeError (Map Scalar (Value m))
forall a b. a -> Either a b
Left (RuntimeError -> Either RuntimeError (Map Scalar (Value m)))
-> RuntimeError -> Either RuntimeError (Map Scalar (Value m))
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> RuntimeError
TagError Text
"conversion to dict" Text
"dict" Text
"non-dict native object")
    Map Scalar (Value m) -> Either RuntimeError (Map Scalar (Value m))
forall a b. b -> Either a b
Right (Maybe (Map Scalar (Value m))
 -> Either RuntimeError (Map Scalar (Value m)))
-> m (Maybe (Map Scalar (Value m)))
-> m (Either RuntimeError (Map Scalar (Value m)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    NativeObject m -> m (Maybe (Map Scalar (Value m)))
forall (m :: * -> *).
Monad m =>
NativeObject m -> m (Maybe (Map Scalar (Value m)))
nativeObjectAsDict NativeObject m
n
asDictVal Value m
x = Either RuntimeError (Map Scalar (Value m))
-> m (Either RuntimeError (Map Scalar (Value m)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RuntimeError (Map Scalar (Value m))
 -> m (Either RuntimeError (Map Scalar (Value m))))
-> (RuntimeError -> Either RuntimeError (Map Scalar (Value m)))
-> RuntimeError
-> m (Either RuntimeError (Map Scalar (Value m)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuntimeError -> Either RuntimeError (Map Scalar (Value m))
forall a b. a -> Either a b
Left (RuntimeError -> m (Either RuntimeError (Map Scalar (Value m))))
-> RuntimeError -> m (Either RuntimeError (Map Scalar (Value m)))
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> RuntimeError
TagError Text
"conversion to dict" Text
"dict" (Value m -> Text
forall (m :: * -> *). Value m -> Text
tagNameOf Value m
x)

asTextVal :: Value m -> Either RuntimeError Text
asTextVal :: forall (m :: * -> *). Value m -> Either RuntimeError Text
asTextVal (StringV Text
a) = Text -> Either RuntimeError Text
forall a b. b -> Either a b
Right Text
a
asTextVal (EncodedV (Encoded Text
a)) = Text -> Either RuntimeError Text
forall a b. b -> Either a b
Right Text
a
asTextVal (IntV Integer
a) = Text -> Either RuntimeError Text
forall a b. b -> Either a b
Right (Integer -> Text
forall a. Show a => a -> Text
Text.show Integer
a)
asTextVal (FloatV Double
a) = Text -> Either RuntimeError Text
forall a b. b -> Either a b
Right (Double -> Text
forall a. Show a => a -> Text
Text.show Double
a)
asTextVal Value m
NoneV = Text -> Either RuntimeError Text
forall a b. b -> Either a b
Right Text
""
asTextVal Value m
x = RuntimeError -> Either RuntimeError Text
forall a b. a -> Either a b
Left (RuntimeError -> Either RuntimeError Text)
-> RuntimeError -> Either RuntimeError Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> RuntimeError
TagError Text
"conversion to string" Text
"string" (Value m -> Text
forall (m :: * -> *). Value m -> Text
tagNameOf Value m
x)

asScalarVal :: Value m -> Either RuntimeError Scalar
asScalarVal :: forall (m :: * -> *). Value m -> Either RuntimeError Scalar
asScalarVal (ScalarV Scalar
a) = Scalar -> Either RuntimeError Scalar
forall a b. b -> Either a b
Right Scalar
a
asScalarVal Value m
x = RuntimeError -> Either RuntimeError Scalar
forall a b. a -> Either a b
Left (RuntimeError -> Either RuntimeError Scalar)
-> RuntimeError -> Either RuntimeError Scalar
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> RuntimeError
TagError Text
"conversion to scalar" Text
"scalar" (Value m -> Text
forall (m :: * -> *). Value m -> Text
tagNameOf Value m
x)

intFunc :: (Monad m, ToValue a m)
         => (Integer -> Either RuntimeError a)
         -> Value m
         -> Either RuntimeError (Value m)
intFunc :: forall (m :: * -> *) a.
(Monad m, ToValue a m) =>
(Integer -> Either RuntimeError a)
-> Value m -> Either RuntimeError (Value m)
intFunc Integer -> Either RuntimeError a
f Value m
a = a -> Value m
forall a (m :: * -> *). ToValue a m => a -> Value m
toValue (a -> Value m)
-> Either RuntimeError a -> Either RuntimeError (Value m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Value m -> Either RuntimeError Integer
forall (m :: * -> *).
Text -> Value m -> Either RuntimeError Integer
asIntVal Text
"conversion to int" Value m
a Either RuntimeError Integer
-> (Integer -> Either RuntimeError a) -> Either RuntimeError a
forall a b.
Either RuntimeError a
-> (a -> Either RuntimeError b) -> Either RuntimeError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Integer -> Either RuntimeError a
f)

floatFunc :: (Monad m, ToValue a m)
         => (Double -> Either RuntimeError a)
         -> Value m
         -> Either RuntimeError (Value m)
floatFunc :: forall (m :: * -> *) a.
(Monad m, ToValue a m) =>
(Double -> Either RuntimeError a)
-> Value m -> Either RuntimeError (Value m)
floatFunc Double -> Either RuntimeError a
f Value m
a = a -> Value m
forall a (m :: * -> *). ToValue a m => a -> Value m
toValue (a -> Value m)
-> Either RuntimeError a -> Either RuntimeError (Value m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Value m -> Either RuntimeError Double
forall (m :: * -> *). Text -> Value m -> Either RuntimeError Double
asFloatVal Text
"conversion to float" Value m
a Either RuntimeError Double
-> (Double -> Either RuntimeError a) -> Either RuntimeError a
forall a b.
Either RuntimeError a
-> (a -> Either RuntimeError b) -> Either RuntimeError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Double -> Either RuntimeError a
f)

boolFunc :: (Monad m, ToValue a m)
         => (Bool -> a)
         -> Value m
         -> Either RuntimeError (Value m)
boolFunc :: forall (m :: * -> *) a.
(Monad m, ToValue a m) =>
(Bool -> a) -> Value m -> Either RuntimeError (Value m)
boolFunc Bool -> a
f (BoolV Bool
a) = Value m -> Either RuntimeError (Value m)
forall a. a -> Either RuntimeError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value m -> Either RuntimeError (Value m))
-> (a -> Value m) -> a -> Either RuntimeError (Value m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Value m
forall a (m :: * -> *). ToValue a m => a -> Value m
toValue (a -> Either RuntimeError (Value m))
-> a -> Either RuntimeError (Value m)
forall a b. (a -> b) -> a -> b
$ Bool -> a
f Bool
a
boolFunc Bool -> a
_ Value m
a = RuntimeError -> Either RuntimeError (Value m)
forall a b. a -> Either a b
Left (Text -> Text -> Text -> RuntimeError
TagError Text
"bool function" Text
"bool" (Value m -> Text
forall (m :: * -> *). Value m -> Text
tagNameOf Value m
a))

textFunc :: (Monad m, ToValue a m)
         => (Text -> Either RuntimeError a)
         -> Value m
         -> Either RuntimeError (Value m)
textFunc :: forall (m :: * -> *) a.
(Monad m, ToValue a m) =>
(Text -> Either RuntimeError a)
-> Value m -> Either RuntimeError (Value m)
textFunc Text -> Either RuntimeError a
f (StringV Text
a) = a -> Value m
forall a (m :: * -> *). ToValue a m => a -> Value m
toValue (a -> Value m)
-> Either RuntimeError a -> Either RuntimeError (Value m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either RuntimeError a
f Text
a
textFunc Text -> Either RuntimeError a
f (EncodedV (Encoded Text
a)) = a -> Value m
forall a (m :: * -> *). ToValue a m => a -> Value m
toValue (a -> Value m)
-> Either RuntimeError a -> Either RuntimeError (Value m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either RuntimeError a
f Text
a
textFunc Text -> Either RuntimeError a
f (IntV Integer
a) = a -> Value m
forall a (m :: * -> *). ToValue a m => a -> Value m
toValue (a -> Value m)
-> Either RuntimeError a -> Either RuntimeError (Value m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either RuntimeError a
f (Integer -> Text
forall a. Show a => a -> Text
Text.show Integer
a)
textFunc Text -> Either RuntimeError a
f (FloatV Double
a) = a -> Value m
forall a (m :: * -> *). ToValue a m => a -> Value m
toValue (a -> Value m)
-> Either RuntimeError a -> Either RuntimeError (Value m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either RuntimeError a
f (Double -> Text
forall a. Show a => a -> Text
Text.show Double
a)
textFunc Text -> Either RuntimeError a
f Value m
NoneV = a -> Value m
forall a (m :: * -> *). ToValue a m => a -> Value m
toValue (a -> Value m)
-> Either RuntimeError a -> Either RuntimeError (Value m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either RuntimeError a
f Text
""
textFunc Text -> Either RuntimeError a
_ Value m
a = RuntimeError -> Either RuntimeError (Value m)
forall a b. a -> Either a b
Left (Text -> Text -> Text -> RuntimeError
TagError Text
"text function" Text
"int" (Value m -> Text
forall (m :: * -> *). Value m -> Text
tagNameOf Value m
a))

dictFunc :: (Monad m, ToValue a m)
         => (Map Scalar (Value m) -> Either RuntimeError a)
         -> Value m
         -> Either RuntimeError (Value m)
dictFunc :: forall (m :: * -> *) a.
(Monad m, ToValue a m) =>
(Map Scalar (Value m) -> Either RuntimeError a)
-> Value m -> Either RuntimeError (Value m)
dictFunc Map Scalar (Value m) -> Either RuntimeError a
f (DictV Map Scalar (Value m)
a) = a -> Value m
forall a (m :: * -> *). ToValue a m => a -> Value m
toValue (a -> Value m)
-> Either RuntimeError a -> Either RuntimeError (Value m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Scalar (Value m) -> Either RuntimeError a
f Map Scalar (Value m)
a
dictFunc Map Scalar (Value m) -> Either RuntimeError a
_ Value m
a = RuntimeError -> Either RuntimeError (Value m)
forall a b. a -> Either a b
Left (Text -> Text -> Text -> RuntimeError
TagError Text
"dict function" Text
"dict" (Value m -> Text
forall (m :: * -> *). Value m -> Text
tagNameOf Value m
a))

numericFunc2 :: Monad m
             => (Integer -> Integer -> Integer)
             -> (Double -> Double -> Double)
             -> Value m
             -> Value m
             -> Either RuntimeError (Value m)
numericFunc2 :: forall (m :: * -> *).
Monad m =>
(Integer -> Integer -> Integer)
-> (Double -> Double -> Double)
-> Value m
-> Value m
-> Either RuntimeError (Value m)
numericFunc2 Integer -> Integer -> Integer
f Double -> Double -> Double
g =
  (Integer -> Integer -> Either RuntimeError Integer)
-> (Double -> Double -> Either RuntimeError Double)
-> Value m
-> Value m
-> Either RuntimeError (Value m)
forall (m :: * -> *).
Monad m =>
(Integer -> Integer -> Either RuntimeError Integer)
-> (Double -> Double -> Either RuntimeError Double)
-> Value m
-> Value m
-> Either RuntimeError (Value m)
numericFunc2Catch Integer -> Integer -> Either RuntimeError Integer
forall {a}. Integer -> Integer -> Either a Integer
f' Double -> Double -> Either RuntimeError Double
forall {a}. Double -> Double -> Either a Double
g'
  where
    f' :: Integer -> Integer -> Either a Integer
f' Integer
x Integer
y = Integer -> Either a Integer
forall a b. b -> Either a b
Right (Integer -> Integer -> Integer
f Integer
x Integer
y)
    g' :: Double -> Double -> Either a Double
g' Double
x Double
y = Double -> Either a Double
forall a b. b -> Either a b
Right (Double -> Double -> Double
g Double
x Double
y)

numericFunc2Catch :: Monad m
                  => (Integer -> Integer -> Either RuntimeError Integer)
                  -> (Double -> Double -> Either RuntimeError Double)
                  -> Value m
                  -> Value m
                  -> Either RuntimeError (Value m)
numericFunc2Catch :: forall (m :: * -> *).
Monad m =>
(Integer -> Integer -> Either RuntimeError Integer)
-> (Double -> Double -> Either RuntimeError Double)
-> Value m
-> Value m
-> Either RuntimeError (Value m)
numericFunc2Catch Integer -> Integer -> Either RuntimeError Integer
f Double -> Double -> Either RuntimeError Double
_ (IntV Integer
a) (IntV Integer
b) = Integer -> Value m
forall (m :: * -> *). Integer -> Value m
IntV (Integer -> Value m)
-> Either RuntimeError Integer -> Either RuntimeError (Value m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Integer
a Integer -> Integer -> Either RuntimeError Integer
`f` Integer
b)
numericFunc2Catch Integer -> Integer -> Either RuntimeError Integer
_ Double -> Double -> Either RuntimeError Double
f (FloatV Double
a) (FloatV Double
b) = Double -> Value m
forall (m :: * -> *). Double -> Value m
FloatV (Double -> Value m)
-> Either RuntimeError Double -> Either RuntimeError (Value m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Double -> Either RuntimeError Double
leftNaN (Double -> Either RuntimeError Double)
-> Either RuntimeError Double -> Either RuntimeError Double
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Double
a Double -> Double -> Either RuntimeError Double
`f` Double
b)
numericFunc2Catch Integer -> Integer -> Either RuntimeError Integer
_ Double -> Double -> Either RuntimeError Double
f (IntV Integer
a) (FloatV Double
b) = Double -> Value m
forall (m :: * -> *). Double -> Value m
FloatV (Double -> Value m)
-> Either RuntimeError Double -> Either RuntimeError (Value m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Double -> Either RuntimeError Double
leftNaN (Double -> Either RuntimeError Double)
-> Either RuntimeError Double -> Either RuntimeError Double
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Integer -> Double
forall a. Num a => Integer -> a
fromInteger Integer
a Double -> Double -> Either RuntimeError Double
`f` Double
b)
numericFunc2Catch Integer -> Integer -> Either RuntimeError Integer
_ Double -> Double -> Either RuntimeError Double
f (FloatV Double
a) (IntV Integer
b) = Double -> Value m
forall (m :: * -> *). Double -> Value m
FloatV (Double -> Value m)
-> Either RuntimeError Double -> Either RuntimeError (Value m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Double -> Either RuntimeError Double
leftNaN (Double -> Either RuntimeError Double)
-> Either RuntimeError Double -> Either RuntimeError Double
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Double
a Double -> Double -> Either RuntimeError Double
`f` Integer -> Double
forall a. Num a => Integer -> a
fromInteger Integer
b)
numericFunc2Catch Integer -> Integer -> Either RuntimeError Integer
_ Double -> Double -> Either RuntimeError Double
_ (FloatV Double
_) Value m
b = RuntimeError -> Either RuntimeError (Value m)
forall a b. a -> Either a b
Left (Text -> Text -> Text -> RuntimeError
TagError Text
"numeric function" Text
"number" (Value m -> Text
forall (m :: * -> *). Value m -> Text
tagNameOf Value m
b))
numericFunc2Catch Integer -> Integer -> Either RuntimeError Integer
_ Double -> Double -> Either RuntimeError Double
_ (IntV Integer
_) Value m
b = RuntimeError -> Either RuntimeError (Value m)
forall a b. a -> Either a b
Left (Text -> Text -> Text -> RuntimeError
TagError Text
"numeric function" Text
"number" (Value m -> Text
forall (m :: * -> *). Value m -> Text
tagNameOf Value m
b))
numericFunc2Catch Integer -> Integer -> Either RuntimeError Integer
_ Double -> Double -> Either RuntimeError Double
_ Value m
b Value m
_ = RuntimeError -> Either RuntimeError (Value m)
forall a b. a -> Either a b
Left (Text -> Text -> Text -> RuntimeError
TagError Text
"numeric function" Text
"number" (Value m -> Text
forall (m :: * -> *). Value m -> Text
tagNameOf Value m
b))

intFunc2 :: Monad m
         => (Integer -> Integer -> Either RuntimeError Integer)
         -> Value m
         -> Value m
         -> Either RuntimeError (Value m)
intFunc2 :: forall (m :: * -> *).
Monad m =>
(Integer -> Integer -> Either RuntimeError Integer)
-> Value m -> Value m -> Either RuntimeError (Value m)
intFunc2 Integer -> Integer -> Either RuntimeError Integer
f Value m
a Value m
b = do
  Integer
x <- Text -> Value m -> Either RuntimeError Integer
forall (m :: * -> *).
Text -> Value m -> Either RuntimeError Integer
asIntVal Text
"argument conversion to int" Value m
a
  Integer
y <- Text -> Value m -> Either RuntimeError Integer
forall (m :: * -> *).
Text -> Value m -> Either RuntimeError Integer
asIntVal Text
"argument conversion to int" Value m
b
  Integer -> Value m
forall (m :: * -> *). Integer -> Value m
IntV (Integer -> Value m)
-> Either RuntimeError Integer -> Either RuntimeError (Value m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> Integer -> Either RuntimeError Integer
f Integer
x Integer
y

floatFunc2 :: Monad m
         => (Double -> Double -> Either RuntimeError Double)
         -> Value m
         -> Value m
         -> Either RuntimeError (Value m)
floatFunc2 :: forall (m :: * -> *).
Monad m =>
(Double -> Double -> Either RuntimeError Double)
-> Value m -> Value m -> Either RuntimeError (Value m)
floatFunc2 Double -> Double -> Either RuntimeError Double
f (IntV Integer
a) Value m
b = (Double -> Double -> Either RuntimeError Double)
-> Value m -> Value m -> Either RuntimeError (Value m)
forall (m :: * -> *).
Monad m =>
(Double -> Double -> Either RuntimeError Double)
-> Value m -> Value m -> Either RuntimeError (Value m)
floatFunc2 Double -> Double -> Either RuntimeError Double
f (Double -> Value m
forall (m :: * -> *). Double -> Value m
FloatV (Double -> Value m) -> Double -> Value m
forall a b. (a -> b) -> a -> b
$ Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
a) Value m
b
floatFunc2 Double -> Double -> Either RuntimeError Double
f (FloatV Double
a) (IntV Integer
b) = (Double -> Double -> Either RuntimeError Double)
-> Value m -> Value m -> Either RuntimeError (Value m)
forall (m :: * -> *).
Monad m =>
(Double -> Double -> Either RuntimeError Double)
-> Value m -> Value m -> Either RuntimeError (Value m)
floatFunc2 Double -> Double -> Either RuntimeError Double
f (Double -> Value m
forall (m :: * -> *). Double -> Value m
FloatV Double
a) (Double -> Value m
forall (m :: * -> *). Double -> Value m
FloatV (Double -> Value m) -> Double -> Value m
forall a b. (a -> b) -> a -> b
$ Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
b)
floatFunc2 Double -> Double -> Either RuntimeError Double
f (FloatV Double
a) (FloatV Double
b) = Double -> Value m
forall (m :: * -> *). Double -> Value m
FloatV (Double -> Value m)
-> Either RuntimeError Double -> Either RuntimeError (Value m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Double
a Double -> Double -> Either RuntimeError Double
`f` Double
b)
floatFunc2 Double -> Double -> Either RuntimeError Double
_ (FloatV Double
_) Value m
b = RuntimeError -> Either RuntimeError (Value m)
forall a b. a -> Either a b
Left (Text -> Text -> Text -> RuntimeError
TagError Text
"floating-point function" Text
"float" (Value m -> Text
forall (m :: * -> *). Value m -> Text
tagNameOf Value m
b))
floatFunc2 Double -> Double -> Either RuntimeError Double
_ Value m
b Value m
_ = RuntimeError -> Either RuntimeError (Value m)
forall a b. a -> Either a b
Left (Text -> Text -> Text -> RuntimeError
TagError Text
"floating-point function" Text
"float" (Value m -> Text
forall (m :: * -> *). Value m -> Text
tagNameOf Value m
b))

boolFunc2 :: Monad m
         => (Bool -> Bool -> Bool)
         -> Value m
         -> Value m
         -> Either RuntimeError (Value m)
boolFunc2 :: forall (m :: * -> *).
Monad m =>
(Bool -> Bool -> Bool)
-> Value m -> Value m -> Either RuntimeError (Value m)
boolFunc2 Bool -> Bool -> Bool
f Value m
a Value m
b = Bool -> Value m
forall (m :: * -> *). Bool -> Value m
BoolV (Bool -> Value m)
-> Either RuntimeError Bool -> Either RuntimeError (Value m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool -> Bool -> Bool
f (Bool -> Bool -> Bool)
-> Either RuntimeError Bool -> Either RuntimeError (Bool -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Value m -> Either RuntimeError Bool
forall (m :: * -> *). Text -> Value m -> Either RuntimeError Bool
asBoolVal Text
"conversion to bool" Value m
a 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
<*> Text -> Value m -> Either RuntimeError Bool
forall (m :: * -> *). Text -> Value m -> Either RuntimeError Bool
asBoolVal Text
"conversion to bool" Value m
b)

native :: (Monad m, MonadTrans t, MonadError RuntimeError (t m))
       => m (Either RuntimeError a)
       -> t m a
native :: forall (m :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad m, MonadTrans t, MonadError RuntimeError (t m)) =>
m (Either RuntimeError a) -> t m a
native m (Either RuntimeError a)
action =
  m (Either RuntimeError a) -> t m (Either RuntimeError a)
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Either RuntimeError a)
action t m (Either RuntimeError a)
-> (Either RuntimeError a -> t m a) -> t m a
forall a b. t m a -> (a -> t m b) -> t m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (RuntimeError -> t m a)
-> (a -> t m a) -> Either RuntimeError a -> t m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either RuntimeError -> t m a
forall a. RuntimeError -> t m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError a -> t m a
forall a. a -> t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

encodeText :: ( Monad m
              , MonadError RuntimeError (t m)
              , MonadTrans t
              , MonadReader (Context m) (t m)
              )
           => Text
           -> t m Encoded
encodeText :: forall (m :: * -> *) (t :: (* -> *) -> * -> *).
(Monad m, MonadError RuntimeError (t m), MonadTrans t,
 MonadReader (Context m) (t m)) =>
Text -> t m Encoded
encodeText Text
str = do
  Context m
ctx <- t m (Context m)
forall r (m :: * -> *). MonadReader r m => m r
ask
  Context m -> Text -> t m Encoded
forall (m :: * -> *) (t :: (* -> *) -> * -> *).
(Monad m, MonadError RuntimeError (t m), MonadTrans t) =>
Context m -> Text -> t m Encoded
encodeTextWith Context m
ctx Text
str

encodeTextWith :: ( Monad m
              , MonadError RuntimeError (t m)
              , MonadTrans t
              )
           => Context m
           -> Text
           -> t m Encoded
encodeTextWith :: forall (m :: * -> *) (t :: (* -> *) -> * -> *).
(Monad m, MonadError RuntimeError (t m), MonadTrans t) =>
Context m -> Text -> t m Encoded
encodeTextWith Context m
ctx Text
str = do
  let encoder :: Encoder m
encoder = Context m -> Encoder m
forall (m :: * -> *). Context m -> Encoder m
contextEncode Context m
ctx
  m (Either RuntimeError Encoded) -> t m Encoded
forall (m :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad m, MonadTrans t, MonadError RuntimeError (t m)) =>
m (Either RuntimeError a) -> t m a
native (Encoded -> Either RuntimeError Encoded
forall a b. b -> Either a b
Right (Encoded -> Either RuntimeError Encoded)
-> m Encoded -> m (Either RuntimeError Encoded)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Encoder m
encoder Text
str)

encode :: ( Monad m
          , MonadError RuntimeError (t m)
          , MonadTrans t
          , MonadReader (Context m) (t m)
          )
       => Value m
       -> t m Encoded
encode :: forall (m :: * -> *) (t :: (* -> *) -> * -> *).
(Monad m, MonadError RuntimeError (t m), MonadTrans t,
 MonadReader (Context m) (t m)) =>
Value m -> t m Encoded
encode Value m
v = do
  Context m
ctx <- t m (Context m)
forall r (m :: * -> *). MonadReader r m => m r
ask
  Context m -> Value m -> t m Encoded
forall (m :: * -> *) (t :: (* -> *) -> * -> *).
(Monad m, MonadError RuntimeError (t m), MonadTrans t) =>
Context m -> Value m -> t m Encoded
encodeWith Context m
ctx Value m
v

encodeWith :: ( Monad m
          , MonadError RuntimeError (t m)
          , MonadTrans t
          )
       => Context m
       -> Value m
       -> t m Encoded
encodeWith :: forall (m :: * -> *) (t :: (* -> *) -> * -> *).
(Monad m, MonadError RuntimeError (t m), MonadTrans t) =>
Context m -> Value m -> t m Encoded
encodeWith Context m
_ (EncodedV Encoded
e) = Encoded -> t m Encoded
forall a. a -> t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Encoded
e
encodeWith Context m
ctx (NativeV NativeObject m
n) = m (Either RuntimeError Encoded) -> t m Encoded
forall (m :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad m, MonadTrans t, MonadError RuntimeError (t m)) =>
m (Either RuntimeError a) -> t m a
native (Encoded -> Either RuntimeError Encoded
forall a b. b -> Either a b
Right (Encoded -> Either RuntimeError Encoded)
-> m Encoded -> m (Either RuntimeError Encoded)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NativeObject m -> Context m -> m Encoded
forall (m :: * -> *). NativeObject m -> Context m -> m Encoded
nativeObjectEncoded NativeObject m
n Context m
ctx)
encodeWith Context m
_ (ProcedureV Procedure m
_) = Encoded -> t m Encoded
forall a. a -> t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoded -> t m Encoded) -> Encoded -> t m Encoded
forall a b. (a -> b) -> a -> b
$ Text -> Encoded
Encoded Text
"[[procedure]]"
encodeWith Context m
ctx Value m
v = Context m -> Text -> t m Encoded
forall (m :: * -> *) (t :: (* -> *) -> * -> *).
(Monad m, MonadError RuntimeError (t m), MonadTrans t) =>
Context m -> Text -> t m Encoded
encodeTextWith Context m
ctx (Text -> t m Encoded) -> t m Text -> t m Encoded
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value m -> t m Text
forall (m :: * -> *) (t :: (* -> *) -> * -> *).
(Monad m, MonadError RuntimeError (t m), MonadTrans t) =>
Value m -> t m Text
stringify Value m
v

--------------------------------------------------------------------------------
-- String / Encoding helpers
--------------------------------------------------------------------------------

stringify :: ( Monad m
             , MonadError RuntimeError (t m)
             , MonadTrans t
             )
          => Value m
          -> t m Text
stringify :: forall (m :: * -> *) (t :: (* -> *) -> * -> *).
(Monad m, MonadError RuntimeError (t m), MonadTrans t) =>
Value m -> t m Text
stringify Value m
NoneV = Text -> t m Text
forall a. a -> t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
""
stringify Value m
TrueV = Text -> t m Text
forall a. a -> t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"true"
stringify Value m
FalseV = Text -> t m Text
forall a. a -> t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
""
stringify (StringV Text
str) = Text -> t m Text
forall a. a -> t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
str
stringify (BytesV ByteString
b) =
  Text -> t m Text
forall a. a -> t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> t m Text)
-> (ByteString -> Text) -> ByteString -> t m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base64.encode (ByteString -> t m Text) -> ByteString -> t m Text
forall a b. (a -> b) -> a -> b
$ ByteString
b
stringify (EncodedV (Encoded Text
e)) =
  Text -> t m Text
forall a. a -> t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
e
stringify (IntV Integer
i) = Text -> t m Text
forall a. a -> t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> t m Text) -> Text -> t m Text
forall a b. (a -> b) -> a -> b
$ Integer -> Text
forall a. Show a => a -> Text
Text.show Integer
i
stringify (FloatV Double
f) = Text -> t m Text
forall a. a -> t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> t m Text) -> Text -> t m Text
forall a b. (a -> b) -> a -> b
$ Double -> Text
forall a. Show a => a -> Text
Text.show Double
f
stringify (ScalarV Scalar
s) = Text -> t m Text
forall a. a -> t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> t m Text) -> (Scalar -> Text) -> Scalar -> t m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scalar -> Text
forall a. Show a => a -> Text
Text.show (Scalar -> t m Text) -> Scalar -> t m Text
forall a b. (a -> b) -> a -> b
$ Scalar
s
stringify (ListV Vector (Value m)
xs) = do
  Vector Text
elems <- (Value m -> t m Text) -> Vector (Value m) -> t m (Vector Text)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
V.mapM Value m -> t m Text
forall (m :: * -> *) (t :: (* -> *) -> * -> *).
(Monad m, MonadError RuntimeError (t m), MonadTrans t) =>
Value m -> t m Text
stringify Vector (Value m)
xs
  Text -> t m Text
forall a. a -> t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> t m Text) -> Text -> t m Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
Text.intercalate Text
", " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Vector Text -> [Text]
forall a. Vector a -> [a]
V.toList Vector Text
elems
stringify (DictV Map Scalar (Value m)
m) = do
  [Text]
elems <- ((Scalar, Value m) -> t m Text)
-> [(Scalar, Value m)] -> t m [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Scalar, Value m) -> t m Text
forall (m :: * -> *) (t :: (* -> *) -> * -> *).
(Monad m, MonadError RuntimeError (t m), MonadTrans t) =>
(Scalar, Value m) -> t m Text
stringifyKV ([(Scalar, Value m)] -> t m [Text])
-> [(Scalar, Value m)] -> t m [Text]
forall a b. (a -> b) -> a -> b
$ Map Scalar (Value m) -> [(Scalar, Value m)]
forall k a. Map k a -> [(k, a)]
Map.toAscList Map Scalar (Value m)
m
  Text -> t m Text
forall a. a -> t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> t m Text) -> Text -> t m Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
Text.intercalate Text
", " [Text]
elems
stringify (NativeV NativeObject m
n) =
  m (Either RuntimeError Text) -> t m Text
forall (m :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad m, MonadTrans t, MonadError RuntimeError (t m)) =>
m (Either RuntimeError a) -> t m a
native (Text -> Either RuntimeError Text
forall a b. b -> Either a b
Right (Text -> Either RuntimeError Text)
-> m Text -> m (Either RuntimeError Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NativeObject m -> m Text
forall (m :: * -> *). NativeObject m -> m Text
nativeObjectStringified NativeObject m
n)
stringify (ProcedureV {}) =
  Text -> t m Text
forall a. a -> t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> t m Text) -> Text -> t m Text
forall a b. (a -> b) -> a -> b
$ Text
"[[procedure]]"
stringify (TestV Test m
_) =
  Text -> t m Text
forall a. a -> t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"[[test]]"
stringify (FilterV Filter m
_) =
  Text -> t m Text
forall a. a -> t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"[[filter]]"
stringify (MutableRefV RefID
ref) =
  Text -> t m Text
forall a. a -> t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> t m Text) -> Text -> t m Text
forall a b. (a -> b) -> a -> b
$ Text
"[[ref#]]" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
Text.show (RefID -> Int
unRefID RefID
ref)

stringifyKV :: ( Monad m
               , MonadError RuntimeError (t m)
               , MonadTrans t
               )
            => (Scalar, Value m)
            -> t m Text
stringifyKV :: forall (m :: * -> *) (t :: (* -> *) -> * -> *).
(Monad m, MonadError RuntimeError (t m), MonadTrans t) =>
(Scalar, Value m) -> t m Text
stringifyKV (Scalar
k, Value m
v) = do
  Text
kStr <- Value m -> t m Text
forall (m :: * -> *) (t :: (* -> *) -> * -> *).
(Monad m, MonadError RuntimeError (t m), MonadTrans t) =>
Value m -> t m Text
stringify (Scalar -> Value m
forall (m :: * -> *). Scalar -> Value m
ScalarV Scalar
k)
  Text
vStr <- Value m -> t m Text
forall (m :: * -> *) (t :: (* -> *) -> * -> *).
(Monad m, MonadError RuntimeError (t m), MonadTrans t) =>
Value m -> t m Text
stringify Value m
v
  Text -> t m Text
forall a. a -> t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> t m Text) -> Text -> t m Text
forall a b. (a -> b) -> a -> b
$ Text
kStr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
vStr


--------------------------------------------------------------------------------
-- Dictionary helpers
--------------------------------------------------------------------------------

dictV :: [(Scalar, Value m)] -> Value m
dictV :: forall (m :: * -> *). [(Scalar, Value m)] -> Value m
dictV [(Scalar, Value m)]
items = Map Scalar (Value m) -> Value m
forall (m :: * -> *). Map Scalar (Value m) -> Value m
DictV (Map Scalar (Value m) -> Value m)
-> Map Scalar (Value m) -> Value m
forall a b. (a -> b) -> a -> b
$ [(Scalar, Value m)] -> Map Scalar (Value m)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Scalar, Value m)]
items

infixr 8 .=

(.=) :: (ToValue v m) => Scalar -> v -> (Scalar, Value m)
Scalar
k .= :: forall v (m :: * -> *).
ToValue v m =>
Scalar -> v -> (Scalar, Value m)
.= v
v = (Scalar
k, v -> Value m
forall a (m :: * -> *). ToValue a m => a -> Value m
toValue v
v)

--------------------------------------------------------------------------------
-- Arbitrary instances
--------------------------------------------------------------------------------

instance Arbitrary Scalar where
  arbitrary :: Gen Scalar
arbitrary =
    [Gen Scalar] -> Gen Scalar
forall a. HasCallStack => [Gen a] -> Gen a
QC.oneof
      [ Scalar -> Gen Scalar
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Scalar
NoneScalar
      , Bool -> Scalar
BoolScalar (Bool -> Scalar) -> Gen Bool -> Gen Scalar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Bool
forall a. Arbitrary a => Gen a
arbitrary
      , Text -> Scalar
StringScalar (Text -> Scalar) -> (String -> Text) -> String -> Scalar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Scalar) -> Gen String -> Gen Scalar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Char -> Gen String
forall a. Gen a -> Gen [a]
QC.listOf Gen Char
forall a. Arbitrary a => Gen a
arbitrary
      , Encoded -> Scalar
EncodedScalar (Encoded -> Scalar) -> (String -> Encoded) -> String -> Scalar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Encoded
Encoded (Text -> Encoded) -> (String -> Text) -> String -> Encoded
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Scalar) -> Gen String -> Gen Scalar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Char -> Gen String
forall a. Gen a -> Gen [a]
QC.listOf Gen Char
forall a. Arbitrary a => Gen a
arbitrary
      , ByteString -> Scalar
BytesScalar (ByteString -> Scalar)
-> ([Word8] -> ByteString) -> [Word8] -> Scalar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack ([Word8] -> Scalar) -> Gen [Word8] -> Gen Scalar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word8 -> Gen [Word8]
forall a. Gen a -> Gen [a]
QC.listOf Gen Word8
forall a. Arbitrary a => Gen a
arbitrary
      , Integer -> Scalar
IntScalar (Integer -> Scalar) -> Gen Integer -> Gen Scalar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Integer
forall a. Arbitrary a => Gen a
arbitrary
      , Double -> Scalar
FloatScalar (Double -> Scalar) -> Gen Double -> Gen Scalar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Double
forall a. Arbitrary a => Gen a
arbitrary
      ]

  shrink :: Scalar -> [Scalar]
shrink = \case
    BoolScalar Bool
True -> [Bool -> Scalar
BoolScalar Bool
False]
    StringScalar Text
str | Text -> Bool
Text.null Text
str -> []
    StringScalar Text
str -> [Text -> Scalar
StringScalar (Text -> Scalar) -> Text -> Scalar
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text
Text -> Text
Text.init Text
str]
    EncodedScalar (Encoded Text
str) | Text -> Bool
Text.null Text
str -> []
    EncodedScalar (Encoded Text
str) -> [Encoded -> Scalar
EncodedScalar (Encoded -> Scalar) -> (Text -> Encoded) -> Text -> Scalar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Encoded
Encoded (Text -> Scalar) -> Text -> Scalar
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text
Text -> Text
Text.init Text
str]
    BytesScalar ByteString
str | ByteString -> Bool
BS.null ByteString
str -> []
    BytesScalar ByteString
str -> [ByteString -> Scalar
BytesScalar (ByteString -> Scalar) -> ByteString -> Scalar
forall a b. (a -> b) -> a -> b
$ HasCallStack => ByteString -> ByteString
ByteString -> ByteString
BS.init ByteString
str]
    IntScalar Integer
i -> Scalar
NoneScalar Scalar -> [Scalar] -> [Scalar]
forall a. a -> [a] -> [a]
: (Integer -> Scalar
IntScalar (Integer -> Scalar) -> [Integer] -> [Scalar]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> [Integer]
forall a. Arbitrary a => a -> [a]
shrink Integer
i)
    FloatScalar Double
f -> Scalar
NoneScalar Scalar -> [Scalar] -> [Scalar]
forall a. a -> [a] -> [a]
: (Double -> Scalar
FloatScalar (Double -> Scalar) -> [Double] -> [Scalar]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Double -> [Double]
forall a. Arbitrary a => a -> [a]
shrink Double
f)
    Scalar
NoneScalar -> []
    Scalar
_ -> [Scalar
NoneScalar]

instance Monad m => Arbitrary (Value m) where
  arbitrary :: Gen (Value m)
arbitrary =
    [Gen (Value m)] -> Gen (Value m)
forall a. HasCallStack => [Gen a] -> Gen a
QC.oneof
      [ Value m -> Gen (Value m)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value m
forall (m :: * -> *). Value m
NoneV
      , Scalar -> Value m
forall (m :: * -> *). Scalar -> Value m
ScalarV (Scalar -> Value m) -> Gen Scalar -> Gen (Value m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Scalar
forall a. Arbitrary a => Gen a
arbitrary
      , 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) -> Gen [Value m] -> Gen (Value m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Value m) -> Gen [Value m]
forall a. Gen a -> Gen [a]
fuelledList Gen (Value m)
forall a. Arbitrary a => Gen a
arbitrary
      , Map Scalar (Value m) -> Value m
forall (m :: * -> *). Map Scalar (Value m) -> Value m
DictV (Map Scalar (Value m) -> Value m)
-> ([(Scalar, Value m)] -> Map Scalar (Value m))
-> [(Scalar, Value m)]
-> Value m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Scalar, Value m)] -> Map Scalar (Value m)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Scalar, Value m)] -> Value m)
-> Gen [(Scalar, Value m)] -> Gen (Value m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Scalar, Value m) -> Gen [(Scalar, Value m)]
forall a. Gen a -> Gen [a]
fuelledList Gen (Scalar, Value m)
forall a. Arbitrary a => Gen a
arbitrary
      , NativeObject m -> Value m
forall (m :: * -> *). NativeObject m -> Value m
NativeV (NativeObject m -> Value m)
-> Gen (NativeObject m) -> Gen (Value m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (NativeObject m)
forall (m :: * -> *). Monad m => Gen (NativeObject m)
arbitraryNative
      , Procedure m -> Value m
forall (m :: * -> *). Procedure m -> Value m
ProcedureV (Procedure m -> Value m) -> Gen (Procedure m) -> Gen (Value m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Procedure m)
forall (m :: * -> *). Monad m => Gen (Procedure m)
arbitraryNativeProcedure
      ]

arbitraryNativeProcedure :: Monad m => QC.Gen (Procedure m)
arbitraryNativeProcedure :: forall (m :: * -> *). Monad m => Gen (Procedure m)
arbitraryNativeProcedure = do
  Value m
retval <- (Int -> Int) -> Gen (Value m) -> Gen (Value m)
forall a. (Int -> Int) -> Gen a -> Gen a
QC.scale (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) Gen (Value m)
forall a. Arbitrary a => Gen a
arbitrary
  ObjectID
oid <- Text -> ObjectID
ObjectID (Text -> ObjectID)
-> (Identifier -> Text) -> Identifier -> ObjectID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"arbitrary:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Identifier -> Text) -> Identifier -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Text
identifierName (Identifier -> ObjectID) -> Gen Identifier -> Gen ObjectID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Identifier
forall a. Arbitrary a => Gen a
arbitrary
  Procedure m -> Gen (Procedure m)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Procedure m -> Gen (Procedure m))
-> Procedure m -> Gen (Procedure m)
forall a b. (a -> b) -> a -> b
$ ObjectID
-> Maybe ProcedureDoc
-> ([(Maybe Identifier, Value m)]
    -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
-> Procedure m
forall (m :: * -> *).
ObjectID
-> Maybe ProcedureDoc
-> ([(Maybe Identifier, Value m)]
    -> Context m -> SomePRNG -> m (Either RuntimeError (Value m)))
-> Procedure m
NativeProcedure ObjectID
oid Maybe ProcedureDoc
forall a. Maybe a
Nothing (\[(Maybe Identifier, Value m)]
_ Context m
_ SomePRNG
_ -> Either RuntimeError (Value m) -> m (Either RuntimeError (Value m))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value m -> Either RuntimeError (Value m)
forall a b. b -> Either a b
Right Value m
retval))

arbitraryNative :: Monad m => QC.Gen (NativeObject m)
arbitraryNative :: forall (m :: * -> *). Monad m => Gen (NativeObject m)
arbitraryNative = do
  ObjectID
objectID <- Text -> ObjectID
ObjectID (Text -> ObjectID)
-> (Identifier -> Text) -> Identifier -> ObjectID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Text
identifierName (Identifier -> ObjectID) -> Gen Identifier -> Gen ObjectID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Identifier
forall a. Arbitrary a => Gen a
arbitrary
  NativeObject m -> Gen (NativeObject m)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ObjectID -> NativeObject m
forall (m :: * -> *). Monad m => ObjectID -> NativeObject m
defNativeObject ObjectID
objectID)
    { nativeObjectGetFieldNames = pure ["id"]
    , nativeObjectGetField = \case
        Scalar
"id" -> Maybe (Value m) -> m (Maybe (Value m))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Value m) -> m (Maybe (Value m)))
-> (ObjectID -> Maybe (Value m)) -> ObjectID -> m (Maybe (Value m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value m -> Maybe (Value m)
forall a. a -> Maybe a
Just (Value m -> Maybe (Value m))
-> (ObjectID -> Value m) -> ObjectID -> Maybe (Value m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value m
forall a (m :: * -> *). ToValue a m => a -> Value m
toValue (Text -> Value m) -> (ObjectID -> Text) -> ObjectID -> Value m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectID -> Text
unObjectID (ObjectID -> m (Maybe (Value m)))
-> ObjectID -> m (Maybe (Value m))
forall a b. (a -> b) -> a -> b
$ ObjectID
objectID
        Scalar
_ -> Maybe (Value m) -> m (Maybe (Value m))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Value m)
forall a. Maybe a
Nothing
    , nativeObjectStringified = pure $ unObjectID objectID
    , nativeObjectEq = \NativeObject m
self NativeObject m
other -> do
        Maybe (Value m)
otherID <- NativeObject m -> Scalar -> m (Maybe (Value m))
forall (m :: * -> *).
NativeObject m -> Scalar -> m (Maybe (Value m))
nativeObjectGetField NativeObject m
other Scalar
"id"
        Maybe (Value m)
selfID <- NativeObject m -> Scalar -> m (Maybe (Value m))
forall (m :: * -> *).
NativeObject m -> Scalar -> m (Maybe (Value m))
nativeObjectGetField NativeObject m
self Scalar
"id"
        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
$ Maybe (Value m)
otherID Maybe (Value m) -> Maybe (Value m) -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe (Value m)
selfID
    }