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

-- |
-- Module      : Text.EDE.Internal.Filters
-- Copyright   : (c) 2013-2020 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 (Array, Object, 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 Data.Text.Prettyprint.Doc ((<+>))
import qualified Data.Text.Unsafe as Text.Unsafe
import qualified Data.Vector as Vector
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 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 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 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 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 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 -> 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)
-> (Object -> Int)
-> (Array -> Int)
-> (Text, Term)
forall a b c.
(Quote a, Quote b, Quote c) =>
Text
-> (Text -> a) -> (Object -> b) -> (Array -> c) -> (Text, Term)
qcol1 Text
"length" Text -> Int
Text.length Object -> Int
forall k v. HashMap k v -> Int
HashMap.size Array -> Int
forall a. Vector a -> Int
Vector.length,
      Text
-> (Text -> Bool)
-> (Object -> Bool)
-> (Array -> Bool)
-> (Text, Term)
forall a b c.
(Quote a, Quote b, Quote c) =>
Text
-> (Text -> a) -> (Object -> b) -> (Array -> c) -> (Text, Term)
qcol1 Text
"empty" Text -> Bool
Text.null Object -> Bool
forall k v. HashMap k v -> Bool
HashMap.null Array -> Bool
forall a. Vector a -> Bool
Vector.null,
      Text
-> (Text -> Text)
-> (Object -> Object)
-> (Array -> Array)
-> (Text, Term)
forall a b c.
(Quote a, Quote b, Quote c) =>
Text
-> (Text -> a) -> (Object -> b) -> (Array -> c) -> (Text, Term)
qcol1 Text
"reverse" Text -> Text
Text.reverse Object -> Object
forall a. a -> a
id Array -> Array
forall a. Vector a -> Vector a
Vector.reverse,
      -- lists
      Text -> (Text -> Value) -> (Array -> Value) -> (Text, Term)
forall a b.
(Quote a, Quote b) =>
Text -> (Text -> a) -> (Array -> b) -> (Text, Term)
qlist1 Text
"head" Text -> Value
headT Array -> Value
headV,
      Text -> (Text -> Value) -> (Array -> Value) -> (Text, Term)
forall a b.
(Quote a, Quote b) =>
Text -> (Text -> a) -> (Array -> b) -> (Text, Term)
qlist1 Text
"last" Text -> Value
lastT Array -> Value
lastV,
      Text -> (Text -> Value) -> (Array -> Value) -> (Text, Term)
forall a b.
(Quote a, Quote b) =>
Text -> (Text -> a) -> (Array -> b) -> (Text, Term)
qlist1 Text
"tail" Text -> Value
tailT Array -> Value
tailV,
      Text -> (Text -> Value) -> (Array -> Value) -> (Text, Term)
forall a b.
(Quote a, Quote b) =>
Text -> (Text -> a) -> (Array -> b) -> (Text, Term)
qlist1 Text
"init" Text -> Value
initT Array -> Value
initV,
      Text
"at" Text -> (Array -> Int -> Value) -> (Text, Term)
forall a. Quote a => Text -> a -> (Text, Term)
@: (\Array
x Int
i -> Array
x Array -> Int -> Value
forall a. Vector a -> Int -> a
Vector.! Int
i :: Value),
      -- object
      Text
"keys" Text -> (Object -> [Text]) -> (Text, Term)
forall a. Quote a => Text -> a -> (Text, Term)
@: (Object -> [Text]
forall k v. HashMap k v -> [k]
HashMap.keys :: Object -> [Text]),
      Text
"elems" Text -> (Object -> [Value]) -> (Text, Term)
forall a. Quote a => Text -> a -> (Text, Term)
@: (Object -> [Value]
forall k v. HashMap k v -> [v]
HashMap.elems :: Object -> [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 -> Array) -> (Text, Term)
forall a. Quote a => Text -> a -> (Text, Term)
@: (Value -> Array
forall (f :: * -> *) a. Applicative f => a -> f a
pure :: Value -> Vector.Vector Value)
      -- FIXME: existence checks currently hardcoded into the evaluator:
      -- "default"
      -- "defined"
    ]

(@:) :: Quote a => Id -> a -> (Id, Term)
Text
k @: :: 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 :: 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 :: 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) ->
  (Array -> b) ->
  (Id, Term)
qlist1 :: Text -> (Text -> a) -> (Array -> b) -> (Text, Term)
qlist1 Text
k Text -> a
f Array -> 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 (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 Array
v) -> Term -> Result Term
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
$ Array -> b
g Array
v
  Term
x ->
    AnsiDoc -> Result Term
forall a. AnsiDoc -> Result a
Failure (AnsiDoc -> Result Term) -> AnsiDoc -> Result Term
forall a b. (a -> b) -> a -> b
$
      AnsiDoc
"when expecting a String or Array, encountered" AnsiDoc -> AnsiDoc -> AnsiDoc
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Term -> AnsiDoc
forall a. AnsiPretty a => a -> AnsiDoc
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) ->
  (Object -> b) ->
  (Array -> c) ->
  (Id, Term)
qcol1 :: Text
-> (Text -> a) -> (Object -> b) -> (Array -> c) -> (Text, Term)
qcol1 Text
k Text -> a
f Object -> b
g Array -> 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 (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 (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
$ Object -> b
g Object
o
  TVal (Array Array
v) -> Term -> Result Term
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
$ Array -> c
h Array
v
  Term
x ->
    AnsiDoc -> Result Term
forall a. AnsiDoc -> Result a
Failure (AnsiDoc -> Result Term) -> AnsiDoc -> Result Term
forall a b. (a -> b) -> a -> b
$
      AnsiDoc
"when expecting a String, Object, or Array, encountered" AnsiDoc -> AnsiDoc -> AnsiDoc
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Term -> AnsiDoc
forall a. AnsiPretty a => a -> AnsiDoc
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
. 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 Text -> Text
Text.init

headV, lastV, tailV, initV :: Array -> Value
headV :: Array -> Value
headV = (Array -> Value) -> Array -> Value
vec Array -> Value
forall a. Vector a -> a
Vector.unsafeHead
lastV :: Array -> Value
lastV = (Array -> Value) -> Array -> Value
vec Array -> Value
forall a. Vector a -> a
Vector.unsafeLast
tailV :: Array -> Value
tailV = (Array -> Value) -> Array -> Value
vec (Array -> Value
Array (Array -> Value) -> (Array -> Array) -> Array -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array -> Array
forall a. Vector a -> Vector a
Vector.unsafeTail)
initV :: Array -> Value
initV = (Array -> Value) -> Array -> Value
vec (Array -> Value
Array (Array -> Value) -> (Array -> Array) -> Array -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array -> Array
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 :: (Array -> Value) -> Array -> Value
vec :: (Array -> Value) -> Array -> Value
vec = Value -> (Array -> Bool) -> (Array -> Value) -> Array -> Value
forall b a. b -> (a -> Bool) -> (a -> b) -> a -> b
safe (Array -> Value
Array Array
forall a. Vector a
Vector.empty) Array -> Bool
forall a. Vector a -> Bool
Vector.null

safe :: b -> (a -> Bool) -> (a -> b) -> a -> b
safe :: 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