content: {-# 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 = M.fromList (map (definitionName &&& definitionType) (concatMap snd functions))
  
  -- | Bindings available in scope.
  scope :: Map Variable Core
  scope = M.fromList (map (definitionName &&&definitionCore) (concatMap snd functions))
  
  -- | All functions.
  functions :: [(Text, [Definition])]
  functions =
    [ ("Record access", [getf, setf, modifyf, keysf, elemsf])
    , ( "Sequences"
      , [ mapf
        , filterf
        , takeWhilef
        , empty
        , len
        , rev
        , dropf
        , elemf
        , concatf
        , zipw
        , takef
        , foldf
        , dropWhilef
        , anyf
        , allf
        , nubf
        , sortf
        , appendf
        , sumf
        , productf
        , minimumf
        , maximumf
        ])
    , ("Strings", [wordsf, unwordsf, linesf, unlinesf])
    , ( "Predicate operators"
      , [predicateOperator "/=" (/=), predicateOperator "=" (==)])
    , ( "Boolean operators"
      , [boolOperator "&&" (&&), boolOperator "||" (||), boolFun "not" not])
    , ( "Numeric operators"
      , [ numericPredicateOperator ">" (>)
        , numericPredicateOperator "<" (<)
        , numericPredicateOperator ">=" (>=)
        , numericPredicateOperator "<=" (<=)
        , arithmeticOperator "*" (*)
        , arithmeticOperator "+" (+)
        , arithmeticOperator "-" (-)
        , arithmeticOperator "/" (/)
        , arithmeticOperator "min" min
        , arithmeticOperator "max" max
        , arithmeticFun "abs" abs
        ])
    , ("Function combinators", [idf, compose, flipf])
    ]
  
  --------------------------------------------------------------------------------
  -- Functions
  
  keysf :: Definition
  keysf =
    Definition
    { definitionDoc = "Get all keys of the object"
    , definitionName = Variable "keys"
    , definitionCore =
        (EvalCore
           (\obj ->
              case obj of
                RecordCore o ->
                  ArrayCore
                    (V.fromList (map (ConstantCore . StringConstant) (HM.keys o)))
                _ -> error "keys function expected an object"))
    , definitionType = FunctionType JSONType JSONType
    }
  
  elemsf :: Definition
  elemsf =
    Definition
    { definitionDoc = "Get all elements of the object"
    , definitionName = Variable "elems"
    , definitionCore =
        (EvalCore
           (\obj ->
              case obj of
                RecordCore o ->
                  ArrayCore
                    (V.fromList (HM.elems o))
                _ -> error "elems function expected an object"))
    , definitionType = FunctionType JSONType JSONType
    }
  
  modifyf :: Definition
  modifyf =
    Definition
    { definitionDoc = "Modify the object at k with function f"
    , definitionName = Variable "modify"
    , definitionCore =
        (EvalCore
           (\key ->
              EvalCore
                (\f ->
                   EvalCore
                     (\obj ->
                        case (key, obj) of
                          (ConstantCore (StringConstant k), (RecordCore o)) ->
                            (RecordCore
                               (HM.adjust (\v -> eval (ApplicationCore f v)) k o))
                          _ -> error "type error for args to modify"))))
    , definitionType =
        FunctionType
          JSONType
          (FunctionType
             (FunctionType JSONType JSONType)
             (FunctionType JSONType JSONType))
    }
  
  getf :: Definition
  getf =
    Definition
    { definitionDoc = "Get the value at k from the object"
    , definitionName = Variable "get"
    , definitionCore =
        (EvalCore
           (\key ->
              EvalCore
                (\obj ->
                   case (key, obj) of
                     (ConstantCore (StringConstant k), RecordCore o) ->
                       (case HM.lookup k o of
                          Nothing -> error ("missing key " <> show k)
                          Just v -> v)
                     (ConstantCore (NumberConstant i), (ArrayCore v)) ->
                       (case v V.!? (round i) of
                          Nothing -> error ("missing array index " <> show i)
                          Just v' -> v')
                     _ -> error "type error for get arguments")))
    , definitionType = FunctionType JSONType (FunctionType JSONType JSONType)
    }
  
  setf :: Definition
  setf =
    Definition
    { definitionDoc = "Set the value k to v in object"
    , definitionName = Variable "set"
    , definitionCore =
        (EvalCore
           (\key ->
              EvalCore
                (\val ->
                   EvalCore
                     (\obj ->
                        case (key, val, obj) of
                          (ConstantCore (StringConstant k), v, RecordCore o) ->
                            (RecordCore (HM.insert k v o))
                          _ -> error "type error in arguments to: set"))))
    , definitionType =
        FunctionType
          JSONType
          (FunctionType JSONType (FunctionType JSONType JSONType))
    }
  
  idf :: Definition
  idf =
    Definition
    { definitionDoc = "Identity function, returns its input unchanged"
    , definitionName = Variable "id"
    , definitionCore = (EvalCore (\x -> x))
    , definitionType = FunctionType JSONType JSONType
    }
  
  flipf :: Definition
  flipf =
    Definition
    { definitionDoc = "Flips the argument order of a function of two or more arguments"
    , definitionName = Variable "flip"
    , definitionCore =
        (EvalCore
           (\f ->
              EvalCore
                (\x ->
                   EvalCore (\y -> eval (ApplicationCore (ApplicationCore f y) x)))))
    , definitionType =
        FunctionType
          (FunctionType JSONType (FunctionType JSONType JSONType))
          (FunctionType JSONType (FunctionType JSONType JSONType))
    }
  
  compose :: Definition
  compose =
    Definition
    { definitionDoc = "Compose two functions"
    , definitionName = Variable "compose"
    , definitionCore =
        EvalCore
          (\f ->
             EvalCore
               (\g ->
                  EvalCore (\x -> eval (ApplicationCore g (ApplicationCore f x)))))
    , definitionType =
        FunctionType
          (FunctionType JSONType JSONType)
          (FunctionType
             (FunctionType JSONType JSONType)
             (FunctionType JSONType JSONType))
    }
  
  foldf :: Definition
  foldf =
    Definition
    { definitionDoc = "Fold over a structure with a state."
    , definitionName = Variable "fold"
    , definitionCore =
        EvalCore
          (\cons ->
             EvalCore
               (\nil ->
                  EvalCore
                    (\xs ->
                       case xs of
                         ArrayCore xs' ->
                           (V.foldl
                              (\acc x ->
                                 eval
                                   (ApplicationCore (ApplicationCore cons acc) x))
                              nil
                              xs')
                         ConstantCore (StringConstant xs') ->
                           (T.foldl
                              (\acc x ->
                                 eval
                                   (ApplicationCore
                                      (ApplicationCore cons acc)
                                      (ConstantCore
                                         (StringConstant (T.singleton x)))))
                              nil
                              xs')
                         _ -> error "can only fold sequences")))
    , definitionType =
        (FunctionType
           ((FunctionType JSONType (FunctionType JSONType JSONType)))
           (FunctionType JSONType (FunctionType JSONType JSONType)))
    }
  
  zipw :: Definition
  zipw =
    Definition
    { definitionDoc = "Zip two lists calling with each element to f x y"
    , definitionName = Variable "zipWith"
    , definitionCore =
        EvalCore
          (\f ->
             EvalCore
               (\xs ->
                  EvalCore
                    (\ys ->
                       case (xs, ys) of
                         (ArrayCore xs', ArrayCore ys') ->
                           (ArrayCore
                              (V.zipWith
                                 (\x y ->
                                    eval (ApplicationCore (ApplicationCore f x) y))
                                 xs'
                                 ys'))
                         _ -> error "can only zip two arrays")))
    , definitionType =
        FunctionType
          (FunctionType JSONType (FunctionType JSONType JSONType))
          (FunctionType JSONType (FunctionType JSONType JSONType))
    }
  
  elemf :: Definition
  elemf =
    Definition
    { definitionDoc = "Is x an element of y?"
    , definitionName = Variable "elem"
    , definitionCore =
        EvalCore
          (\n ->
             EvalCore
               (\xs ->
                  case xs of
                    (ArrayCore xs') ->
                      (ConstantCore
                         (BoolConstant
                            (V.elem (coreToValue n) (fmap coreToValue xs'))))
                    (ConstantCore (StringConstant xs')) ->
                      (ConstantCore
                         (BoolConstant
                            (isJust
                               (T.findIndex
                                  (\cc ->
                                     case n of
                                       ConstantCore (StringConstant c) ->
                                         c == T.singleton cc
                                       _ -> False)
                                  xs'))))
                    _ ->
                      error
                        "can only check elements from sequences"))
    , definitionType = FunctionType JSONType (FunctionType JSONType JSONType)
    }
  
  takef :: Definition
  takef =
    Definition
    { definitionDoc = "Take n items from sequence"
    , definitionName = Variable "take"
    , definitionCore =
        EvalCore
          (\n ->
             EvalCore
               (\xs ->
                  case (n, xs) of
                    (ConstantCore (NumberConstant n'), ArrayCore xs') ->
                      (ArrayCore (V.take (round n') xs'))
                    (ConstantCore (NumberConstant n'), ConstantCore (StringConstant xs')) ->
                      (ConstantCore (StringConstant (T.take (round n') xs')))
                    _ -> error "can only take from sequences"))
    , definitionType = FunctionType JSONType (FunctionType JSONType JSONType)
    }
  
  dropf :: Definition
  dropf =
    Definition
    { definitionDoc = "Drop n items from the sequence"
    , definitionName = Variable "drop"
    , definitionCore =
        EvalCore
          (\n ->
             EvalCore
               (\xs ->
                  case (n, xs) of
                    (ConstantCore (NumberConstant n'), ConstantCore (StringConstant xs')) ->
                      (ConstantCore (StringConstant (T.drop (round n') xs')))
                    (ConstantCore (NumberConstant n'), ArrayCore xs') ->
                      (ArrayCore (V.drop (round n') xs'))
                    _ -> error "can only drop from sequences"))
    , definitionType = FunctionType JSONType (FunctionType JSONType JSONType)
    }
  
  concatf :: Definition
  concatf =
    Definition
    { definitionDoc = "Concatenate a list of sequences into one sequence"
    , definitionName = Variable "concat"
    , definitionCore =
        (EvalCore
           (\xs ->
              case xs of
                (ArrayCore xs') ->
                  (ArrayCore (V.concat (map coreToArray (V.toList xs'))))
                _ -> error "can only concat arrays"))
    , definitionType = FunctionType JSONType JSONType
    }
  
  rev :: Definition
  rev =
    Definition
    { definitionDoc = "Reverse a sequence"
    , definitionName = Variable "reverse"
    , definitionCore =
        (EvalCore
           (\xs ->
              case xs of
                (ArrayCore xs') -> (ArrayCore (V.reverse xs'))
                (ConstantCore (StringConstant xs')) ->
                  (ConstantCore (StringConstant (T.reverse xs')))
                _ -> error "can only reverse a sequence"))
    , definitionType = FunctionType JSONType JSONType
    }
  
  appendf :: Definition
  appendf =
    Definition
    { definitionDoc = "Append the members of the second sequence to the first sequence"
    , definitionName = Variable "append"
    , definitionCore =
        (EvalCore
           (\xs ->
              (EvalCore
                 (\ys ->
                    case (xs, ys) of
                      (ArrayCore xs', ArrayCore ys') -> (ArrayCore (xs' <> ys'))
                      (ConstantCore (StringConstant xs'), ConstantCore (StringConstant ys')) ->
                        (ConstantCore (StringConstant (xs' <> ys')))
                      _ -> error "can only append two sequences of the same type"))))
    , definitionType = FunctionType JSONType (FunctionType JSONType JSONType)
    }
  
  nubf :: Definition
  nubf =
    Definition
    { definitionDoc = "Return the sequence with no duplicates; the nub of it"
    , definitionName = Variable "nub"
    , definitionCore =
        (EvalCore
           (\xs ->
              case xs of
                (ArrayCore xs') ->
                  (ArrayCore
                     (V.fromList (nubBy (on (==) coreToValue) (V.toList xs'))))
                (ConstantCore (StringConstant xs')) ->
                  (ConstantCore
                     (StringConstant
                        (T.pack (nub (T.unpack xs')))))
                _ -> error "can only nub a sequence"))
    , definitionType = FunctionType JSONType JSONType
    }
  
  linesf :: Definition
  linesf =
    Definition
    { definitionDoc = "Split the string into a list of lines"
    , definitionName = Variable "lines"
    , definitionCore =
        (EvalCore
           (\xs ->
              case xs of
                (ConstantCore (StringConstant xs')) ->
                  (ArrayCore
                     (V.map
                        (ConstantCore . StringConstant)
                        ((V.fromList (T.lines xs')))))
                _ -> error "can only lines a string"))
    , definitionType = FunctionType JSONType JSONType
    }
  
  wordsf :: Definition
  wordsf =
    Definition
    { definitionDoc = "Split the string into a list of words"
    , definitionName = Variable "words"
    , definitionCore =
        (EvalCore
           (\xs ->
              case xs of
                (ConstantCore (StringConstant xs')) ->
                  (ArrayCore
                     (V.map
                        (ConstantCore . StringConstant)
                        ((V.fromList (T.words xs')))))
                _ -> error "can only words a string"))
    , definitionType = FunctionType JSONType JSONType
    }
  
  unwordsf :: Definition
  unwordsf =
    Definition
    { definitionDoc = "Join the list of strings into a string separated by spaces"
    , definitionName = Variable "unwords"
    , definitionCore =
        (EvalCore
           (\xs ->
              case xs of
                (ArrayCore xs') ->
                  (ConstantCore (StringConstant (T.unwords (V.toList (fmap coreToString xs')))))
                _ -> error "can only unwords a string"))
    , definitionType = FunctionType JSONType JSONType
    }
  
  unlinesf :: Definition
  unlinesf =
    Definition
    { definitionDoc = "Join the list of strings into a string separated by lines and terminated by a new line"
    , definitionName = Variable "unlines"
    , definitionCore =
        (EvalCore
           (\xs ->
              case xs of
                (ArrayCore xs') ->
                  (ConstantCore (StringConstant (T.unlines (V.toList (fmap coreToString xs')))))
                _ -> error "can only unlines a string"))
    , definitionType = FunctionType JSONType JSONType
    }
  
  sortf :: Definition
  sortf =
    Definition
    { definitionDoc = "Return the sequence sorted"
    , definitionName = Variable "sort"
    , definitionCore =
        (EvalCore
           (\xs ->
              case xs of
                (ArrayCore xs') ->
                  (ArrayCore
                     (V.fromList (sortBy (comparing coreToCompare) (V.toList xs'))))
                (ConstantCore (StringConstant xs')) ->
                  (ConstantCore
                     (StringConstant
                        (T.pack (sort (T.unpack xs')))))
                _ -> error "can only sort a sequence"))
    , definitionType = FunctionType JSONType JSONType
    }
  
  len :: Definition
  len =
    Definition
    { definitionDoc = "Get the length of a sequence"
    , definitionName = Variable "length"
    , definitionCore =
        (EvalCore
           (\xs ->
              case xs of
                (ArrayCore xs') ->
                  (ConstantCore (NumberConstant (fromIntegral (V.length xs'))))
                (ConstantCore (StringConstant xs')) ->
                  (ConstantCore (NumberConstant (fromIntegral (T.length xs'))))
                _ -> error "can only take length of sequences"))
    , definitionType = FunctionType JSONType JSONType
    }
  
  sumf :: Definition
  sumf =
    Definition
    { definitionDoc = "Get the sum of a sequence"
    , definitionName = Variable "sum"
    , definitionCore =
        (EvalCore
           (\xs ->
              case xs of
                (ArrayCore xs') ->
                  (ConstantCore (NumberConstant (V.sum (fmap coreToNumber xs'))))
                _ -> error "can only take sum of arrays"))
    , definitionType = FunctionType JSONType JSONType
    }
  
  productf :: Definition
  productf =
    Definition
    { definitionDoc = "Get the product of a sequence"
    , definitionName = Variable "product"
    , definitionCore =
        (EvalCore
           (\xs ->
              case xs of
                (ArrayCore xs') ->
                  (ConstantCore (NumberConstant (V.product (fmap coreToNumber xs'))))
                _ -> error "can only take product of arrays"))
    , definitionType = FunctionType JSONType JSONType
    }
  
  maximumf :: Definition
  maximumf =
    Definition
    { definitionDoc = "Get the maximum of a sequence"
    , definitionName = Variable "maximum"
    , definitionCore =
        (EvalCore
           (\xs ->
              case xs of
                (ArrayCore xs') ->
                  (ConstantCore (NumberConstant (V.maximum (fmap coreToNumber xs'))))
                _ -> error "can only take maximum of arrays"))
    , definitionType = FunctionType JSONType JSONType
    }
  
  minimumf :: Definition
  minimumf =
    Definition
    { definitionDoc = "Get the minimum of a sequence"
    , definitionName = Variable "minimum"
    , definitionCore =
        (EvalCore
           (\xs ->
              case xs of
                (ArrayCore xs') ->
                  (ConstantCore (NumberConstant (V.minimum (fmap coreToNumber xs'))))
                _ -> error "can only take minimum of arrays"))
    , definitionType = FunctionType JSONType JSONType
    }
  
  empty :: Definition
  empty =
    Definition
    { definitionDoc = "Is a sequence empty?"
    , definitionName = Variable "empty"
    , definitionCore =
        (EvalCore
           (\xs ->
              case xs of
                (ArrayCore xs') -> (ConstantCore (BoolConstant (V.null xs')))
                (ConstantCore (StringConstant xs')) ->
                  (ConstantCore (BoolConstant (T.null xs')))
                _ -> error "can only check if sequences are empty"))
    , definitionType = FunctionType JSONType JSONType
    }
  
  anyf :: Definition
  anyf =
    Definition
    { definitionDoc = "Does p return true for any of the elements?"
    , definitionName = Variable "any"
    , definitionCore =
        EvalCore
          (\f ->
             EvalCore
               (\xs ->
                  case xs of
                    (ArrayCore xs') ->
                      (ConstantCore
                         (BoolConstant
                            (V.any
                               (\x ->
                                  case eval (ApplicationCore f x) of
                                    ConstantCore (BoolConstant b) -> b
                                    _ -> True)
                               xs')))
                    (ConstantCore (StringConstant xs')) ->
                      (ConstantCore
                         (BoolConstant
                            (T.any
                               (\x ->
                                  case eval
                                         (ApplicationCore
                                            f
                                            (ConstantCore
                                               (StringConstant (T.singleton x)))) of
                                    ConstantCore (BoolConstant b) -> b
                                    _ -> True)
                               xs')))
                    _ -> error "can only any over sequences"))
    , definitionType =
        FunctionType
          (FunctionType JSONType JSONType)
          (FunctionType JSONType JSONType)
    }
  
  allf :: Definition
  allf =
    Definition
    { definitionDoc = "Does p return true for all of the elements?"
    , definitionName = Variable "all"
    , definitionCore =
        EvalCore
          (\f ->
             EvalCore
               (\xs ->
                  case xs of
                    (ArrayCore xs') ->
                      (ConstantCore
                         (BoolConstant
                            (V.all
                               (\x ->
                                  case eval (ApplicationCore f x) of
                                    ConstantCore (BoolConstant b) -> b
                                    _ -> True)
                               xs')))
                    (ConstantCore (StringConstant xs')) ->
                      (ConstantCore
                         (BoolConstant
                            (T.all
                               (\x ->
                                  case eval
                                         (ApplicationCore
                                            f
                                            (ConstantCore
                                               (StringConstant (T.singleton x)))) of
                                    ConstantCore (BoolConstant b) -> b
                                    _ -> True)
                               xs')))
                    _ -> error "can only all over sequences"))
    , definitionType =
        FunctionType
          (FunctionType JSONType JSONType)
          (FunctionType JSONType JSONType)
    }
  
  dropWhilef :: Definition
  dropWhilef =
    Definition
    { definitionDoc = "Drop elements from a sequence while a predicate is true"
    , definitionName = Variable "dropWhile"
    , definitionCore =
        EvalCore
          (\f ->
             EvalCore
               (\xs ->
                  case xs of
                    (ArrayCore xs') ->
                      (ArrayCore
                         (V.dropWhile
                            (\x ->
                               case eval (ApplicationCore f x) of
                                 ConstantCore (BoolConstant b) -> b
                                 _ -> True)
                            xs'))
                    (ConstantCore (StringConstant xs')) ->
                      (ConstantCore
                         (StringConstant
                            (T.dropWhile
                               (\x ->
                                  case eval
                                         (ApplicationCore
                                            f
                                            (ConstantCore
                                               (StringConstant (T.singleton x)))) of
                                    ConstantCore (BoolConstant b) -> b
                                    _ -> True)
                               xs')))
                    _ -> error "can only dropWhile over sequences"))
    , definitionType =
        FunctionType
          (FunctionType JSONType JSONType)
          (FunctionType JSONType JSONType)
    }
  
  takeWhilef :: Definition
  takeWhilef =
    Definition
    { definitionDoc =
        "Take elements from a sequence while given predicate is true"
    , definitionName = Variable "takeWhile"
    , definitionCore =
        (EvalCore
           (\f ->
              EvalCore
                (\xs ->
                   case xs of
                     (ConstantCore (StringConstant xs')) ->
                       (ConstantCore
                          (StringConstant
                             (T.takeWhile
                                (\x ->
                                   case eval
                                          (ApplicationCore
                                             f
                                             (ConstantCore
                                                (StringConstant (T.singleton x)))) of
                                     ConstantCore (BoolConstant b) -> b
                                     _ -> True)
                                xs')))
                     (ArrayCore xs') ->
                       (ArrayCore
                          (V.takeWhile
                             (\x ->
                                case eval (ApplicationCore f x) of
                                  ConstantCore (BoolConstant b) -> b
                                  _ -> True)
                             xs'))
                     _ -> error "can only takeWhile over sequences")))
    , definitionType =
        FunctionType
          (FunctionType JSONType JSONType)
          (FunctionType JSONType JSONType)
    }
  
  filterf :: Definition
  filterf =
    Definition
    { definitionDoc = "Keep only items from the sequence for which p returns true"
    , definitionName = Variable "filter"
    , definitionCore =
        EvalCore
          (\f ->
             EvalCore
               (\xs ->
                  case xs of
                    (ConstantCore (StringConstant xs')) ->
                      (ConstantCore
                         (StringConstant
                            (T.filter
                               (\x ->
                                  case eval
                                         (ApplicationCore
                                            f
                                            (ConstantCore
                                               (StringConstant (T.singleton x)))) of
                                    ConstantCore (BoolConstant b) -> b
                                    _ -> True)
                               xs')))
                    (ArrayCore xs') ->
                      (ArrayCore
                         (V.filter
                            (\x ->
                               case eval (ApplicationCore f x) of
                                 ConstantCore (BoolConstant b) -> b
                                 _ -> True)
                            xs'))
                    _ -> error "can only filter over sequences"))
    , definitionType =
        FunctionType
          (FunctionType JSONType JSONType)
          (FunctionType JSONType JSONType)
    }
  
  mapf :: Definition
  mapf =
    Definition
    { definitionDoc = "Apply a function to every element in the sequence"
    , definitionName = Variable "map"
    , definitionCore =
        EvalCore
          (\f ->
             EvalCore
               (\xs ->
                  case xs of
                    (ConstantCore (StringConstant xs')) ->
                      (ConstantCore
                         (StringConstant
                            (T.concatMap
                               (\x ->
                                  case eval
                                         (ApplicationCore
                                            f
                                            (ConstantCore
                                               (StringConstant (T.singleton x)))) of
                                    ConstantCore (StringConstant b) -> b
                                    _ -> error "map over a string must return strings")
                               xs')))
                    (ArrayCore xs') ->
                      (ArrayCore (fmap (\x -> (eval (ApplicationCore f (x)))) xs'))
                    _ -> error "can only map over sequences"))
    , definitionType =
        FunctionType
          (FunctionType JSONType JSONType)
          (FunctionType JSONType JSONType)
    }
  
  --------------------------------------------------------------------------------
  -- Function builders
  
  arithmeticOperator :: Text -> (Scientific -> Scientific -> Scientific) -> Definition
  arithmeticOperator name f =
    Definition
    { definitionName = Variable name
    , definitionCore =
        EvalCore
          (\x ->
             EvalCore
               (\y ->
                  case (x, y) of
                    (ConstantCore (NumberConstant a), ConstantCore (NumberConstant b)) ->
                      ConstantCore (NumberConstant (f a b))
                    _ -> error ("type error for arguments to " <> show name)))
    , definitionType = JSONType .-> JSONType .-> JSONType
    , definitionDoc = "a " <> name <> " b"
    }
  
  boolOperator :: Text -> (Bool -> Bool -> Bool) -> Definition
  boolOperator name f =
    Definition
    { definitionName = Variable name
    , definitionCore =
        EvalCore
          (\x ->
             EvalCore
               (\y ->
                  case (x, y) of
                    (ConstantCore (BoolConstant a), ConstantCore (BoolConstant b)) ->
                      ConstantCore (BoolConstant (f a b))
                    _ -> error ("type error for arguments to " <> show name)))
    , definitionType = JSONType .-> JSONType .-> JSONType
    , definitionDoc = "a " <> name <> " b"
    }
  
  arithmeticFun :: Text -> (Scientific -> Scientific) -> Definition
  arithmeticFun name f =
    Definition
    { definitionName = Variable name
    , definitionCore =
        EvalCore
          (\x ->
             case (x) of
               (ConstantCore (NumberConstant a)) ->
                 ConstantCore (NumberConstant (f a))
               _ -> error ("type error for arguments to " <> show name))
    , definitionType = JSONType .-> JSONType
    , definitionDoc = name <> " b"
    }
  
  boolFun :: Text -> (Bool -> Bool) -> Definition
  boolFun name f =
    Definition
    { definitionName = Variable name
    , definitionCore =
        EvalCore
          (\x ->
             case (x) of
               (ConstantCore (BoolConstant a)) ->
                 ConstantCore (BoolConstant (f a))
               _ -> error ("type error for arguments to " <> show name))
    , definitionType = JSONType .-> JSONType
    , definitionDoc = name <> " b"
    }
  
  predicateOperator :: Text -> (Value -> Value -> Bool) -> Definition
  predicateOperator name f =
    Definition
    { definitionName = Variable name
    , definitionCore =
        EvalCore
          (\x ->
             EvalCore
               (\y ->
                  ConstantCore (BoolConstant (f (coreToValue x) (coreToValue y)))))
    , definitionType = JSONType .-> JSONType .-> JSONType
    , definitionDoc = "a " <> name <> " b"
    }
  
  numericPredicateOperator :: Text -> (Scientific -> Scientific -> Bool) -> Definition
  numericPredicateOperator name f =
    Definition
    { definitionName = Variable name
    , definitionCore =
        EvalCore
          (\x ->
             EvalCore
               (\y ->
                  case (x, y) of
                    (ConstantCore (NumberConstant a), ConstantCore (NumberConstant b)) ->
                      ConstantCore (BoolConstant (f a b))
                    _ -> error ("type error for arguments to " <> show name)))
    , definitionType = JSONType .-> JSONType .-> JSONType
    , definitionDoc = "a " <> name <> " b"
    }
  
  --------------------------------------------------------------------------------
  -- Handy combinators
  
  -- | Type a -> b.
  (.->) :: Type -> Type -> Type
  a .-> b = FunctionType a b
  infixr 9 .->
  