{-# LANGUAGE CPP #-}
{-# LANGUAGE ExtendedDefaultRules #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -fno-warn-type-defaults #-}

-- |
-- Module      : Text.EDE.Internal.Filters
-- Copyright   : (c) 2013-2022 Brendan Hay <brendan.g.hay@gmail.com>
-- License     : This Source Code Form is subject to the terms of
--               the Mozilla Public License, v. 2.0.
--               A copy of the MPL can be found in the LICENSE file or
--               you can obtain it at http://mozilla.org/MPL/2.0/.
-- Maintainer  : Brendan Hay <brendan.g.hay@gmail.com>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--
-- /Warning/: this is an internal module, and does not have a stable
-- API or name. Functions in this module may not check or enforce
-- preconditions expected by public modules. Use at your own risk!
module Text.EDE.Internal.Filters where

import qualified Data.Aeson as Aeson
import Data.Aeson.Types (Value (..))
import qualified Data.Char as Char
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Maybe as Maybe
import Data.Scientific (Scientific)
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Lazy as Text.Lazy
import qualified Data.Text.Lazy.Encoding as Text.Lazy.Encoding
import qualified Data.Text.Manipulate as Text.Manipulate
import qualified Data.Text.Unsafe as Text.Unsafe
import Data.Vector (Vector)
import qualified Data.Vector as Vector
import Prettyprinter ((<+>))
import Text.EDE.Internal.Compat
import Text.EDE.Internal.Quoting
import Text.EDE.Internal.Types

default (Integer)

stdlib :: HashMap Text Term
stdlib :: HashMap Text Term
stdlib =
  [(Text, Term)] -> HashMap Text Term
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
    -- boolean
    [ Text
"!" Text -> (Bool -> Bool) -> (Text, Term)
forall a. Quote a => Text -> a -> (Text, Term)
@: Bool -> Bool
not,
      Text
"&&" Text -> (Bool -> Bool -> Bool) -> (Text, Term)
forall a. Quote a => Text -> a -> (Text, Term)
@: Bool -> Bool -> Bool
(&&),
      Text
"||" Text -> (Bool -> Bool -> Bool) -> (Text, Term)
forall a. Quote a => Text -> a -> (Text, Term)
@: Bool -> Bool -> Bool
(||),
      -- equality
      Text
"==" Text -> (Value -> Value -> Bool) -> (Text, Term)
forall a. Quote a => Text -> (Value -> Value -> a) -> (Text, Term)
`qpoly2` Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
(==),
      Text
"!=" Text -> (Value -> Value -> Bool) -> (Text, Term)
forall a. Quote a => Text -> (Value -> Value -> a) -> (Text, Term)
`qpoly2` Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
(/=),
      -- relational
      Text
">" Text -> (Scientific -> Scientific -> Bool) -> (Text, Term)
forall a.
Quote a =>
Text -> (Scientific -> Scientific -> a) -> (Text, Term)
`qnum2` Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
(>),
      Text
">=" Text -> (Scientific -> Scientific -> Bool) -> (Text, Term)
forall a.
Quote a =>
Text -> (Scientific -> Scientific -> a) -> (Text, Term)
`qnum2` Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
(>=),
      Text
"<=" Text -> (Scientific -> Scientific -> Bool) -> (Text, Term)
forall a.
Quote a =>
Text -> (Scientific -> Scientific -> a) -> (Text, Term)
`qnum2` Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
(<=),
      Text
"<" Text -> (Scientific -> Scientific -> Bool) -> (Text, Term)
forall a.
Quote a =>
Text -> (Scientific -> Scientific -> a) -> (Text, Term)
`qnum2` Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
(<),
      -- numeric
      Text
"+" Text -> (Scientific -> Scientific -> Scientific) -> (Text, Term)
forall a.
Quote a =>
Text -> (Scientific -> Scientific -> a) -> (Text, Term)
`qnum2` Scientific -> Scientific -> Scientific
forall a. Num a => a -> a -> a
(+),
      Text
"-" Text -> (Scientific -> Scientific -> Scientific) -> (Text, Term)
forall a.
Quote a =>
Text -> (Scientific -> Scientific -> a) -> (Text, Term)
`qnum2` (-),
      Text
"*" Text -> (Scientific -> Scientific -> Scientific) -> (Text, Term)
forall a.
Quote a =>
Text -> (Scientific -> Scientific -> a) -> (Text, Term)
`qnum2` Scientific -> Scientific -> Scientific
forall a. Num a => a -> a -> a
(*),
      Text
"abs" Text -> (Scientific -> Scientific) -> (Text, Term)
`qnum1` Scientific -> Scientific
forall a. Num a => a -> a
abs,
      Text
"signum" Text -> (Scientific -> Scientific) -> (Text, Term)
`qnum1` Scientific -> Scientific
forall a. Num a => a -> a
signum,
      Text
"negate" Text -> (Scientific -> Scientific) -> (Text, Term)
`qnum1` Scientific -> Scientific
forall a. Num a => a -> a
negate,
      -- fractional
      Text
"truncate" Text -> (Scientific -> Scientific) -> (Text, Term)
`qnum1` (Integer -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Scientific)
-> (Scientific -> Integer) -> Scientific -> Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Integer
forall b. Integral b => Scientific -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate),
      Text
"round" Text -> (Scientific -> Scientific) -> (Text, Term)
`qnum1` (Integer -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Scientific)
-> (Scientific -> Integer) -> Scientific -> Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Integer
forall b. Integral b => Scientific -> b
forall a b. (RealFrac a, Integral b) => a -> b
round),
      Text
"ceiling" Text -> (Scientific -> Scientific) -> (Text, Term)
`qnum1` (Integer -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Scientific)
-> (Scientific -> Integer) -> Scientific -> Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Integer
forall b. Integral b => Scientific -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling),
      Text
"floor" Text -> (Scientific -> Scientific) -> (Text, Term)
`qnum1` (Integer -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Scientific)
-> (Scientific -> Integer) -> Scientific -> Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Integer
forall b. Integral b => Scientific -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor),
      -- text
      Text
"lowerHead" Text -> (Text -> Text) -> (Text, Term)
forall a. Quote a => Text -> a -> (Text, Term)
@: Text -> Text
Text.Manipulate.lowerHead,
      Text
"upperHead" Text -> (Text -> Text) -> (Text, Term)
forall a. Quote a => Text -> a -> (Text, Term)
@: Text -> Text
Text.Manipulate.upperHead,
      Text
"toTitle" Text -> (Text -> Text) -> (Text, Term)
forall a. Quote a => Text -> a -> (Text, Term)
@: Text -> Text
Text.Manipulate.toTitle,
      Text
"toCamel" Text -> (Text -> Text) -> (Text, Term)
forall a. Quote a => Text -> a -> (Text, Term)
@: Text -> Text
Text.Manipulate.toCamel,
      Text
"toPascal" Text -> (Text -> Text) -> (Text, Term)
forall a. Quote a => Text -> a -> (Text, Term)
@: Text -> Text
Text.Manipulate.toPascal,
      Text
"toSnake" Text -> (Text -> Text) -> (Text, Term)
forall a. Quote a => Text -> a -> (Text, Term)
@: Text -> Text
Text.Manipulate.toSnake,
      Text
"toSpinal" Text -> (Text -> Text) -> (Text, Term)
forall a. Quote a => Text -> a -> (Text, Term)
@: Text -> Text
Text.Manipulate.toSpinal,
      Text
"toTrain" Text -> (Text -> Text) -> (Text, Term)
forall a. Quote a => Text -> a -> (Text, Term)
@: Text -> Text
Text.Manipulate.toTrain,
      Text
"toUpper" Text -> (Text -> Text) -> (Text, Term)
forall a. Quote a => Text -> a -> (Text, Term)
@: Text -> Text
Text.toUpper,
      Text
"toLower" Text -> (Text -> Text) -> (Text, Term)
forall a. Quote a => Text -> a -> (Text, Term)
@: Text -> Text
Text.toLower,
      Text
"toOrdinal" Text -> (Integer -> Text) -> (Text, Term)
forall a. Quote a => Text -> a -> (Text, Term)
@: (Integer -> Text
forall a. Integral a => a -> Text
Text.Manipulate.toOrdinal :: Integer -> Text),
      Text
"dropLower" Text -> (Text -> Text) -> (Text, Term)
forall a. Quote a => Text -> a -> (Text, Term)
@: (Char -> Bool) -> Text -> Text
Text.dropWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
Char.isUpper),
      Text
"dropUpper" Text -> (Text -> Text) -> (Text, Term)
forall a. Quote a => Text -> a -> (Text, Term)
@: (Char -> Bool) -> Text -> Text
Text.dropWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
Char.isLower),
      Text
"takeWord" Text -> (Text -> Text) -> (Text, Term)
forall a. Quote a => Text -> a -> (Text, Term)
@: Text -> Text
Text.Manipulate.takeWord,
      Text
"dropWord" Text -> (Text -> Text) -> (Text, Term)
forall a. Quote a => Text -> a -> (Text, Term)
@: Text -> Text
Text.Manipulate.dropWord,
      Text
"splitWords" Text -> (Text -> [Text]) -> (Text, Term)
forall a. Quote a => Text -> a -> (Text, Term)
@: Text -> [Text]
Text.Manipulate.splitWords,
      Text
"strip" Text -> (Text -> Text) -> (Text, Term)
forall a. Quote a => Text -> a -> (Text, Term)
@: Text -> Text
Text.strip,
      Text
"stripPrefix" Text -> (Text -> Text -> Text) -> (Text, Term)
forall a. Quote a => Text -> a -> (Text, Term)
@: (\Text
x Text
p -> Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
Maybe.fromMaybe Text
x (Text
p Text -> Text -> Maybe Text
`Text.stripPrefix` Text
x)),
      Text
"stripSuffix" Text -> (Text -> Text -> Text) -> (Text, Term)
forall a. Quote a => Text -> a -> (Text, Term)
@: (\Text
x Text
s -> Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
Maybe.fromMaybe Text
x (Text
s Text -> Text -> Maybe Text
`Text.stripSuffix` Text
x)),
      Text
"stripStart" Text -> (Text -> Text) -> (Text, Term)
forall a. Quote a => Text -> a -> (Text, Term)
@: Text -> Text
Text.stripStart,
      Text
"stripEnd" Text -> (Text -> Text) -> (Text, Term)
forall a. Quote a => Text -> a -> (Text, Term)
@: Text -> Text
Text.stripEnd,
      Text
"replace" Text -> (Text -> Text -> Text -> Text) -> (Text, Term)
forall a. Quote a => Text -> a -> (Text, Term)
@: (Text -> Text -> Text -> Text) -> Text -> Text -> Text -> Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
Text.replace,
      Text
"remove" Text -> (Text -> Text -> Text) -> (Text, Term)
forall a. Quote a => Text -> a -> (Text, Term)
@: (\Text
x Text
r -> HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
Text.replace Text
r Text
"" Text
x),
      Text
"toEllipsis" Text -> (Text -> Int -> Text) -> (Text, Term)
forall a. Quote a => Text -> a -> (Text, Term)
@: (Int -> Text -> Text) -> Text -> Int -> Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Text -> Text
Text.Manipulate.toEllipsis,
      Text
"toEllipsisWith" Text -> (Text -> Int -> Text -> Text) -> (Text, Term)
forall a. Quote a => Text -> a -> (Text, Term)
@: (\Text
x Int
n Text
e -> Int -> Text -> Text -> Text
Text.Manipulate.toEllipsisWith Int
n Text
e Text
x),
      Text
"indentLines" Text -> (Text -> Int -> Text) -> (Text, Term)
forall a. Quote a => Text -> a -> (Text, Term)
@: (Int -> Text -> Text) -> Text -> Int -> Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Text -> Text
Text.Manipulate.indentLines,
      Text
"prependLines" Text -> (Text -> Text -> Text) -> (Text, Term)
forall a. Quote a => Text -> a -> (Text, Term)
@: (Text -> Text -> Text) -> Text -> Text -> Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Text -> Text
Text.Manipulate.prependLines,
      Text
"justifyLeft" Text -> (Text -> Int -> Text) -> (Text, Term)
forall a. Quote a => Text -> a -> (Text, Term)
@: (\Text
x Int
n -> Int -> Char -> Text -> Text
Text.justifyLeft Int
n Char
' ' Text
x),
      Text
"justifyRight" Text -> (Text -> Int -> Text) -> (Text, Term)
forall a. Quote a => Text -> a -> (Text, Term)
@: (\Text
x Int
n -> Int -> Char -> Text -> Text
Text.justifyRight Int
n Char
' ' Text
x),
      Text
"center" Text -> (Text -> Int -> Text) -> (Text, Term)
forall a. Quote a => Text -> a -> (Text, Term)
@: (\Text
x Int
n -> Int -> Char -> Text -> Text
Text.center Int
n Char
' ' Text
x),
      -- sequences
      Text
-> (Text -> Int)
-> (HashMap Text Value -> Int)
-> (Vector Value -> Int)
-> (Text, Term)
forall a b c.
(Quote a, Quote b, Quote c) =>
Text
-> (Text -> a)
-> (HashMap Text Value -> b)
-> (Vector Value -> c)
-> (Text, Term)
qcol1 Text
"length" Text -> Int
Text.length HashMap Text Value -> Int
forall k v. HashMap k v -> Int
HashMap.size Vector Value -> Int
forall a. Vector a -> Int
Vector.length,
      Text
-> (Text -> Bool)
-> (HashMap Text Value -> Bool)
-> (Vector Value -> Bool)
-> (Text, Term)
forall a b c.
(Quote a, Quote b, Quote c) =>
Text
-> (Text -> a)
-> (HashMap Text Value -> b)
-> (Vector Value -> c)
-> (Text, Term)
qcol1 Text
"empty" Text -> Bool
Text.null HashMap Text Value -> Bool
forall k v. HashMap k v -> Bool
HashMap.null Vector Value -> Bool
forall a. Vector a -> Bool
Vector.null,
      Text
-> (Text -> Text)
-> (HashMap Text Value -> HashMap Text Value)
-> (Vector Value -> Vector Value)
-> (Text, Term)
forall a b c.
(Quote a, Quote b, Quote c) =>
Text
-> (Text -> a)
-> (HashMap Text Value -> b)
-> (Vector Value -> c)
-> (Text, Term)
qcol1 Text
"reverse" Text -> Text
Text.reverse HashMap Text Value -> HashMap Text Value
forall a. a -> a
id Vector Value -> Vector Value
forall a. Vector a -> Vector a
Vector.reverse,
      -- lists
      Text -> (Text -> Value) -> (Vector Value -> Value) -> (Text, Term)
forall a b.
(Quote a, Quote b) =>
Text -> (Text -> a) -> (Vector Value -> b) -> (Text, Term)
qlist1 Text
"head" Text -> Value
headT Vector Value -> Value
headV,
      Text -> (Text -> Value) -> (Vector Value -> Value) -> (Text, Term)
forall a b.
(Quote a, Quote b) =>
Text -> (Text -> a) -> (Vector Value -> b) -> (Text, Term)
qlist1 Text
"last" Text -> Value
lastT Vector Value -> Value
lastV,
      Text -> (Text -> Value) -> (Vector Value -> Value) -> (Text, Term)
forall a b.
(Quote a, Quote b) =>
Text -> (Text -> a) -> (Vector Value -> b) -> (Text, Term)
qlist1 Text
"tail" Text -> Value
tailT Vector Value -> Value
tailV,
      Text -> (Text -> Value) -> (Vector Value -> Value) -> (Text, Term)
forall a b.
(Quote a, Quote b) =>
Text -> (Text -> a) -> (Vector Value -> b) -> (Text, Term)
qlist1 Text
"init" Text -> Value
initT Vector Value -> Value
initV,
      Text
"at" Text -> (Vector Value -> Int -> Value) -> (Text, Term)
forall a. Quote a => Text -> a -> (Text, Term)
@: (\Vector Value
x Int
i -> Vector Value
x Vector Value -> Int -> Value
forall a. Vector a -> Int -> a
Vector.! Int
i :: Value),
      -- object
      Text
"keys" Text -> (HashMap Text Value -> [Text]) -> (Text, Term)
forall a. Quote a => Text -> a -> (Text, Term)
@: (HashMap Text Value -> [Text]
forall k v. HashMap k v -> [k]
HashMap.keys :: HashMap Text Value -> [Text]),
      Text
"elems" Text -> (HashMap Text Value -> [Value]) -> (Text, Term)
forall a. Quote a => Text -> a -> (Text, Term)
@: (HashMap Text Value -> [Value]
forall k v. HashMap k v -> [v]
HashMap.elems :: HashMap Text Value -> [Value]),
      -- , "map"        @: undefined
      -- , "filter"     @: undefined
      -- , "zip"        @: undefined
      -- , "join"       @: undefined

      -- polymorphic
      Text
"show" Text -> (Value -> Text) -> (Text, Term)
forall a. Quote a => Text -> a -> (Text, Term)
@: (ByteString -> Text
Text.Lazy.Encoding.decodeUtf8 (ByteString -> Text) -> (Value -> ByteString) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode :: Value -> Text.Lazy.Text),
      Text
"singleton" Text -> (Value -> Vector Value) -> (Text, Term)
forall a. Quote a => Text -> a -> (Text, Term)
@: (Value -> Vector Value
forall a. a -> Vector a
forall (f :: * -> *) a. Applicative f => a -> f a
pure :: Value -> Vector Value)
      -- FIXME: existence checks currently hardcoded into the evaluator:
      -- "default"
      -- "defined"
    ]

(@:) :: Quote a => Id -> a -> (Id, Term)
Text
k @: :: forall a. Quote a => Text -> a -> (Text, Term)
@: a
q = (Text
k, Text -> Int -> a -> Term
forall a. Quote a => Text -> Int -> a -> Term
quote Text
k Int
0 a
q)

-- | Quote a binary function which takes the most general binding value.
qpoly2 :: Quote a => Id -> (Value -> Value -> a) -> (Id, Term)
qpoly2 :: forall a. Quote a => Text -> (Value -> Value -> a) -> (Text, Term)
qpoly2 Text
k = (Text
k,) (Term -> (Text, Term))
-> ((Value -> Value -> a) -> Term)
-> (Value -> Value -> a)
-> (Text, Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int -> (Value -> Value -> a) -> Term
forall a. Quote a => Text -> Int -> a -> Term
quote Text
k Int
0

-- | Quote an unary numeric function.
qnum1 :: Id -> (Scientific -> Scientific) -> (Id, Term)
qnum1 :: Text -> (Scientific -> Scientific) -> (Text, Term)
qnum1 Text
k = (Text
k,) (Term -> (Text, Term))
-> ((Scientific -> Scientific) -> Term)
-> (Scientific -> Scientific)
-> (Text, Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int -> (Scientific -> Scientific) -> Term
forall a. Quote a => Text -> Int -> a -> Term
quote Text
k Int
0

-- | Quote a binary numeric function.
qnum2 :: Quote a => Id -> (Scientific -> Scientific -> a) -> (Id, Term)
qnum2 :: forall a.
Quote a =>
Text -> (Scientific -> Scientific -> a) -> (Text, Term)
qnum2 Text
k = (Text
k,) (Term -> (Text, Term))
-> ((Scientific -> Scientific -> a) -> Term)
-> (Scientific -> Scientific -> a)
-> (Text, Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int -> (Scientific -> Scientific -> a) -> Term
forall a. Quote a => Text -> Int -> a -> Term
quote Text
k Int
0

-- | Quote a comprehensive set of unary functions to create a binding
-- that supports list collection types.
qlist1 ::
  (Quote a, Quote b) =>
  Id ->
  (Text -> a) ->
  (Vector Value -> b) ->
  (Id, Term)
qlist1 :: forall a b.
(Quote a, Quote b) =>
Text -> (Text -> a) -> (Vector Value -> b) -> (Text, Term)
qlist1 Text
k Text -> a
f Vector Value -> b
g = (Text
k,) (Term -> (Text, Term))
-> ((Term -> Result Term) -> Term)
-> (Term -> Result Term)
-> (Text, Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Term -> Result Term) -> Term
TLam ((Term -> Result Term) -> (Text, Term))
-> (Term -> Result Term) -> (Text, Term)
forall a b. (a -> b) -> a -> b
$ \case
  TVal (String Text
t) -> Term -> Result Term
forall a. a -> Result a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> Result Term) -> (a -> Term) -> a -> Result Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int -> a -> Term
forall a. Quote a => Text -> Int -> a -> Term
quote Text
k Int
0 (a -> Result Term) -> a -> Result Term
forall a b. (a -> b) -> a -> b
$ Text -> a
f Text
t
  TVal (Array Vector Value
v) -> Term -> Result Term
forall a. a -> Result a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> Result Term) -> (b -> Term) -> b -> Result Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int -> b -> Term
forall a. Quote a => Text -> Int -> a -> Term
quote Text
k Int
0 (b -> Result Term) -> b -> Result Term
forall a b. (a -> b) -> a -> b
$ Vector Value -> b
g Vector Value
v
  Term
x ->
    Doc AnsiStyle -> Result Term
forall a. Doc AnsiStyle -> Result a
Failure (Doc AnsiStyle -> Result Term) -> Doc AnsiStyle -> Result Term
forall a b. (a -> b) -> a -> b
$
      Doc AnsiStyle
"when expecting a String or Array, encountered" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Term -> Doc AnsiStyle
forall a. AnsiPretty a => a -> Doc AnsiStyle
apretty Term
x

-- | Quote a comprehensive set of unary functions to create a binding
-- that supports all collection types.
qcol1 ::
  (Quote a, Quote b, Quote c) =>
  Id ->
  (Text -> a) ->
  (HashMap Text Value -> b) ->
  (Vector Value -> c) ->
  (Id, Term)
qcol1 :: forall a b c.
(Quote a, Quote b, Quote c) =>
Text
-> (Text -> a)
-> (HashMap Text Value -> b)
-> (Vector Value -> c)
-> (Text, Term)
qcol1 Text
k Text -> a
f HashMap Text Value -> b
g Vector Value -> c
h = (Text
k,) (Term -> (Text, Term))
-> ((Term -> Result Term) -> Term)
-> (Term -> Result Term)
-> (Text, Term)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Term -> Result Term) -> Term
TLam ((Term -> Result Term) -> (Text, Term))
-> (Term -> Result Term) -> (Text, Term)
forall a b. (a -> b) -> a -> b
$ \case
  TVal (String Text
t) -> Term -> Result Term
forall a. a -> Result a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> Result Term) -> (a -> Term) -> a -> Result Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int -> a -> Term
forall a. Quote a => Text -> Int -> a -> Term
quote Text
k Int
0 (a -> Result Term) -> a -> Result Term
forall a b. (a -> b) -> a -> b
$ Text -> a
f Text
t
  TVal (Object Object
o) -> Term -> Result Term
forall a. a -> Result a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> Result Term) -> (b -> Term) -> b -> Result Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int -> b -> Term
forall a. Quote a => Text -> Int -> a -> Term
quote Text
k Int
0 (b -> Result Term) -> b -> Result Term
forall a b. (a -> b) -> a -> b
$ HashMap Text Value -> b
g (Object -> HashMap Text Value
forall v. KeyMap v -> HashMap Text v
toHashMapText Object
o)
  TVal (Array Vector Value
v) -> Term -> Result Term
forall a. a -> Result a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> Result Term) -> (c -> Term) -> c -> Result Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int -> c -> Term
forall a. Quote a => Text -> Int -> a -> Term
quote Text
k Int
0 (c -> Result Term) -> c -> Result Term
forall a b. (a -> b) -> a -> b
$ Vector Value -> c
h Vector Value
v
  Term
x ->
    Doc AnsiStyle -> Result Term
forall a. Doc AnsiStyle -> Result a
Failure (Doc AnsiStyle -> Result Term) -> Doc AnsiStyle -> Result Term
forall a b. (a -> b) -> a -> b
$
      Doc AnsiStyle
"when expecting a String, Object, or Array, encountered" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Term -> Doc AnsiStyle
forall a. AnsiPretty a => a -> Doc AnsiStyle
apretty Term
x

headT, lastT, tailT, initT :: Text -> Value
headT :: Text -> Value
headT = (Text -> Text) -> Text -> Value
text (Char -> Text
Text.singleton (Char -> Text) -> (Text -> Char) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Char
Text.Unsafe.unsafeHead)
lastT :: Text -> Value
lastT = (Text -> Text) -> Text -> Value
text (Char -> Text
Text.singleton (Char -> Text) -> (Text -> Char) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Char
Text -> Char
Text.last)
tailT :: Text -> Value
tailT = (Text -> Text) -> Text -> Value
text Text -> Text
Text.Unsafe.unsafeTail
initT :: Text -> Value
initT = (Text -> Text) -> Text -> Value
text HasCallStack => Text -> Text
Text -> Text
Text.init

headV, lastV, tailV, initV :: Vector Value -> Value
headV :: Vector Value -> Value
headV = (Vector Value -> Value) -> Vector Value -> Value
vec Vector Value -> Value
forall a. Vector a -> a
Vector.unsafeHead
lastV :: Vector Value -> Value
lastV = (Vector Value -> Value) -> Vector Value -> Value
vec Vector Value -> Value
forall a. Vector a -> a
Vector.unsafeLast
tailV :: Vector Value -> Value
tailV = (Vector Value -> Value) -> Vector Value -> Value
vec (Vector Value -> Value
Array (Vector Value -> Value)
-> (Vector Value -> Vector Value) -> Vector Value -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Value -> Vector Value
forall a. Vector a -> Vector a
Vector.unsafeTail)
initV :: Vector Value -> Value
initV = (Vector Value -> Value) -> Vector Value -> Value
vec (Vector Value -> Value
Array (Vector Value -> Value)
-> (Vector Value -> Vector Value) -> Vector Value -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Value -> Vector Value
forall a. Vector a -> Vector a
Vector.unsafeInit)

text :: (Text -> Text) -> Text -> Value
text :: (Text -> Text) -> Text -> Value
text Text -> Text
f = Text -> Value
String (Text -> Value) -> (Text -> Text) -> Text -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> (Text -> Bool) -> (Text -> Text) -> Text -> Text
forall b a. b -> (a -> Bool) -> (a -> b) -> a -> b
safe Text
forall a. Monoid a => a
mempty Text -> Bool
Text.null Text -> Text
f

vec :: (Vector Value -> Value) -> Vector Value -> Value
vec :: (Vector Value -> Value) -> Vector Value -> Value
vec = Value
-> (Vector Value -> Bool)
-> (Vector Value -> Value)
-> Vector Value
-> Value
forall b a. b -> (a -> Bool) -> (a -> b) -> a -> b
safe (Vector Value -> Value
Array Vector Value
forall a. Vector a
Vector.empty) Vector Value -> Bool
forall a. Vector a -> Bool
Vector.null

safe :: b -> (a -> Bool) -> (a -> b) -> a -> b
safe :: forall b a. b -> (a -> Bool) -> (a -> b) -> a -> b
safe b
v a -> Bool
f a -> b
g a
x
  | a -> Bool
f a
x = b
v
  | Bool
otherwise = a -> b
g a
x