{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}

-- |

module JL.Functions (context, scope, functions) where

import           Control.Arrow
import           Data.Aeson (Value)
import           Data.Function
import qualified Data.HashMap.Strict as HM
import           Data.List
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import           Data.Maybe
import           Data.Ord
import           Data.Scientific
import           Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Vector as V
import           JL.Interpreter
import           JL.Serializer
import           JL.Types

--------------------------------------------------------------------------------
-- Lists

-- | The typing context.
context :: Map Variable Type
context :: Map Variable Type
context = [(Variable, Type)] -> Map Variable Type
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ((Definition -> (Variable, Type))
-> [Definition] -> [(Variable, Type)]
forall a b. (a -> b) -> [a] -> [b]
map (Definition -> Variable
definitionName (Definition -> Variable)
-> (Definition -> Type) -> Definition -> (Variable, Type)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Definition -> Type
definitionType) (((Text, [Definition]) -> [Definition])
-> [(Text, [Definition])] -> [Definition]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Text, [Definition]) -> [Definition]
forall a b. (a, b) -> b
snd [(Text, [Definition])]
functions))

-- | Bindings available in scope.
scope :: Map Variable Core
scope :: Map Variable Core
scope = [(Variable, Core)] -> Map Variable Core
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ((Definition -> (Variable, Core))
-> [Definition] -> [(Variable, Core)]
forall a b. (a -> b) -> [a] -> [b]
map (Definition -> Variable
definitionName (Definition -> Variable)
-> (Definition -> Core) -> Definition -> (Variable, Core)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&Definition -> Core
definitionCore) (((Text, [Definition]) -> [Definition])
-> [(Text, [Definition])] -> [Definition]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Text, [Definition]) -> [Definition]
forall a b. (a, b) -> b
snd [(Text, [Definition])]
functions))

-- | All functions.
functions :: [(Text, [Definition])]
functions :: [(Text, [Definition])]
functions =
  [ (Text
"Record access", [Definition
getf, Definition
setf, Definition
modifyf, Definition
keysf, Definition
elemsf])
  , ( Text
"Sequences"
    , [ Definition
mapf
      , Definition
filterf
      , Definition
takeWhilef
      , Definition
empty
      , Definition
len
      , Definition
rev
      , Definition
dropf
      , Definition
elemf
      , Definition
concatf
      , Definition
zipw
      , Definition
takef
      , Definition
foldf
      , Definition
dropWhilef
      , Definition
anyf
      , Definition
allf
      , Definition
nubf
      , Definition
sortf
      , Definition
appendf
      , Definition
sumf
      , Definition
productf
      , Definition
minimumf
      , Definition
maximumf
      ])
  , (Text
"Strings", [Definition
wordsf, Definition
unwordsf, Definition
linesf, Definition
unlinesf])
  , ( Text
"Predicate operators"
    , [Text -> (Value -> Value -> Bool) -> Definition
predicateOperator Text
"/=" Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
(/=), Text -> (Value -> Value -> Bool) -> Definition
predicateOperator Text
"=" Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
(==)])
  , ( Text
"Boolean operators"
    , [Text -> (Bool -> Bool -> Bool) -> Definition
boolOperator Text
"&&" Bool -> Bool -> Bool
(&&), Text -> (Bool -> Bool -> Bool) -> Definition
boolOperator Text
"||" Bool -> Bool -> Bool
(||), Text -> (Bool -> Bool) -> Definition
boolFun Text
"not" Bool -> Bool
not])
  , ( Text
"Numeric operators"
    , [ Text -> (Scientific -> Scientific -> Bool) -> Definition
numericPredicateOperator Text
">" Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
(>)
      , Text -> (Scientific -> Scientific -> Bool) -> Definition
numericPredicateOperator Text
"<" Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
(<)
      , Text -> (Scientific -> Scientific -> Bool) -> Definition
numericPredicateOperator Text
">=" Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
(>=)
      , Text -> (Scientific -> Scientific -> Bool) -> Definition
numericPredicateOperator Text
"<=" Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
(<=)
      , Text -> (Scientific -> Scientific -> Scientific) -> Definition
arithmeticOperator Text
"*" Scientific -> Scientific -> Scientific
forall a. Num a => a -> a -> a
(*)
      , Text -> (Scientific -> Scientific -> Scientific) -> Definition
arithmeticOperator Text
"+" Scientific -> Scientific -> Scientific
forall a. Num a => a -> a -> a
(+)
      , Text -> (Scientific -> Scientific -> Scientific) -> Definition
arithmeticOperator Text
"-" (-)
      , Text -> (Scientific -> Scientific -> Scientific) -> Definition
arithmeticOperator Text
"/" Scientific -> Scientific -> Scientific
forall a. Fractional a => a -> a -> a
(/)
      , Text -> (Scientific -> Scientific -> Scientific) -> Definition
arithmeticOperator Text
"min" Scientific -> Scientific -> Scientific
forall a. Ord a => a -> a -> a
min
      , Text -> (Scientific -> Scientific -> Scientific) -> Definition
arithmeticOperator Text
"max" Scientific -> Scientific -> Scientific
forall a. Ord a => a -> a -> a
max
      , Text -> (Scientific -> Scientific) -> Definition
arithmeticFun Text
"abs" Scientific -> Scientific
forall a. Num a => a -> a
abs
      ])
  , (Text
"Function combinators", [Definition
idf, Definition
compose, Definition
flipf])
  ]

--------------------------------------------------------------------------------
-- Functions

keysf :: Definition
keysf :: Definition
keysf =
  Definition :: Variable -> Text -> Type -> Core -> Definition
Definition
  { definitionDoc :: Text
definitionDoc = Text
"Get all keys of the object"
  , definitionName :: Variable
definitionName = Text -> Variable
Variable Text
"keys"
  , definitionCore :: Core
definitionCore =
      ((Core -> Core) -> Core
EvalCore
         (\Core
obj ->
            case Core
obj of
              RecordCore HashMap Text Core
o ->
                Vector Core -> Core
ArrayCore
                  ([Core] -> Vector Core
forall a. [a] -> Vector a
V.fromList ((Text -> Core) -> [Text] -> [Core]
forall a b. (a -> b) -> [a] -> [b]
map (Constant -> Core
ConstantCore (Constant -> Core) -> (Text -> Constant) -> Text -> Core
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Constant
StringConstant) (HashMap Text Core -> [Text]
forall k v. HashMap k v -> [k]
HM.keys HashMap Text Core
o)))
              Core
_ -> [Char] -> Core
forall a. HasCallStack => [Char] -> a
error [Char]
"keys function expected an object"))
  , definitionType :: Type
definitionType = Type -> Type -> Type
FunctionType Type
JSONType Type
JSONType
  }

elemsf :: Definition
elemsf :: Definition
elemsf =
  Definition :: Variable -> Text -> Type -> Core -> Definition
Definition
  { definitionDoc :: Text
definitionDoc = Text
"Get all elements of the object"
  , definitionName :: Variable
definitionName = Text -> Variable
Variable Text
"elems"
  , definitionCore :: Core
definitionCore =
      ((Core -> Core) -> Core
EvalCore
         (\Core
obj ->
            case Core
obj of
              RecordCore HashMap Text Core
o ->
                Vector Core -> Core
ArrayCore
                  ([Core] -> Vector Core
forall a. [a] -> Vector a
V.fromList (HashMap Text Core -> [Core]
forall k v. HashMap k v -> [v]
HM.elems HashMap Text Core
o))
              Core
_ -> [Char] -> Core
forall a. HasCallStack => [Char] -> a
error [Char]
"elems function expected an object"))
  , definitionType :: Type
definitionType = Type -> Type -> Type
FunctionType Type
JSONType Type
JSONType
  }

modifyf :: Definition
modifyf :: Definition
modifyf =
  Definition :: Variable -> Text -> Type -> Core -> Definition
Definition
  { definitionDoc :: Text
definitionDoc = Text
"Modify the object at k with function f"
  , definitionName :: Variable
definitionName = Text -> Variable
Variable Text
"modify"
  , definitionCore :: Core
definitionCore =
      ((Core -> Core) -> Core
EvalCore
         (\Core
key ->
            (Core -> Core) -> Core
EvalCore
              (\Core
f ->
                 (Core -> Core) -> Core
EvalCore
                   (\Core
obj ->
                      case (Core
key, Core
obj) of
                        (ConstantCore (StringConstant Text
k), (RecordCore HashMap Text Core
o)) ->
                          (HashMap Text Core -> Core
RecordCore
                             ((Core -> Core) -> Text -> HashMap Text Core -> HashMap Text Core
forall k v.
(Eq k, Hashable k) =>
(v -> v) -> k -> HashMap k v -> HashMap k v
HM.adjust (\Core
v -> Core -> Core
eval (Core -> Core -> Core
ApplicationCore Core
f Core
v)) Text
k HashMap Text Core
o))
                        (Core, Core)
_ -> [Char] -> Core
forall a. HasCallStack => [Char] -> a
error [Char]
"type error for args to modify"))))
  , definitionType :: Type
definitionType =
      Type -> Type -> Type
FunctionType
        Type
JSONType
        (Type -> Type -> Type
FunctionType
           (Type -> Type -> Type
FunctionType Type
JSONType Type
JSONType)
           (Type -> Type -> Type
FunctionType Type
JSONType Type
JSONType))
  }

getf :: Definition
getf :: Definition
getf =
  Definition :: Variable -> Text -> Type -> Core -> Definition
Definition
  { definitionDoc :: Text
definitionDoc = Text
"Get the value at k from the object"
  , definitionName :: Variable
definitionName = Text -> Variable
Variable Text
"get"
  , definitionCore :: Core
definitionCore =
      ((Core -> Core) -> Core
EvalCore
         (\Core
key ->
            (Core -> Core) -> Core
EvalCore
              (\Core
obj ->
                 case (Core
key, Core
obj) of
                   (ConstantCore (StringConstant Text
k), RecordCore HashMap Text Core
o) ->
                     (case Text -> HashMap Text Core -> Maybe Core
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
k HashMap Text Core
o of
                        Maybe Core
Nothing -> [Char] -> Core
forall a. HasCallStack => [Char] -> a
error ([Char]
"missing key " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
forall a. Show a => a -> [Char]
show Text
k)
                        Just Core
v -> Core
v)
                   (ConstantCore (NumberConstant Scientific
i), (ArrayCore Vector Core
v)) ->
                     (case Vector Core
v Vector Core -> Int -> Maybe Core
forall a. Vector a -> Int -> Maybe a
V.!? (Scientific -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round Scientific
i) of
                        Maybe Core
Nothing -> [Char] -> Core
forall a. HasCallStack => [Char] -> a
error ([Char]
"missing array index " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Scientific -> [Char]
forall a. Show a => a -> [Char]
show Scientific
i)
                        Just Core
v' -> Core
v')
                   (Core, Core)
_ -> [Char] -> Core
forall a. HasCallStack => [Char] -> a
error [Char]
"type error for get arguments")))
  , definitionType :: Type
definitionType = Type -> Type -> Type
FunctionType Type
JSONType (Type -> Type -> Type
FunctionType Type
JSONType Type
JSONType)
  }

setf :: Definition
setf :: Definition
setf =
  Definition :: Variable -> Text -> Type -> Core -> Definition
Definition
  { definitionDoc :: Text
definitionDoc = Text
"Set the value k to v in object"
  , definitionName :: Variable
definitionName = Text -> Variable
Variable Text
"set"
  , definitionCore :: Core
definitionCore =
      ((Core -> Core) -> Core
EvalCore
         (\Core
key ->
            (Core -> Core) -> Core
EvalCore
              (\Core
val ->
                 (Core -> Core) -> Core
EvalCore
                   (\Core
obj ->
                      case (Core
key, Core
val, Core
obj) of
                        (ConstantCore (StringConstant Text
k), Core
v, RecordCore HashMap Text Core
o) ->
                          (HashMap Text Core -> Core
RecordCore (Text -> Core -> HashMap Text Core -> HashMap Text Core
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert Text
k Core
v HashMap Text Core
o))
                        (Core, Core, Core)
_ -> [Char] -> Core
forall a. HasCallStack => [Char] -> a
error [Char]
"type error in arguments to: set"))))
  , definitionType :: Type
definitionType =
      Type -> Type -> Type
FunctionType
        Type
JSONType
        (Type -> Type -> Type
FunctionType Type
JSONType (Type -> Type -> Type
FunctionType Type
JSONType Type
JSONType))
  }

idf :: Definition
idf :: Definition
idf =
  Definition :: Variable -> Text -> Type -> Core -> Definition
Definition
  { definitionDoc :: Text
definitionDoc = Text
"Identity function, returns its input unchanged"
  , definitionName :: Variable
definitionName = Text -> Variable
Variable Text
"id"
  , definitionCore :: Core
definitionCore = ((Core -> Core) -> Core
EvalCore (\Core
x -> Core
x))
  , definitionType :: Type
definitionType = Type -> Type -> Type
FunctionType Type
JSONType Type
JSONType
  }

flipf :: Definition
flipf :: Definition
flipf =
  Definition :: Variable -> Text -> Type -> Core -> Definition
Definition
  { definitionDoc :: Text
definitionDoc = Text
"Flips the argument order of a function of two or more arguments"
  , definitionName :: Variable
definitionName = Text -> Variable
Variable Text
"flip"
  , definitionCore :: Core
definitionCore =
      ((Core -> Core) -> Core
EvalCore
         (\Core
f ->
            (Core -> Core) -> Core
EvalCore
              (\Core
x ->
                 (Core -> Core) -> Core
EvalCore (\Core
y -> Core -> Core
eval (Core -> Core -> Core
ApplicationCore (Core -> Core -> Core
ApplicationCore Core
f Core
y) Core
x)))))
  , definitionType :: Type
definitionType =
      Type -> Type -> Type
FunctionType
        (Type -> Type -> Type
FunctionType Type
JSONType (Type -> Type -> Type
FunctionType Type
JSONType Type
JSONType))
        (Type -> Type -> Type
FunctionType Type
JSONType (Type -> Type -> Type
FunctionType Type
JSONType Type
JSONType))
  }

compose :: Definition
compose :: Definition
compose =
  Definition :: Variable -> Text -> Type -> Core -> Definition
Definition
  { definitionDoc :: Text
definitionDoc = Text
"Compose two functions"
  , definitionName :: Variable
definitionName = Text -> Variable
Variable Text
"compose"
  , definitionCore :: Core
definitionCore =
      (Core -> Core) -> Core
EvalCore
        (\Core
f ->
           (Core -> Core) -> Core
EvalCore
             (\Core
g ->
                (Core -> Core) -> Core
EvalCore (\Core
x -> Core -> Core
eval (Core -> Core -> Core
ApplicationCore Core
g (Core -> Core -> Core
ApplicationCore Core
f Core
x)))))
  , definitionType :: Type
definitionType =
      Type -> Type -> Type
FunctionType
        (Type -> Type -> Type
FunctionType Type
JSONType Type
JSONType)
        (Type -> Type -> Type
FunctionType
           (Type -> Type -> Type
FunctionType Type
JSONType Type
JSONType)
           (Type -> Type -> Type
FunctionType Type
JSONType Type
JSONType))
  }

foldf :: Definition
foldf :: Definition
foldf =
  Definition :: Variable -> Text -> Type -> Core -> Definition
Definition
  { definitionDoc :: Text
definitionDoc = Text
"Fold over a structure with a state."
  , definitionName :: Variable
definitionName = Text -> Variable
Variable Text
"fold"
  , definitionCore :: Core
definitionCore =
      (Core -> Core) -> Core
EvalCore
        (\Core
cons ->
           (Core -> Core) -> Core
EvalCore
             (\Core
nil ->
                (Core -> Core) -> Core
EvalCore
                  (\Core
xs ->
                     case Core
xs of
                       ArrayCore Vector Core
xs' ->
                         ((Core -> Core -> Core) -> Core -> Vector Core -> Core
forall a b. (a -> b -> a) -> a -> Vector b -> a
V.foldl
                            (\Core
acc Core
x ->
                               Core -> Core
eval
                                 (Core -> Core -> Core
ApplicationCore (Core -> Core -> Core
ApplicationCore Core
cons Core
acc) Core
x))
                            Core
nil
                            Vector Core
xs')
                       ConstantCore (StringConstant Text
xs') ->
                         ((Core -> Char -> Core) -> Core -> Text -> Core
forall a. (a -> Char -> a) -> a -> Text -> a
T.foldl
                            (\Core
acc Char
x ->
                               Core -> Core
eval
                                 (Core -> Core -> Core
ApplicationCore
                                    (Core -> Core -> Core
ApplicationCore Core
cons Core
acc)
                                    (Constant -> Core
ConstantCore
                                       (Text -> Constant
StringConstant (Char -> Text
T.singleton Char
x)))))
                            Core
nil
                            Text
xs')
                       Core
_ -> [Char] -> Core
forall a. HasCallStack => [Char] -> a
error [Char]
"can only fold sequences")))
  , definitionType :: Type
definitionType =
      (Type -> Type -> Type
FunctionType
         ((Type -> Type -> Type
FunctionType Type
JSONType (Type -> Type -> Type
FunctionType Type
JSONType Type
JSONType)))
         (Type -> Type -> Type
FunctionType Type
JSONType (Type -> Type -> Type
FunctionType Type
JSONType Type
JSONType)))
  }

zipw :: Definition
zipw :: Definition
zipw =
  Definition :: Variable -> Text -> Type -> Core -> Definition
Definition
  { definitionDoc :: Text
definitionDoc = Text
"Zip two lists calling with each element to f x y"
  , definitionName :: Variable
definitionName = Text -> Variable
Variable Text
"zipWith"
  , definitionCore :: Core
definitionCore =
      (Core -> Core) -> Core
EvalCore
        (\Core
f ->
           (Core -> Core) -> Core
EvalCore
             (\Core
xs ->
                (Core -> Core) -> Core
EvalCore
                  (\Core
ys ->
                     case (Core
xs, Core
ys) of
                       (ArrayCore Vector Core
xs', ArrayCore Vector Core
ys') ->
                         (Vector Core -> Core
ArrayCore
                            ((Core -> Core -> Core) -> Vector Core -> Vector Core -> Vector Core
forall a b c. (a -> b -> c) -> Vector a -> Vector b -> Vector c
V.zipWith
                               (\Core
x Core
y ->
                                  Core -> Core
eval (Core -> Core -> Core
ApplicationCore (Core -> Core -> Core
ApplicationCore Core
f Core
x) Core
y))
                               Vector Core
xs'
                               Vector Core
ys'))
                       (Core, Core)
_ -> [Char] -> Core
forall a. HasCallStack => [Char] -> a
error [Char]
"can only zip two arrays")))
  , definitionType :: Type
definitionType =
      Type -> Type -> Type
FunctionType
        (Type -> Type -> Type
FunctionType Type
JSONType (Type -> Type -> Type
FunctionType Type
JSONType Type
JSONType))
        (Type -> Type -> Type
FunctionType Type
JSONType (Type -> Type -> Type
FunctionType Type
JSONType Type
JSONType))
  }

elemf :: Definition
elemf :: Definition
elemf =
  Definition :: Variable -> Text -> Type -> Core -> Definition
Definition
  { definitionDoc :: Text
definitionDoc = Text
"Is x an element of y?"
  , definitionName :: Variable
definitionName = Text -> Variable
Variable Text
"elem"
  , definitionCore :: Core
definitionCore =
      (Core -> Core) -> Core
EvalCore
        (\Core
n ->
           (Core -> Core) -> Core
EvalCore
             (\Core
xs ->
                case Core
xs of
                  (ArrayCore Vector Core
xs') ->
                    (Constant -> Core
ConstantCore
                       (Bool -> Constant
BoolConstant
                          (Value -> Vector Value -> Bool
forall a. Eq a => a -> Vector a -> Bool
V.elem (Core -> Value
coreToValue Core
n) ((Core -> Value) -> Vector Core -> Vector Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Core -> Value
coreToValue Vector Core
xs'))))
                  (ConstantCore (StringConstant Text
xs')) ->
                    (Constant -> Core
ConstantCore
                       (Bool -> Constant
BoolConstant
                          (Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust
                             ((Char -> Bool) -> Text -> Maybe Int
T.findIndex
                                (\Char
cc ->
                                   case Core
n of
                                     ConstantCore (StringConstant Text
c) ->
                                       Text
c Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Text
T.singleton Char
cc
                                     Core
_ -> Bool
False)
                                Text
xs'))))
                  Core
_ ->
                    [Char] -> Core
forall a. HasCallStack => [Char] -> a
error
                      [Char]
"can only check elements from sequences"))
  , definitionType :: Type
definitionType = Type -> Type -> Type
FunctionType Type
JSONType (Type -> Type -> Type
FunctionType Type
JSONType Type
JSONType)
  }

takef :: Definition
takef :: Definition
takef =
  Definition :: Variable -> Text -> Type -> Core -> Definition
Definition
  { definitionDoc :: Text
definitionDoc = Text
"Take n items from sequence"
  , definitionName :: Variable
definitionName = Text -> Variable
Variable Text
"take"
  , definitionCore :: Core
definitionCore =
      (Core -> Core) -> Core
EvalCore
        (\Core
n ->
           (Core -> Core) -> Core
EvalCore
             (\Core
xs ->
                case (Core
n, Core
xs) of
                  (ConstantCore (NumberConstant Scientific
n'), ArrayCore Vector Core
xs') ->
                    (Vector Core -> Core
ArrayCore (Int -> Vector Core -> Vector Core
forall a. Int -> Vector a -> Vector a
V.take (Scientific -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round Scientific
n') Vector Core
xs'))
                  (ConstantCore (NumberConstant Scientific
n'), ConstantCore (StringConstant Text
xs')) ->
                    (Constant -> Core
ConstantCore (Text -> Constant
StringConstant (Int -> Text -> Text
T.take (Scientific -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round Scientific
n') Text
xs')))
                  (Core, Core)
_ -> [Char] -> Core
forall a. HasCallStack => [Char] -> a
error [Char]
"can only take from sequences"))
  , definitionType :: Type
definitionType = Type -> Type -> Type
FunctionType Type
JSONType (Type -> Type -> Type
FunctionType Type
JSONType Type
JSONType)
  }

dropf :: Definition
dropf :: Definition
dropf =
  Definition :: Variable -> Text -> Type -> Core -> Definition
Definition
  { definitionDoc :: Text
definitionDoc = Text
"Drop n items from the sequence"
  , definitionName :: Variable
definitionName = Text -> Variable
Variable Text
"drop"
  , definitionCore :: Core
definitionCore =
      (Core -> Core) -> Core
EvalCore
        (\Core
n ->
           (Core -> Core) -> Core
EvalCore
             (\Core
xs ->
                case (Core
n, Core
xs) of
                  (ConstantCore (NumberConstant Scientific
n'), ConstantCore (StringConstant Text
xs')) ->
                    (Constant -> Core
ConstantCore (Text -> Constant
StringConstant (Int -> Text -> Text
T.drop (Scientific -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round Scientific
n') Text
xs')))
                  (ConstantCore (NumberConstant Scientific
n'), ArrayCore Vector Core
xs') ->
                    (Vector Core -> Core
ArrayCore (Int -> Vector Core -> Vector Core
forall a. Int -> Vector a -> Vector a
V.drop (Scientific -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round Scientific
n') Vector Core
xs'))
                  (Core, Core)
_ -> [Char] -> Core
forall a. HasCallStack => [Char] -> a
error [Char]
"can only drop from sequences"))
  , definitionType :: Type
definitionType = Type -> Type -> Type
FunctionType Type
JSONType (Type -> Type -> Type
FunctionType Type
JSONType Type
JSONType)
  }

concatf :: Definition
concatf :: Definition
concatf =
  Definition :: Variable -> Text -> Type -> Core -> Definition
Definition
  { definitionDoc :: Text
definitionDoc = Text
"Concatenate a list of sequences into one sequence"
  , definitionName :: Variable
definitionName = Text -> Variable
Variable Text
"concat"
  , definitionCore :: Core
definitionCore =
      ((Core -> Core) -> Core
EvalCore
         (\Core
xs ->
            case Core
xs of
              (ArrayCore Vector Core
xs') ->
                (Vector Core -> Core
ArrayCore ([Vector Core] -> Vector Core
forall a. [Vector a] -> Vector a
V.concat ((Core -> Vector Core) -> [Core] -> [Vector Core]
forall a b. (a -> b) -> [a] -> [b]
map Core -> Vector Core
coreToArray (Vector Core -> [Core]
forall a. Vector a -> [a]
V.toList Vector Core
xs'))))
              Core
_ -> [Char] -> Core
forall a. HasCallStack => [Char] -> a
error [Char]
"can only concat arrays"))
  , definitionType :: Type
definitionType = Type -> Type -> Type
FunctionType Type
JSONType Type
JSONType
  }

rev :: Definition
rev :: Definition
rev =
  Definition :: Variable -> Text -> Type -> Core -> Definition
Definition
  { definitionDoc :: Text
definitionDoc = Text
"Reverse a sequence"
  , definitionName :: Variable
definitionName = Text -> Variable
Variable Text
"reverse"
  , definitionCore :: Core
definitionCore =
      ((Core -> Core) -> Core
EvalCore
         (\Core
xs ->
            case Core
xs of
              (ArrayCore Vector Core
xs') -> (Vector Core -> Core
ArrayCore (Vector Core -> Vector Core
forall a. Vector a -> Vector a
V.reverse Vector Core
xs'))
              (ConstantCore (StringConstant Text
xs')) ->
                (Constant -> Core
ConstantCore (Text -> Constant
StringConstant (Text -> Text
T.reverse Text
xs')))
              Core
_ -> [Char] -> Core
forall a. HasCallStack => [Char] -> a
error [Char]
"can only reverse a sequence"))
  , definitionType :: Type
definitionType = Type -> Type -> Type
FunctionType Type
JSONType Type
JSONType
  }

appendf :: Definition
appendf :: Definition
appendf =
  Definition :: Variable -> Text -> Type -> Core -> Definition
Definition
  { definitionDoc :: Text
definitionDoc = Text
"Append the members of the second sequence to the first sequence"
  , definitionName :: Variable
definitionName = Text -> Variable
Variable Text
"append"
  , definitionCore :: Core
definitionCore =
      ((Core -> Core) -> Core
EvalCore
         (\Core
xs ->
            ((Core -> Core) -> Core
EvalCore
               (\Core
ys ->
                  case (Core
xs, Core
ys) of
                    (ArrayCore Vector Core
xs', ArrayCore Vector Core
ys') -> (Vector Core -> Core
ArrayCore (Vector Core
xs' Vector Core -> Vector Core -> Vector Core
forall a. Semigroup a => a -> a -> a
<> Vector Core
ys'))
                    (ConstantCore (StringConstant Text
xs'), ConstantCore (StringConstant Text
ys')) ->
                      (Constant -> Core
ConstantCore (Text -> Constant
StringConstant (Text
xs' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ys')))
                    (Core, Core)
_ -> [Char] -> Core
forall a. HasCallStack => [Char] -> a
error [Char]
"can only append two sequences of the same type"))))
  , definitionType :: Type
definitionType = Type -> Type -> Type
FunctionType Type
JSONType (Type -> Type -> Type
FunctionType Type
JSONType Type
JSONType)
  }

nubf :: Definition
nubf :: Definition
nubf =
  Definition :: Variable -> Text -> Type -> Core -> Definition
Definition
  { definitionDoc :: Text
definitionDoc = Text
"Return the sequence with no duplicates; the nub of it"
  , definitionName :: Variable
definitionName = Text -> Variable
Variable Text
"nub"
  , definitionCore :: Core
definitionCore =
      ((Core -> Core) -> Core
EvalCore
         (\Core
xs ->
            case Core
xs of
              (ArrayCore Vector Core
xs') ->
                (Vector Core -> Core
ArrayCore
                   ([Core] -> Vector Core
forall a. [a] -> Vector a
V.fromList ((Core -> Core -> Bool) -> [Core] -> [Core]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy ((Value -> Value -> Bool) -> (Core -> Value) -> Core -> Core -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
(==) Core -> Value
coreToValue) (Vector Core -> [Core]
forall a. Vector a -> [a]
V.toList Vector Core
xs'))))
              (ConstantCore (StringConstant Text
xs')) ->
                (Constant -> Core
ConstantCore
                   (Text -> Constant
StringConstant
                      ([Char] -> Text
T.pack ([Char] -> [Char]
forall a. Eq a => [a] -> [a]
nub (Text -> [Char]
T.unpack Text
xs')))))
              Core
_ -> [Char] -> Core
forall a. HasCallStack => [Char] -> a
error [Char]
"can only nub a sequence"))
  , definitionType :: Type
definitionType = Type -> Type -> Type
FunctionType Type
JSONType Type
JSONType
  }

linesf :: Definition
linesf :: Definition
linesf =
  Definition :: Variable -> Text -> Type -> Core -> Definition
Definition
  { definitionDoc :: Text
definitionDoc = Text
"Split the string into a list of lines"
  , definitionName :: Variable
definitionName = Text -> Variable
Variable Text
"lines"
  , definitionCore :: Core
definitionCore =
      ((Core -> Core) -> Core
EvalCore
         (\Core
xs ->
            case Core
xs of
              (ConstantCore (StringConstant Text
xs')) ->
                (Vector Core -> Core
ArrayCore
                   ((Text -> Core) -> Vector Text -> Vector Core
forall a b. (a -> b) -> Vector a -> Vector b
V.map
                      (Constant -> Core
ConstantCore (Constant -> Core) -> (Text -> Constant) -> Text -> Core
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Constant
StringConstant)
                      (([Text] -> Vector Text
forall a. [a] -> Vector a
V.fromList (Text -> [Text]
T.lines Text
xs')))))
              Core
_ -> [Char] -> Core
forall a. HasCallStack => [Char] -> a
error [Char]
"can only lines a string"))
  , definitionType :: Type
definitionType = Type -> Type -> Type
FunctionType Type
JSONType Type
JSONType
  }

wordsf :: Definition
wordsf :: Definition
wordsf =
  Definition :: Variable -> Text -> Type -> Core -> Definition
Definition
  { definitionDoc :: Text
definitionDoc = Text
"Split the string into a list of words"
  , definitionName :: Variable
definitionName = Text -> Variable
Variable Text
"words"
  , definitionCore :: Core
definitionCore =
      ((Core -> Core) -> Core
EvalCore
         (\Core
xs ->
            case Core
xs of
              (ConstantCore (StringConstant Text
xs')) ->
                (Vector Core -> Core
ArrayCore
                   ((Text -> Core) -> Vector Text -> Vector Core
forall a b. (a -> b) -> Vector a -> Vector b
V.map
                      (Constant -> Core
ConstantCore (Constant -> Core) -> (Text -> Constant) -> Text -> Core
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Constant
StringConstant)
                      (([Text] -> Vector Text
forall a. [a] -> Vector a
V.fromList (Text -> [Text]
T.words Text
xs')))))
              Core
_ -> [Char] -> Core
forall a. HasCallStack => [Char] -> a
error [Char]
"can only words a string"))
  , definitionType :: Type
definitionType = Type -> Type -> Type
FunctionType Type
JSONType Type
JSONType
  }

unwordsf :: Definition
unwordsf :: Definition
unwordsf =
  Definition :: Variable -> Text -> Type -> Core -> Definition
Definition
  { definitionDoc :: Text
definitionDoc = Text
"Join the list of strings into a string separated by spaces"
  , definitionName :: Variable
definitionName = Text -> Variable
Variable Text
"unwords"
  , definitionCore :: Core
definitionCore =
      ((Core -> Core) -> Core
EvalCore
         (\Core
xs ->
            case Core
xs of
              (ArrayCore Vector Core
xs') ->
                (Constant -> Core
ConstantCore (Text -> Constant
StringConstant ([Text] -> Text
T.unwords (Vector Text -> [Text]
forall a. Vector a -> [a]
V.toList ((Core -> Text) -> Vector Core -> Vector Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Core -> Text
coreToString Vector Core
xs')))))
              Core
_ -> [Char] -> Core
forall a. HasCallStack => [Char] -> a
error [Char]
"can only unwords a string"))
  , definitionType :: Type
definitionType = Type -> Type -> Type
FunctionType Type
JSONType Type
JSONType
  }

unlinesf :: Definition
unlinesf :: Definition
unlinesf =
  Definition :: Variable -> Text -> Type -> Core -> Definition
Definition
  { definitionDoc :: Text
definitionDoc = Text
"Join the list of strings into a string separated by lines and terminated by a new line"
  , definitionName :: Variable
definitionName = Text -> Variable
Variable Text
"unlines"
  , definitionCore :: Core
definitionCore =
      ((Core -> Core) -> Core
EvalCore
         (\Core
xs ->
            case Core
xs of
              (ArrayCore Vector Core
xs') ->
                (Constant -> Core
ConstantCore (Text -> Constant
StringConstant ([Text] -> Text
T.unlines (Vector Text -> [Text]
forall a. Vector a -> [a]
V.toList ((Core -> Text) -> Vector Core -> Vector Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Core -> Text
coreToString Vector Core
xs')))))
              Core
_ -> [Char] -> Core
forall a. HasCallStack => [Char] -> a
error [Char]
"can only unlines a string"))
  , definitionType :: Type
definitionType = Type -> Type -> Type
FunctionType Type
JSONType Type
JSONType
  }

sortf :: Definition
sortf :: Definition
sortf =
  Definition :: Variable -> Text -> Type -> Core -> Definition
Definition
  { definitionDoc :: Text
definitionDoc = Text
"Return the sequence sorted"
  , definitionName :: Variable
definitionName = Text -> Variable
Variable Text
"sort"
  , definitionCore :: Core
definitionCore =
      ((Core -> Core) -> Core
EvalCore
         (\Core
xs ->
            case Core
xs of
              (ArrayCore Vector Core
xs') ->
                (Vector Core -> Core
ArrayCore
                   ([Core] -> Vector Core
forall a. [a] -> Vector a
V.fromList ((Core -> Core -> Ordering) -> [Core] -> [Core]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((Core -> Compare) -> Core -> Core -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Core -> Compare
coreToCompare) (Vector Core -> [Core]
forall a. Vector a -> [a]
V.toList Vector Core
xs'))))
              (ConstantCore (StringConstant Text
xs')) ->
                (Constant -> Core
ConstantCore
                   (Text -> Constant
StringConstant
                      ([Char] -> Text
T.pack ([Char] -> [Char]
forall a. Ord a => [a] -> [a]
sort (Text -> [Char]
T.unpack Text
xs')))))
              Core
_ -> [Char] -> Core
forall a. HasCallStack => [Char] -> a
error [Char]
"can only sort a sequence"))
  , definitionType :: Type
definitionType = Type -> Type -> Type
FunctionType Type
JSONType Type
JSONType
  }

len :: Definition
len :: Definition
len =
  Definition :: Variable -> Text -> Type -> Core -> Definition
Definition
  { definitionDoc :: Text
definitionDoc = Text
"Get the length of a sequence"
  , definitionName :: Variable
definitionName = Text -> Variable
Variable Text
"length"
  , definitionCore :: Core
definitionCore =
      ((Core -> Core) -> Core
EvalCore
         (\Core
xs ->
            case Core
xs of
              (ArrayCore Vector Core
xs') ->
                (Constant -> Core
ConstantCore (Scientific -> Constant
NumberConstant (Int -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Core -> Int
forall a. Vector a -> Int
V.length Vector Core
xs'))))
              (ConstantCore (StringConstant Text
xs')) ->
                (Constant -> Core
ConstantCore (Scientific -> Constant
NumberConstant (Int -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Text -> Int
T.length Text
xs'))))
              Core
_ -> [Char] -> Core
forall a. HasCallStack => [Char] -> a
error [Char]
"can only take length of sequences"))
  , definitionType :: Type
definitionType = Type -> Type -> Type
FunctionType Type
JSONType Type
JSONType
  }

sumf :: Definition
sumf :: Definition
sumf =
  Definition :: Variable -> Text -> Type -> Core -> Definition
Definition
  { definitionDoc :: Text
definitionDoc = Text
"Get the sum of a sequence"
  , definitionName :: Variable
definitionName = Text -> Variable
Variable Text
"sum"
  , definitionCore :: Core
definitionCore =
      ((Core -> Core) -> Core
EvalCore
         (\Core
xs ->
            case Core
xs of
              (ArrayCore Vector Core
xs') ->
                (Constant -> Core
ConstantCore (Scientific -> Constant
NumberConstant (Vector Scientific -> Scientific
forall a. Num a => Vector a -> a
V.sum ((Core -> Scientific) -> Vector Core -> Vector Scientific
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Core -> Scientific
coreToNumber Vector Core
xs'))))
              Core
_ -> [Char] -> Core
forall a. HasCallStack => [Char] -> a
error [Char]
"can only take sum of arrays"))
  , definitionType :: Type
definitionType = Type -> Type -> Type
FunctionType Type
JSONType Type
JSONType
  }

productf :: Definition
productf :: Definition
productf =
  Definition :: Variable -> Text -> Type -> Core -> Definition
Definition
  { definitionDoc :: Text
definitionDoc = Text
"Get the product of a sequence"
  , definitionName :: Variable
definitionName = Text -> Variable
Variable Text
"product"
  , definitionCore :: Core
definitionCore =
      ((Core -> Core) -> Core
EvalCore
         (\Core
xs ->
            case Core
xs of
              (ArrayCore Vector Core
xs') ->
                (Constant -> Core
ConstantCore (Scientific -> Constant
NumberConstant (Vector Scientific -> Scientific
forall a. Num a => Vector a -> a
V.product ((Core -> Scientific) -> Vector Core -> Vector Scientific
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Core -> Scientific
coreToNumber Vector Core
xs'))))
              Core
_ -> [Char] -> Core
forall a. HasCallStack => [Char] -> a
error [Char]
"can only take product of arrays"))
  , definitionType :: Type
definitionType = Type -> Type -> Type
FunctionType Type
JSONType Type
JSONType
  }

maximumf :: Definition
maximumf :: Definition
maximumf =
  Definition :: Variable -> Text -> Type -> Core -> Definition
Definition
  { definitionDoc :: Text
definitionDoc = Text
"Get the maximum of a sequence"
  , definitionName :: Variable
definitionName = Text -> Variable
Variable Text
"maximum"
  , definitionCore :: Core
definitionCore =
      ((Core -> Core) -> Core
EvalCore
         (\Core
xs ->
            case Core
xs of
              (ArrayCore Vector Core
xs') ->
                (Constant -> Core
ConstantCore (Scientific -> Constant
NumberConstant (Vector Scientific -> Scientific
forall a. Ord a => Vector a -> a
V.maximum ((Core -> Scientific) -> Vector Core -> Vector Scientific
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Core -> Scientific
coreToNumber Vector Core
xs'))))
              Core
_ -> [Char] -> Core
forall a. HasCallStack => [Char] -> a
error [Char]
"can only take maximum of arrays"))
  , definitionType :: Type
definitionType = Type -> Type -> Type
FunctionType Type
JSONType Type
JSONType
  }

minimumf :: Definition
minimumf :: Definition
minimumf =
  Definition :: Variable -> Text -> Type -> Core -> Definition
Definition
  { definitionDoc :: Text
definitionDoc = Text
"Get the minimum of a sequence"
  , definitionName :: Variable
definitionName = Text -> Variable
Variable Text
"minimum"
  , definitionCore :: Core
definitionCore =
      ((Core -> Core) -> Core
EvalCore
         (\Core
xs ->
            case Core
xs of
              (ArrayCore Vector Core
xs') ->
                (Constant -> Core
ConstantCore (Scientific -> Constant
NumberConstant (Vector Scientific -> Scientific
forall a. Ord a => Vector a -> a
V.minimum ((Core -> Scientific) -> Vector Core -> Vector Scientific
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Core -> Scientific
coreToNumber Vector Core
xs'))))
              Core
_ -> [Char] -> Core
forall a. HasCallStack => [Char] -> a
error [Char]
"can only take minimum of arrays"))
  , definitionType :: Type
definitionType = Type -> Type -> Type
FunctionType Type
JSONType Type
JSONType
  }

empty :: Definition
empty :: Definition
empty =
  Definition :: Variable -> Text -> Type -> Core -> Definition
Definition
  { definitionDoc :: Text
definitionDoc = Text
"Is a sequence empty?"
  , definitionName :: Variable
definitionName = Text -> Variable
Variable Text
"empty"
  , definitionCore :: Core
definitionCore =
      ((Core -> Core) -> Core
EvalCore
         (\Core
xs ->
            case Core
xs of
              (ArrayCore Vector Core
xs') -> (Constant -> Core
ConstantCore (Bool -> Constant
BoolConstant (Vector Core -> Bool
forall a. Vector a -> Bool
V.null Vector Core
xs')))
              (ConstantCore (StringConstant Text
xs')) ->
                (Constant -> Core
ConstantCore (Bool -> Constant
BoolConstant (Text -> Bool
T.null Text
xs')))
              Core
_ -> [Char] -> Core
forall a. HasCallStack => [Char] -> a
error [Char]
"can only check if sequences are empty"))
  , definitionType :: Type
definitionType = Type -> Type -> Type
FunctionType Type
JSONType Type
JSONType
  }

anyf :: Definition
anyf :: Definition
anyf =
  Definition :: Variable -> Text -> Type -> Core -> Definition
Definition
  { definitionDoc :: Text
definitionDoc = Text
"Does p return true for any of the elements?"
  , definitionName :: Variable
definitionName = Text -> Variable
Variable Text
"any"
  , definitionCore :: Core
definitionCore =
      (Core -> Core) -> Core
EvalCore
        (\Core
f ->
           (Core -> Core) -> Core
EvalCore
             (\Core
xs ->
                case Core
xs of
                  (ArrayCore Vector Core
xs') ->
                    (Constant -> Core
ConstantCore
                       (Bool -> Constant
BoolConstant
                          ((Core -> Bool) -> Vector Core -> Bool
forall a. (a -> Bool) -> Vector a -> Bool
V.any
                             (\Core
x ->
                                case Core -> Core
eval (Core -> Core -> Core
ApplicationCore Core
f Core
x) of
                                  ConstantCore (BoolConstant Bool
b) -> Bool
b
                                  Core
_ -> Bool
True)
                             Vector Core
xs')))
                  (ConstantCore (StringConstant Text
xs')) ->
                    (Constant -> Core
ConstantCore
                       (Bool -> Constant
BoolConstant
                          ((Char -> Bool) -> Text -> Bool
T.any
                             (\Char
x ->
                                case Core -> Core
eval
                                       (Core -> Core -> Core
ApplicationCore
                                          Core
f
                                          (Constant -> Core
ConstantCore
                                             (Text -> Constant
StringConstant (Char -> Text
T.singleton Char
x)))) of
                                  ConstantCore (BoolConstant Bool
b) -> Bool
b
                                  Core
_ -> Bool
True)
                             Text
xs')))
                  Core
_ -> [Char] -> Core
forall a. HasCallStack => [Char] -> a
error [Char]
"can only any over sequences"))
  , definitionType :: Type
definitionType =
      Type -> Type -> Type
FunctionType
        (Type -> Type -> Type
FunctionType Type
JSONType Type
JSONType)
        (Type -> Type -> Type
FunctionType Type
JSONType Type
JSONType)
  }

allf :: Definition
allf :: Definition
allf =
  Definition :: Variable -> Text -> Type -> Core -> Definition
Definition
  { definitionDoc :: Text
definitionDoc = Text
"Does p return true for all of the elements?"
  , definitionName :: Variable
definitionName = Text -> Variable
Variable Text
"all"
  , definitionCore :: Core
definitionCore =
      (Core -> Core) -> Core
EvalCore
        (\Core
f ->
           (Core -> Core) -> Core
EvalCore
             (\Core
xs ->
                case Core
xs of
                  (ArrayCore Vector Core
xs') ->
                    (Constant -> Core
ConstantCore
                       (Bool -> Constant
BoolConstant
                          ((Core -> Bool) -> Vector Core -> Bool
forall a. (a -> Bool) -> Vector a -> Bool
V.all
                             (\Core
x ->
                                case Core -> Core
eval (Core -> Core -> Core
ApplicationCore Core
f Core
x) of
                                  ConstantCore (BoolConstant Bool
b) -> Bool
b
                                  Core
_ -> Bool
True)
                             Vector Core
xs')))
                  (ConstantCore (StringConstant Text
xs')) ->
                    (Constant -> Core
ConstantCore
                       (Bool -> Constant
BoolConstant
                          ((Char -> Bool) -> Text -> Bool
T.all
                             (\Char
x ->
                                case Core -> Core
eval
                                       (Core -> Core -> Core
ApplicationCore
                                          Core
f
                                          (Constant -> Core
ConstantCore
                                             (Text -> Constant
StringConstant (Char -> Text
T.singleton Char
x)))) of
                                  ConstantCore (BoolConstant Bool
b) -> Bool
b
                                  Core
_ -> Bool
True)
                             Text
xs')))
                  Core
_ -> [Char] -> Core
forall a. HasCallStack => [Char] -> a
error [Char]
"can only all over sequences"))
  , definitionType :: Type
definitionType =
      Type -> Type -> Type
FunctionType
        (Type -> Type -> Type
FunctionType Type
JSONType Type
JSONType)
        (Type -> Type -> Type
FunctionType Type
JSONType Type
JSONType)
  }

dropWhilef :: Definition
dropWhilef :: Definition
dropWhilef =
  Definition :: Variable -> Text -> Type -> Core -> Definition
Definition
  { definitionDoc :: Text
definitionDoc = Text
"Drop elements from a sequence while a predicate is true"
  , definitionName :: Variable
definitionName = Text -> Variable
Variable Text
"dropWhile"
  , definitionCore :: Core
definitionCore =
      (Core -> Core) -> Core
EvalCore
        (\Core
f ->
           (Core -> Core) -> Core
EvalCore
             (\Core
xs ->
                case Core
xs of
                  (ArrayCore Vector Core
xs') ->
                    (Vector Core -> Core
ArrayCore
                       ((Core -> Bool) -> Vector Core -> Vector Core
forall a. (a -> Bool) -> Vector a -> Vector a
V.dropWhile
                          (\Core
x ->
                             case Core -> Core
eval (Core -> Core -> Core
ApplicationCore Core
f Core
x) of
                               ConstantCore (BoolConstant Bool
b) -> Bool
b
                               Core
_ -> Bool
True)
                          Vector Core
xs'))
                  (ConstantCore (StringConstant Text
xs')) ->
                    (Constant -> Core
ConstantCore
                       (Text -> Constant
StringConstant
                          ((Char -> Bool) -> Text -> Text
T.dropWhile
                             (\Char
x ->
                                case Core -> Core
eval
                                       (Core -> Core -> Core
ApplicationCore
                                          Core
f
                                          (Constant -> Core
ConstantCore
                                             (Text -> Constant
StringConstant (Char -> Text
T.singleton Char
x)))) of
                                  ConstantCore (BoolConstant Bool
b) -> Bool
b
                                  Core
_ -> Bool
True)
                             Text
xs')))
                  Core
_ -> [Char] -> Core
forall a. HasCallStack => [Char] -> a
error [Char]
"can only dropWhile over sequences"))
  , definitionType :: Type
definitionType =
      Type -> Type -> Type
FunctionType
        (Type -> Type -> Type
FunctionType Type
JSONType Type
JSONType)
        (Type -> Type -> Type
FunctionType Type
JSONType Type
JSONType)
  }

takeWhilef :: Definition
takeWhilef :: Definition
takeWhilef =
  Definition :: Variable -> Text -> Type -> Core -> Definition
Definition
  { definitionDoc :: Text
definitionDoc =
      Text
"Take elements from a sequence while given predicate is true"
  , definitionName :: Variable
definitionName = Text -> Variable
Variable Text
"takeWhile"
  , definitionCore :: Core
definitionCore =
      ((Core -> Core) -> Core
EvalCore
         (\Core
f ->
            (Core -> Core) -> Core
EvalCore
              (\Core
xs ->
                 case Core
xs of
                   (ConstantCore (StringConstant Text
xs')) ->
                     (Constant -> Core
ConstantCore
                        (Text -> Constant
StringConstant
                           ((Char -> Bool) -> Text -> Text
T.takeWhile
                              (\Char
x ->
                                 case Core -> Core
eval
                                        (Core -> Core -> Core
ApplicationCore
                                           Core
f
                                           (Constant -> Core
ConstantCore
                                              (Text -> Constant
StringConstant (Char -> Text
T.singleton Char
x)))) of
                                   ConstantCore (BoolConstant Bool
b) -> Bool
b
                                   Core
_ -> Bool
True)
                              Text
xs')))
                   (ArrayCore Vector Core
xs') ->
                     (Vector Core -> Core
ArrayCore
                        ((Core -> Bool) -> Vector Core -> Vector Core
forall a. (a -> Bool) -> Vector a -> Vector a
V.takeWhile
                           (\Core
x ->
                              case Core -> Core
eval (Core -> Core -> Core
ApplicationCore Core
f Core
x) of
                                ConstantCore (BoolConstant Bool
b) -> Bool
b
                                Core
_ -> Bool
True)
                           Vector Core
xs'))
                   Core
_ -> [Char] -> Core
forall a. HasCallStack => [Char] -> a
error [Char]
"can only takeWhile over sequences")))
  , definitionType :: Type
definitionType =
      Type -> Type -> Type
FunctionType
        (Type -> Type -> Type
FunctionType Type
JSONType Type
JSONType)
        (Type -> Type -> Type
FunctionType Type
JSONType Type
JSONType)
  }

filterf :: Definition
filterf :: Definition
filterf =
  Definition :: Variable -> Text -> Type -> Core -> Definition
Definition
  { definitionDoc :: Text
definitionDoc = Text
"Keep only items from the sequence for which p returns true"
  , definitionName :: Variable
definitionName = Text -> Variable
Variable Text
"filter"
  , definitionCore :: Core
definitionCore =
      (Core -> Core) -> Core
EvalCore
        (\Core
f ->
           (Core -> Core) -> Core
EvalCore
             (\Core
xs ->
                case Core
xs of
                  (ConstantCore (StringConstant Text
xs')) ->
                    (Constant -> Core
ConstantCore
                       (Text -> Constant
StringConstant
                          ((Char -> Bool) -> Text -> Text
T.filter
                             (\Char
x ->
                                case Core -> Core
eval
                                       (Core -> Core -> Core
ApplicationCore
                                          Core
f
                                          (Constant -> Core
ConstantCore
                                             (Text -> Constant
StringConstant (Char -> Text
T.singleton Char
x)))) of
                                  ConstantCore (BoolConstant Bool
b) -> Bool
b
                                  Core
_ -> Bool
True)
                             Text
xs')))
                  (ArrayCore Vector Core
xs') ->
                    (Vector Core -> Core
ArrayCore
                       ((Core -> Bool) -> Vector Core -> Vector Core
forall a. (a -> Bool) -> Vector a -> Vector a
V.filter
                          (\Core
x ->
                             case Core -> Core
eval (Core -> Core -> Core
ApplicationCore Core
f Core
x) of
                               ConstantCore (BoolConstant Bool
b) -> Bool
b
                               Core
_ -> Bool
True)
                          Vector Core
xs'))
                  Core
_ -> [Char] -> Core
forall a. HasCallStack => [Char] -> a
error [Char]
"can only filter over sequences"))
  , definitionType :: Type
definitionType =
      Type -> Type -> Type
FunctionType
        (Type -> Type -> Type
FunctionType Type
JSONType Type
JSONType)
        (Type -> Type -> Type
FunctionType Type
JSONType Type
JSONType)
  }

mapf :: Definition
mapf :: Definition
mapf =
  Definition :: Variable -> Text -> Type -> Core -> Definition
Definition
  { definitionDoc :: Text
definitionDoc = Text
"Apply a function to every element in the sequence"
  , definitionName :: Variable
definitionName = Text -> Variable
Variable Text
"map"
  , definitionCore :: Core
definitionCore =
      (Core -> Core) -> Core
EvalCore
        (\Core
f ->
           (Core -> Core) -> Core
EvalCore
             (\Core
xs ->
                case Core
xs of
                  (ConstantCore (StringConstant Text
xs')) ->
                    (Constant -> Core
ConstantCore
                       (Text -> Constant
StringConstant
                          ((Char -> Text) -> Text -> Text
T.concatMap
                             (\Char
x ->
                                case Core -> Core
eval
                                       (Core -> Core -> Core
ApplicationCore
                                          Core
f
                                          (Constant -> Core
ConstantCore
                                             (Text -> Constant
StringConstant (Char -> Text
T.singleton Char
x)))) of
                                  ConstantCore (StringConstant Text
b) -> Text
b
                                  Core
_ -> [Char] -> Text
forall a. HasCallStack => [Char] -> a
error [Char]
"map over a string must return strings")
                             Text
xs')))
                  (ArrayCore Vector Core
xs') ->
                    (Vector Core -> Core
ArrayCore ((Core -> Core) -> Vector Core -> Vector Core
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Core
x -> (Core -> Core
eval (Core -> Core -> Core
ApplicationCore Core
f (Core
x)))) Vector Core
xs'))
                  Core
_ -> [Char] -> Core
forall a. HasCallStack => [Char] -> a
error [Char]
"can only map over sequences"))
  , definitionType :: Type
definitionType =
      Type -> Type -> Type
FunctionType
        (Type -> Type -> Type
FunctionType Type
JSONType Type
JSONType)
        (Type -> Type -> Type
FunctionType Type
JSONType Type
JSONType)
  }

--------------------------------------------------------------------------------
-- Function builders

arithmeticOperator :: Text -> (Scientific -> Scientific -> Scientific) -> Definition
arithmeticOperator :: Text -> (Scientific -> Scientific -> Scientific) -> Definition
arithmeticOperator Text
name Scientific -> Scientific -> Scientific
f =
  Definition :: Variable -> Text -> Type -> Core -> Definition
Definition
  { definitionName :: Variable
definitionName = Text -> Variable
Variable Text
name
  , definitionCore :: Core
definitionCore =
      (Core -> Core) -> Core
EvalCore
        (\Core
x ->
           (Core -> Core) -> Core
EvalCore
             (\Core
y ->
                case (Core
x, Core
y) of
                  (ConstantCore (NumberConstant Scientific
a), ConstantCore (NumberConstant Scientific
b)) ->
                    Constant -> Core
ConstantCore (Scientific -> Constant
NumberConstant (Scientific -> Scientific -> Scientific
f Scientific
a Scientific
b))
                  (Core, Core)
_ -> [Char] -> Core
forall a. HasCallStack => [Char] -> a
error ([Char]
"type error for arguments to " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
forall a. Show a => a -> [Char]
show Text
name)))
  , definitionType :: Type
definitionType = Type
JSONType Type -> Type -> Type
.-> Type
JSONType Type -> Type -> Type
.-> Type
JSONType
  , definitionDoc :: Text
definitionDoc = Text
"a " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" b"
  }

boolOperator :: Text -> (Bool -> Bool -> Bool) -> Definition
boolOperator :: Text -> (Bool -> Bool -> Bool) -> Definition
boolOperator Text
name Bool -> Bool -> Bool
f =
  Definition :: Variable -> Text -> Type -> Core -> Definition
Definition
  { definitionName :: Variable
definitionName = Text -> Variable
Variable Text
name
  , definitionCore :: Core
definitionCore =
      (Core -> Core) -> Core
EvalCore
        (\Core
x ->
           (Core -> Core) -> Core
EvalCore
             (\Core
y ->
                case (Core
x, Core
y) of
                  (ConstantCore (BoolConstant Bool
a), ConstantCore (BoolConstant Bool
b)) ->
                    Constant -> Core
ConstantCore (Bool -> Constant
BoolConstant (Bool -> Bool -> Bool
f Bool
a Bool
b))
                  (Core, Core)
_ -> [Char] -> Core
forall a. HasCallStack => [Char] -> a
error ([Char]
"type error for arguments to " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
forall a. Show a => a -> [Char]
show Text
name)))
  , definitionType :: Type
definitionType = Type
JSONType Type -> Type -> Type
.-> Type
JSONType Type -> Type -> Type
.-> Type
JSONType
  , definitionDoc :: Text
definitionDoc = Text
"a " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" b"
  }

arithmeticFun :: Text -> (Scientific -> Scientific) -> Definition
arithmeticFun :: Text -> (Scientific -> Scientific) -> Definition
arithmeticFun Text
name Scientific -> Scientific
f =
  Definition :: Variable -> Text -> Type -> Core -> Definition
Definition
  { definitionName :: Variable
definitionName = Text -> Variable
Variable Text
name
  , definitionCore :: Core
definitionCore =
      (Core -> Core) -> Core
EvalCore
        (\Core
x ->
           case (Core
x) of
             (ConstantCore (NumberConstant Scientific
a)) ->
               Constant -> Core
ConstantCore (Scientific -> Constant
NumberConstant (Scientific -> Scientific
f Scientific
a))
             Core
_ -> [Char] -> Core
forall a. HasCallStack => [Char] -> a
error ([Char]
"type error for arguments to " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
forall a. Show a => a -> [Char]
show Text
name))
  , definitionType :: Type
definitionType = Type
JSONType Type -> Type -> Type
.-> Type
JSONType
  , definitionDoc :: Text
definitionDoc = Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" b"
  }

boolFun :: Text -> (Bool -> Bool) -> Definition
boolFun :: Text -> (Bool -> Bool) -> Definition
boolFun Text
name Bool -> Bool
f =
  Definition :: Variable -> Text -> Type -> Core -> Definition
Definition
  { definitionName :: Variable
definitionName = Text -> Variable
Variable Text
name
  , definitionCore :: Core
definitionCore =
      (Core -> Core) -> Core
EvalCore
        (\Core
x ->
           case (Core
x) of
             (ConstantCore (BoolConstant Bool
a)) ->
               Constant -> Core
ConstantCore (Bool -> Constant
BoolConstant (Bool -> Bool
f Bool
a))
             Core
_ -> [Char] -> Core
forall a. HasCallStack => [Char] -> a
error ([Char]
"type error for arguments to " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
forall a. Show a => a -> [Char]
show Text
name))
  , definitionType :: Type
definitionType = Type
JSONType Type -> Type -> Type
.-> Type
JSONType
  , definitionDoc :: Text
definitionDoc = Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" b"
  }

predicateOperator :: Text -> (Value -> Value -> Bool) -> Definition
predicateOperator :: Text -> (Value -> Value -> Bool) -> Definition
predicateOperator Text
name Value -> Value -> Bool
f =
  Definition :: Variable -> Text -> Type -> Core -> Definition
Definition
  { definitionName :: Variable
definitionName = Text -> Variable
Variable Text
name
  , definitionCore :: Core
definitionCore =
      (Core -> Core) -> Core
EvalCore
        (\Core
x ->
           (Core -> Core) -> Core
EvalCore
             (\Core
y ->
                Constant -> Core
ConstantCore (Bool -> Constant
BoolConstant (Value -> Value -> Bool
f (Core -> Value
coreToValue Core
x) (Core -> Value
coreToValue Core
y)))))
  , definitionType :: Type
definitionType = Type
JSONType Type -> Type -> Type
.-> Type
JSONType Type -> Type -> Type
.-> Type
JSONType
  , definitionDoc :: Text
definitionDoc = Text
"a " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" b"
  }

numericPredicateOperator :: Text -> (Scientific -> Scientific -> Bool) -> Definition
numericPredicateOperator :: Text -> (Scientific -> Scientific -> Bool) -> Definition
numericPredicateOperator Text
name Scientific -> Scientific -> Bool
f =
  Definition :: Variable -> Text -> Type -> Core -> Definition
Definition
  { definitionName :: Variable
definitionName = Text -> Variable
Variable Text
name
  , definitionCore :: Core
definitionCore =
      (Core -> Core) -> Core
EvalCore
        (\Core
x ->
           (Core -> Core) -> Core
EvalCore
             (\Core
y ->
                case (Core
x, Core
y) of
                  (ConstantCore (NumberConstant Scientific
a), ConstantCore (NumberConstant Scientific
b)) ->
                    Constant -> Core
ConstantCore (Bool -> Constant
BoolConstant (Scientific -> Scientific -> Bool
f Scientific
a Scientific
b))
                  (Core, Core)
_ -> [Char] -> Core
forall a. HasCallStack => [Char] -> a
error ([Char]
"type error for arguments to " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
forall a. Show a => a -> [Char]
show Text
name)))
  , definitionType :: Type
definitionType = Type
JSONType Type -> Type -> Type
.-> Type
JSONType Type -> Type -> Type
.-> Type
JSONType
  , definitionDoc :: Text
definitionDoc = Text
"a " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" b"
  }

--------------------------------------------------------------------------------
-- Handy combinators

-- | Type a -> b.
(.->) :: Type -> Type -> Type
Type
a .-> :: Type -> Type -> Type
.-> Type
b = Type -> Type -> Type
FunctionType Type
a Type
b
infixr 9 .->