{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

module Typst.Methods
  ( getMethod,
    formatNumber,
    applyPureFunction
  )
where

import Control.Monad (MonadPlus (mplus), foldM, void)
import Control.Monad.Reader (MonadReader (ask), MonadTrans (lift))
import qualified Data.Array as Array
import qualified Data.Foldable as F
import Data.List (intersperse, sort, sortOn)
import qualified Data.Map as M
import qualified Data.Map.Ordered as OM
import Data.Maybe (fromMaybe, listToMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Vector as V
import Text.Parsec
import Text.Parsec.String (Parser)
import Typst.Module.Standard (applyPureFunction)
import Typst.Regex
  ( RE (..),
    RegexMatch (..),
    extract,
    makeRE,
    match,
    matchAll,
    replaceRegex,
    splitRegex,
  )
import Typst.Types
import Typst.Util (allArgs, makeFunction, namedArg, nthArg)
import Data.Time (toGregorian, dayOfWeek, formatTime, defaultTimeLocale, UTCTime(..))

-- import Debug.Trace

getMethod ::
  MonadFail m =>
  (forall n. Monad n => Val -> MP n ()) ->
  Val ->
  Text ->
  m Val
getMethod :: forall (m :: * -> *).
MonadFail m =>
(forall (n :: * -> *). Monad n => Val -> MP n ())
-> Val -> Text -> m Val
getMethod forall (n :: * -> *). Monad n => Val -> MP n ()
updateVal Val
val Text
fld = do
  let methodUnimplemented :: a -> m a
methodUnimplemented a
name =
        String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$
          String
"Method "
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
name
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" is not yet implemented"
  let noMethod :: String -> a -> m a
noMethod String
typename a
name =
        String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$
          String
typename
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" does not have a method "
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
name
  case Val
val of
    VDict OMap Identifier Val
m ->
      case Text
fld of
        Text
"len" ->
          Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Integer -> Val
VInteger (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ OMap Identifier Val -> Int
forall k v. OMap k v -> Int
OM.size OMap Identifier Val
m)
        Text
"at" ->
          Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
            Text
key <- Int -> ReaderT Arguments (MP m') Text
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
            Val
defval <- Identifier -> Val -> ReaderT Arguments (MP m') Val
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Identifier -> a -> ReaderT Arguments (MP m) a
namedArg Identifier
"default" Val
VNone
            case Identifier -> OMap Identifier Val -> Maybe Val
forall k v. Ord k => k -> OMap k v -> Maybe v
OM.lookup (Text -> Identifier
Identifier Text
key) OMap Identifier Val
m of
              Maybe Val
Nothing -> Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
defval
              Just Val
v -> Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
v
        Text
"insert" -> do
          Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
            Text
key <- Int -> ReaderT Arguments (MP m') Text
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
            Val
v <- Int -> ReaderT Arguments (MP m') Val
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
2
            MP m' () -> ReaderT Arguments (MP m') ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT Arguments m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (MP m' () -> ReaderT Arguments (MP m') ())
-> MP m' () -> ReaderT Arguments (MP m') ()
forall a b. (a -> b) -> a -> b
$ Val -> MP m' ()
forall (n :: * -> *). Monad n => Val -> MP n ()
updateVal (Val -> MP m' ()) -> Val -> MP m' ()
forall a b. (a -> b) -> a -> b
$ OMap Identifier Val -> Val
VDict (OMap Identifier Val -> Val) -> OMap Identifier Val -> Val
forall a b. (a -> b) -> a -> b
$ OMap Identifier Val
m OMap Identifier Val -> (Identifier, Val) -> OMap Identifier Val
forall k v. Ord k => OMap k v -> (k, v) -> OMap k v
OM.|> (Text -> Identifier
Identifier Text
key, Val
v)
            Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
VNone
        Text
"keys" ->
          Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$
            (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$
              Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$
                Vector Val -> Val
VArray (Vector Val -> Val) -> Vector Val -> Val
forall a b. (a -> b) -> a -> b
$
                  [Val] -> Vector Val
forall a. [a] -> Vector a
V.fromList ([Val] -> Vector Val) -> [Val] -> Vector Val
forall a b. (a -> b) -> a -> b
$
                    ((Identifier, Val) -> Val) -> [(Identifier, Val)] -> [Val]
forall a b. (a -> b) -> [a] -> [b]
map (\(Identifier Text
t, Val
_) -> Text -> Val
VString Text
t) ([(Identifier, Val)] -> [Val]) -> [(Identifier, Val)] -> [Val]
forall a b. (a -> b) -> a -> b
$
                      OMap Identifier Val -> [(Identifier, Val)]
forall k v. OMap k v -> [(k, v)]
OM.assocs OMap Identifier Val
m
        Text
"values" ->
          Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Vector Val -> Val
VArray (Vector Val -> Val) -> Vector Val -> Val
forall a b. (a -> b) -> a -> b
$ [Val] -> Vector Val
forall a. [a] -> Vector a
V.fromList ([Val] -> Vector Val) -> [Val] -> Vector Val
forall a b. (a -> b) -> a -> b
$ ((Identifier, Val) -> Val) -> [(Identifier, Val)] -> [Val]
forall a b. (a -> b) -> [a] -> [b]
map (Identifier, Val) -> Val
forall a b. (a, b) -> b
snd ([(Identifier, Val)] -> [Val]) -> [(Identifier, Val)] -> [Val]
forall a b. (a -> b) -> a -> b
$ OMap Identifier Val -> [(Identifier, Val)]
forall k v. OMap k v -> [(k, v)]
OM.assocs OMap Identifier Val
m
        Text
"pairs" ->
          Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
            Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$
              Vector Val -> Val
VArray (Vector Val -> Val) -> Vector Val -> Val
forall a b. (a -> b) -> a -> b
$
                [Val] -> Vector Val
forall a. [a] -> Vector a
V.fromList ([Val] -> Vector Val) -> [Val] -> Vector Val
forall a b. (a -> b) -> a -> b
$
                  ((Identifier, Val) -> Val) -> [(Identifier, Val)] -> [Val]
forall a b. (a -> b) -> [a] -> [b]
map
                    ( \(Identifier Text
k, Val
v) ->
                        Vector Val -> Val
VArray ([Val] -> Vector Val
forall a. [a] -> Vector a
V.fromList [Text -> Val
VString Text
k, Item [Val]
Val
v])
                    )
                    (OMap Identifier Val -> [(Identifier, Val)]
forall k v. OMap k v -> [(k, v)]
OM.assocs OMap Identifier Val
m)
        Text
"remove" ->
          Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
            Text
key <- Int -> ReaderT Arguments (MP m') Text
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
            case Identifier -> OMap Identifier Val -> Maybe Val
forall k v. Ord k => k -> OMap k v -> Maybe v
OM.lookup (Text -> Identifier
Identifier Text
key) OMap Identifier Val
m of
              Maybe Val
Nothing -> Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
VNone
              Just Val
oldval -> do
                MP m' () -> ReaderT Arguments (MP m') ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT Arguments m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (MP m' () -> ReaderT Arguments (MP m') ())
-> MP m' () -> ReaderT Arguments (MP m') ()
forall a b. (a -> b) -> a -> b
$ Val -> MP m' ()
forall (n :: * -> *). Monad n => Val -> MP n ()
updateVal (Val -> MP m' ()) -> Val -> MP m' ()
forall a b. (a -> b) -> a -> b
$ OMap Identifier Val -> Val
VDict (OMap Identifier Val -> Val) -> OMap Identifier Val -> Val
forall a b. (a -> b) -> a -> b
$ Identifier -> OMap Identifier Val -> OMap Identifier Val
forall k v. Ord k => k -> OMap k v -> OMap k v
OM.delete (Text -> Identifier
Identifier Text
key) OMap Identifier Val
m
                Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
oldval
        Text
_ -> case Identifier -> OMap Identifier Val -> Maybe Val
forall k v. Ord k => k -> OMap k v -> Maybe v
OM.lookup (Text -> Identifier
Identifier Text
fld) OMap Identifier Val
m of
          Just Val
x -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
x
          Maybe Val
Nothing -> String -> m Val
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m Val) -> String -> m Val
forall a b. (a -> b) -> a -> b
$ Identifier -> String
forall a. Show a => a -> String
show (Text -> Identifier
Identifier Text
fld) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" not found"
    VColor Color
col ->
      case Text
fld of
        Text
"darken" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
          (Rational
n :: Rational) <- Int -> ReaderT Arguments (MP m') Rational
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
          Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Color -> Val
VColor (Color -> Val) -> Color -> Val
forall a b. (a -> b) -> a -> b
$ case Color
col of
            RGB Rational
r Rational
g Rational
b Rational
o -> Rational -> Rational -> Rational -> Rational -> Color
RGB (Rational
r Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* (Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
n)) (Rational
g Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* (Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
n)) (Rational
b Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* (Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
n)) Rational
o
            CMYK Rational
c Rational
m Rational
y Rational
k -> Rational -> Rational -> Rational -> Rational -> Color
CMYK (Rational
c Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* (Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
n)) (Rational
m Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* (Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
n)) (Rational
y Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* (Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
n)) (Rational
k Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* (Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
n))
            Luma Rational
x -> Rational -> Color
Luma (Rational
x Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* (Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
n))
        Text
"lighten" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
          (Rational
n :: Rational) <- Int -> ReaderT Arguments (MP m') Rational
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
          Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Color -> Val
VColor (Color -> Val) -> Color -> Val
forall a b. (a -> b) -> a -> b
$ case Color
col of
            RGB Rational
r Rational
g Rational
b Rational
o ->
              Rational -> Rational -> Rational -> Rational -> Color
RGB
                (Rational
r Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ ((Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
r) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
n))
                (Rational
g Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ ((Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
g) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
n))
                (Rational
b Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ ((Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
b) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
n))
                Rational
o
            CMYK Rational
c Rational
m Rational
y Rational
k ->
              Rational -> Rational -> Rational -> Rational -> Color
CMYK
                (Rational
c Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ ((Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
c) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
n))
                (Rational
m Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ ((Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
m) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
n))
                (Rational
y Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ ((Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
y) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
n))
                (Rational
k Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ ((Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
k) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
n))
            Luma Rational
x -> Rational -> Color
Luma (Rational
x Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ ((Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
x) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
n))
        Text
"negate" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
          Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Color -> Val
VColor (Color -> Val) -> Color -> Val
forall a b. (a -> b) -> a -> b
$ case Color
col of
            RGB Rational
r Rational
g Rational
b Rational
o -> Rational -> Rational -> Rational -> Rational -> Color
RGB (Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
r) (Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
g) (Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
b) Rational
o
            CMYK Rational
c Rational
m Rational
y Rational
k -> Rational -> Rational -> Rational -> Rational -> Color
CMYK (Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
c) (Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
m) (Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
y) Rational
k
            Luma Rational
x -> Rational -> Color
Luma (Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
x)
        Text
_ -> String -> Text -> m Val
forall {m :: * -> *} {a} {a}.
(MonadFail m, Show a) =>
String -> a -> m a
noMethod String
"Color" Text
fld
    VString Text
t -> do
      let toPos :: Int -> Int
toPos Int
n =
            if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
              then Text -> Int
T.length Text
t Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n
              else Int
n
      case Text
fld of
        Text
"len" ->
          Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Integer -> Val
VInteger (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length Text
t)
        Text
"rev" ->
          Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Text -> Val
VString (Text -> Text
T.reverse Text
t)
        Text
"first" ->
          if Text -> Bool
T.null Text
t
            then String -> m Val
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"string is empty"
            else Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Text -> Val
VString (Text -> Val) -> Text -> Val
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.take Int
1 Text
t
        Text
"last" ->
          if Text -> Bool
T.null Text
t
            then String -> m Val
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"string is empty"
            else Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Text -> Val
VString (Text -> Val) -> Text -> Val
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.takeEnd Int
1 Text
t
        Text
"at" ->
          Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
            Int
n <- Int -> Int
toPos (Int -> Int)
-> ReaderT Arguments (MP m') Int -> ReaderT Arguments (MP m') Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ReaderT Arguments (MP m') Int
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
            Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Text -> Val
VString (Text -> Val) -> Text -> Val
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.take Int
1 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop Int
n Text
t
        Text
"slice" ->
          Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
            Int
start <- Int -> Int
toPos (Int -> Int)
-> ReaderT Arguments (MP m') Int -> ReaderT Arguments (MP m') Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ReaderT Arguments (MP m') Int
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
            Maybe Int
mbcount <- Identifier -> Maybe Int -> ReaderT Arguments (MP m') (Maybe Int)
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Identifier -> a -> ReaderT Arguments (MP m) a
namedArg Identifier
"count" Maybe Int
forall a. Maybe a
Nothing
            Int
end <- (Int -> Int
toPos (Int -> Int)
-> ReaderT Arguments (MP m') Int -> ReaderT Arguments (MP m') Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ReaderT Arguments (MP m') Int
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
2) ReaderT Arguments (MP m') Int
-> ReaderT Arguments (MP m') Int -> ReaderT Arguments (MP m') Int
forall a.
ReaderT Arguments (MP m') a
-> ReaderT Arguments (MP m') a -> ReaderT Arguments (MP m') a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
                      Int -> ReaderT Arguments (MP m') Int
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Int
T.length Text
t) (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
start) Maybe Int
mbcount)
            if Int
end Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
start
              then Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Text -> Val
VString Text
""
              else Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Text -> Val
VString (Text -> Val) -> Text -> Val
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.take (Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start) (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop Int
start Text
t
        Text
"clusters" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
          -- TODO this isn't right, but we'd need fancier libraries
          -- to get at grapheme clusters
          Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Vector Val -> Val
VArray (Vector Val -> Val) -> Vector Val -> Val
forall a b. (a -> b) -> a -> b
$ [Val] -> Vector Val
forall a. [a] -> Vector a
V.fromList ([Val] -> Vector Val) -> [Val] -> Vector Val
forall a b. (a -> b) -> a -> b
$ (Text -> Val) -> [Text] -> [Val]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Val
VString ([Text] -> [Val]) -> [Text] -> [Val]
forall a b. (a -> b) -> a -> b
$ Int -> Text -> [Text]
T.chunksOf Int
1 Text
t
        Text
"codepoints" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
          Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Vector Val -> Val
VArray (Vector Val -> Val) -> Vector Val -> Val
forall a b. (a -> b) -> a -> b
$ [Val] -> Vector Val
forall a. [a] -> Vector a
V.fromList ([Val] -> Vector Val) -> [Val] -> Vector Val
forall a b. (a -> b) -> a -> b
$ (Text -> Val) -> [Text] -> [Val]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Val
VString ([Text] -> [Val]) -> [Text] -> [Val]
forall a b. (a -> b) -> a -> b
$ Int -> Text -> [Text]
T.chunksOf Int
1 Text
t
        Text
"contains" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
          (RE
patt :: RE) <- Int -> ReaderT Arguments (MP m') RE
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
          Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean (Bool -> Val) -> Bool -> Val
forall a b. (a -> b) -> a -> b
$ RE -> Text -> Bool
forall source target.
RegexContext Regex source target =>
RE -> source -> target
match RE
patt Text
t
        Text
"starts-with" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
          (RE Text
reStr Regex
_) <- Int -> ReaderT Arguments (MP m') RE
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
          RE
patt <- Text -> ReaderT Arguments (MP m') RE
forall (m :: * -> *). MonadFail m => Text -> m RE
makeRE (Text
"^" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
reStr)
          Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean (Bool -> Val) -> Bool -> Val
forall a b. (a -> b) -> a -> b
$ RE -> Text -> Bool
forall source target.
RegexContext Regex source target =>
RE -> source -> target
match RE
patt Text
t
        Text
"ends-with" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
          (RE Text
reStr Regex
_) <- Int -> ReaderT Arguments (MP m') RE
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
          RE
patt <- Text -> ReaderT Arguments (MP m') RE
forall (m :: * -> *). MonadFail m => Text -> m RE
makeRE (Text
reStr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"$")
          Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean (Bool -> Val) -> Bool -> Val
forall a b. (a -> b) -> a -> b
$ RE -> Text -> Bool
forall source target.
RegexContext Regex source target =>
RE -> source -> target
match RE
patt Text
t
        Text
"find" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
          (RE
patt :: RE) <- Int -> ReaderT Arguments (MP m') RE
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
          Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$
            let ((Text
_, Text
m, Text
_) :: (Text, Text, Text)) = RE -> Text -> (Text, Text, Text)
forall source target.
RegexContext Regex source target =>
RE -> source -> target
match RE
patt Text
t
             in Text -> Val
VString Text
m
        Text
"position" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
          (RE
patt :: RE) <- Int -> ReaderT Arguments (MP m') RE
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
          Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$
            let ((Int
off, Int
_) :: (Int, Int)) = RE -> Text -> (Int, Int)
forall source target.
RegexContext Regex source target =>
RE -> source -> target
match RE
patt Text
t
             in Integer -> Val
VInteger (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
off)
        Text
"match" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
          (RE
patt :: RE) <- Int -> ReaderT Arguments (MP m') RE
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
          let (Text
pre, Text
whole, (Text
_post :: Text), [Text]
subs) = RE -> Text -> (Text, Text, Text, [Text])
forall source target.
RegexContext Regex source target =>
RE -> source -> target
match RE
patt Text
t
          if Text -> Bool
T.null Text
whole
            then Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
VNone
            else
              Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$
                OMap Identifier Val -> Val
VDict (OMap Identifier Val -> Val) -> OMap Identifier Val -> Val
forall a b. (a -> b) -> a -> b
$
                  [(Identifier, Val)] -> OMap Identifier Val
forall k v. Ord k => [(k, v)] -> OMap k v
OM.fromList
                    [ (Identifier
"start", Integer -> Val
VInteger (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length Text
pre)),
                      (Identifier
"end", Integer -> Val
VInteger (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length Text
pre Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
whole)),
                      (Identifier
"text", Text -> Val
VString Text
whole),
                      (Identifier
"captures", Vector Val -> Val
VArray (Vector Val -> Val) -> Vector Val -> Val
forall a b. (a -> b) -> a -> b
$ [Val] -> Vector Val
forall a. [a] -> Vector a
V.fromList ([Val] -> Vector Val) -> [Val] -> Vector Val
forall a b. (a -> b) -> a -> b
$ (Text -> Val) -> [Text] -> [Val]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Val
VString [Text]
subs)
                    ]
        Text
"matches" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
          (RE
patt :: RE) <- Int -> ReaderT Arguments (MP m') RE
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
          let matchToDict :: Array i (Int, Int) -> Val
matchToDict Array i (Int, Int)
matchArray =
                case Array i (Int, Int) -> [(Int, Int)]
forall i e. Array i e -> [e]
Array.elems Array i (Int, Int)
matchArray of
                  [] -> Val
VNone
                  (Int
off, Int
len) : [(Int, Int)]
subs ->
                    let submatches :: [Val]
submatches = ((Int, Int) -> Val) -> [(Int, Int)] -> [Val]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
o, Int
l) -> Text -> Val
VString (Text -> Val) -> Text -> Val
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> Text -> Text
forall source. Extract source => (Int, Int) -> source -> source
extract (Int
o, Int
l) Text
t) [(Int, Int)]
subs
                     in OMap Identifier Val -> Val
VDict (OMap Identifier Val -> Val) -> OMap Identifier Val -> Val
forall a b. (a -> b) -> a -> b
$
                          [(Identifier, Val)] -> OMap Identifier Val
forall k v. Ord k => [(k, v)] -> OMap k v
OM.fromList
                            [ (Identifier
"start", Integer -> Val
VInteger (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
off)),
                              (Identifier
"end", Integer -> Val
VInteger (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
off Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)),
                              (Identifier
"text", Text -> Val
VString (Text -> Val) -> Text -> Val
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> Text -> Text
forall source. Extract source => (Int, Int) -> source -> source
extract (Int
off, Int
len) Text
t),
                              (Identifier
"captures", Vector Val -> Val
VArray (Vector Val -> Val) -> Vector Val -> Val
forall a b. (a -> b) -> a -> b
$ [Val] -> Vector Val
forall a. [a] -> Vector a
V.fromList [Val]
submatches)
                            ]
          let matches :: [Val]
matches = (MatchArray -> Val) -> [MatchArray] -> [Val]
forall a b. (a -> b) -> [a] -> [b]
map MatchArray -> Val
forall {i}. Array i (Int, Int) -> Val
matchToDict ([MatchArray] -> [Val]) -> [MatchArray] -> [Val]
forall a b. (a -> b) -> a -> b
$ RE -> Text -> [MatchArray]
forall source.
RegexLike Regex source =>
RE -> source -> [MatchArray]
matchAll RE
patt Text
t
          Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Vector Val -> Val
VArray (Vector Val -> Val) -> Vector Val -> Val
forall a b. (a -> b) -> a -> b
$ [Val] -> Vector Val
forall a. [a] -> Vector a
V.fromList [Val]
matches
        Text
"replace" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
          RE
patt :: RE <- Int -> ReaderT Arguments (MP m') RE
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
          (Val
replacement :: Val) <- Int -> ReaderT Arguments (MP m') Val
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
2
          Maybe Int
mbCount :: Maybe Int <- Identifier -> Maybe Int -> ReaderT Arguments (MP m') (Maybe Int)
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Identifier -> a -> ReaderT Arguments (MP m) a
namedArg Identifier
"count" Maybe Int
forall a. Maybe a
Nothing
          case Maybe Int
mbCount of
            Just Int
0 -> Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Text -> Val
VString Text
t
            Maybe Int
_ ->
              case Val
replacement of
                VString Text
r ->
                  Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Text -> Val
VString (Text -> Val) -> Text -> Val
forall a b. (a -> b) -> a -> b
$ RE -> Maybe Int -> (RegexMatch -> Text) -> Text -> Text
replaceRegex RE
patt Maybe Int
mbCount (Text -> RegexMatch -> Text
forall a b. a -> b -> a
const Text
r) Text
t
                VSymbol (Symbol Text
r Bool
_ [(Set Text, Text)]
_) ->
                  Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Text -> Val
VString (Text -> Val) -> Text -> Val
forall a b. (a -> b) -> a -> b
$ RE -> Maybe Int -> (RegexMatch -> Text) -> Text -> Text
replaceRegex RE
patt Maybe Int
mbCount (Text -> RegexMatch -> Text
forall a b. a -> b -> a
const Text
r) Text
t
                VFunction Maybe Identifier
_ Map Identifier Val
_ Function
f ->
                  Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$
                    Text -> Val
VString (Text -> Val) -> Text -> Val
forall a b. (a -> b) -> a -> b
$
                      RE -> Maybe Int -> (RegexMatch -> Text) -> Text -> Text
replaceRegex
                        RE
patt
                        Maybe Int
mbCount
                        ( \(RegexMatch Int
start Int
end Text
txt [Text]
captures) ->
                            case Function -> [Val] -> Attempt Val
applyPureFunction
                              Function
f
                              [ OMap Identifier Val -> Val
VDict (OMap Identifier Val -> Val) -> OMap Identifier Val -> Val
forall a b. (a -> b) -> a -> b
$
                                  [(Identifier, Val)] -> OMap Identifier Val
forall k v. Ord k => [(k, v)] -> OMap k v
OM.fromList
                                    [ (Identifier
"start", Integer -> Val
VInteger (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
start)),
                                      (Identifier
"end", Integer -> Val
VInteger (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
end)),
                                      (Identifier
"text", Text -> Val
VString Text
txt),
                                      (Identifier
"captures", Vector Val -> Val
VArray ([Val] -> Vector Val
forall a. [a] -> Vector a
V.fromList ((Text -> Val) -> [Text] -> [Val]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Val
VString [Text]
captures)))
                                    ]
                              ] of
                              Success (VString Text
s) -> Text
s
                              Attempt Val
_ -> Text
""
                        )
                        Text
t
                Val
_ -> String -> ReaderT Arguments (MP m') Val
forall a. String -> ReaderT Arguments (MP m') a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"replacement must be string or function"
        Text
"trim" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
          (RE Text
patt Regex
_) <- Int -> ReaderT Arguments (MP m') RE
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1 ReaderT Arguments (MP m') RE
-> ReaderT Arguments (MP m') RE -> ReaderT Arguments (MP m') RE
forall a.
ReaderT Arguments (MP m') a
-> ReaderT Arguments (MP m') a -> ReaderT Arguments (MP m') a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Text -> ReaderT Arguments (MP m') RE
forall (m :: * -> *). MonadFail m => Text -> m RE
makeRE Text
"[[:space:]]*"
          (Bool
repeated :: Bool) <- Identifier -> Bool -> ReaderT Arguments (MP m') Bool
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Identifier -> a -> ReaderT Arguments (MP m) a
namedArg Identifier
"repeat" Bool
True
          (Maybe Val
mbAt :: Maybe Val) <- Identifier -> Maybe Val -> ReaderT Arguments (MP m') (Maybe Val)
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Identifier -> a -> ReaderT Arguments (MP m) a
namedArg Identifier
"at" Maybe Val
forall a. Maybe a
Nothing
          let patt' :: Text
patt' =
                if Bool
repeated
                  then Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
patt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")*"
                  else Text
patt
          RE
patt'' <- case Maybe Val
mbAt of
            Just (VAlignment (Just Horiz
HorizStart) Maybe Vert
_) -> Text -> ReaderT Arguments (MP m') RE
forall (m :: * -> *). MonadFail m => Text -> m RE
makeRE (Text -> ReaderT Arguments (MP m') RE)
-> Text -> ReaderT Arguments (MP m') RE
forall a b. (a -> b) -> a -> b
$ Text
"^" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
patt'
            Just (VAlignment (Just Horiz
HorizEnd) Maybe Vert
_) -> Text -> ReaderT Arguments (MP m') RE
forall (m :: * -> *). MonadFail m => Text -> m RE
makeRE (Text -> ReaderT Arguments (MP m') RE)
-> Text -> ReaderT Arguments (MP m') RE
forall a b. (a -> b) -> a -> b
$ Text
patt' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"$"
            Maybe Val
Nothing -> Text -> ReaderT Arguments (MP m') RE
forall (m :: * -> *). MonadFail m => Text -> m RE
makeRE (Text -> ReaderT Arguments (MP m') RE)
-> Text -> ReaderT Arguments (MP m') RE
forall a b. (a -> b) -> a -> b
$ Text
"(^" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
patt' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")|(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
patt' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"$)"
            Maybe Val
_ -> String -> ReaderT Arguments (MP m') RE
forall a. String -> ReaderT Arguments (MP m') a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"'at' expected either 'start' or 'end'"
          Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Text -> Val
VString (Text -> Val) -> Text -> Val
forall a b. (a -> b) -> a -> b
$ RE -> Maybe Int -> (RegexMatch -> Text) -> Text -> Text
replaceRegex RE
patt'' Maybe Int
forall a. Maybe a
Nothing (Text -> RegexMatch -> Text
forall a b. a -> b -> a
const Text
forall a. Monoid a => a
mempty) Text
t
        Text
"split" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
          Val
arg <- Int -> ReaderT Arguments (MP m') Val
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
          case Val
arg of
            VString Text
"" ->
              Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Vector Val -> Val
VArray (Vector Val -> Val) -> Vector Val -> Val
forall a b. (a -> b) -> a -> b
$ [Val] -> Vector Val
forall a. [a] -> Vector a
V.fromList ([Val] -> Vector Val) -> [Val] -> Vector Val
forall a b. (a -> b) -> a -> b
$ (Text -> Val) -> [Text] -> [Val]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Val
VString ([Text] -> [Val]) -> [Text] -> [Val]
forall a b. (a -> b) -> a -> b
$ Text
"" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Int -> Text -> [Text]
T.chunksOf Int
1 Text
t [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
Item [Text]
""]
            VString Text
patt -> Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Vector Val -> Val
VArray (Vector Val -> Val) -> Vector Val -> Val
forall a b. (a -> b) -> a -> b
$ [Val] -> Vector Val
forall a. [a] -> Vector a
V.fromList ([Val] -> Vector Val) -> [Val] -> Vector Val
forall a b. (a -> b) -> a -> b
$ (Text -> Val) -> [Text] -> [Val]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Val
VString ([Text] -> [Val]) -> [Text] -> [Val]
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
patt Text
t
            VRegex RE
patt ->
              Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$
                Vector Val -> Val
VArray (Vector Val -> Val) -> Vector Val -> Val
forall a b. (a -> b) -> a -> b
$
                  [Val] -> Vector Val
forall a. [a] -> Vector a
V.fromList ([Val] -> Vector Val) -> [Val] -> Vector Val
forall a b. (a -> b) -> a -> b
$
                    (Text -> Val) -> [Text] -> [Val]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Val
VString ([Text] -> [Val]) -> [Text] -> [Val]
forall a b. (a -> b) -> a -> b
$
                      RE -> Text -> [Text]
splitRegex RE
patt Text
t
            Val
_ ->
              -- defaults to split on whitespace
              Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Vector Val -> Val
VArray (Vector Val -> Val) -> Vector Val -> Val
forall a b. (a -> b) -> a -> b
$ [Val] -> Vector Val
forall a. [a] -> Vector a
V.fromList ([Val] -> Vector Val) -> [Val] -> Vector Val
forall a b. (a -> b) -> a -> b
$ (Text -> Val) -> [Text] -> [Val]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Val
VString ([Text] -> [Val]) -> [Text] -> [Val]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.words Text
t
        Text
_ -> String -> Text -> m Val
forall {m :: * -> *} {a} {a}.
(MonadFail m, Show a) =>
String -> a -> m a
noMethod String
"String" Text
fld
    VCounter Counter
key ->
      case Text
fld of
        Text
"display" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
          Maybe Integer
mbnum <- Counter -> Map Counter Integer -> Maybe Integer
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Counter
key (Map Counter Integer -> Maybe Integer)
-> (EvalState m' -> Map Counter Integer)
-> EvalState m'
-> Maybe Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalState m' -> Map Counter Integer
forall (m :: * -> *). EvalState m -> Map Counter Integer
evalCounters (EvalState m' -> Maybe Integer)
-> ReaderT Arguments (MP m') (EvalState m')
-> ReaderT Arguments (MP m') (Maybe Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MP m' (EvalState m') -> ReaderT Arguments (MP m') (EvalState m')
forall (m :: * -> *) a. Monad m => m a -> ReaderT Arguments m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift MP m' (EvalState m')
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
          ReaderT Arguments (MP m') Val
-> (Integer -> ReaderT Arguments (MP m') Val)
-> Maybe Integer
-> ReaderT Arguments (MP m') Val
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> ReaderT Arguments (MP m') Val
forall a. String -> ReaderT Arguments (MP m') a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"counter not defined") (Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> (Integer -> Val) -> Integer -> ReaderT Arguments (MP m') Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Val
VInteger) Maybe Integer
mbnum
        Text
"step" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
          MP m' () -> ReaderT Arguments (MP m') ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT Arguments m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (MP m' () -> ReaderT Arguments (MP m') ())
-> MP m' () -> ReaderT Arguments (MP m') ()
forall a b. (a -> b) -> a -> b
$ (EvalState m' -> EvalState m') -> MP m' ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((EvalState m' -> EvalState m') -> MP m' ())
-> (EvalState m' -> EvalState m') -> MP m' ()
forall a b. (a -> b) -> a -> b
$ \EvalState m'
st ->
            EvalState m'
st {evalCounters = M.adjust (+ 1) key $ evalCounters st}
          Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
VNone
        Text
"update" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
          Maybe Integer
mbnum <- Counter -> Map Counter Integer -> Maybe Integer
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Counter
key (Map Counter Integer -> Maybe Integer)
-> (EvalState m' -> Map Counter Integer)
-> EvalState m'
-> Maybe Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalState m' -> Map Counter Integer
forall (m :: * -> *). EvalState m -> Map Counter Integer
evalCounters (EvalState m' -> Maybe Integer)
-> ReaderT Arguments (MP m') (EvalState m')
-> ReaderT Arguments (MP m') (Maybe Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MP m' (EvalState m') -> ReaderT Arguments (MP m') (EvalState m')
forall (m :: * -> *) a. Monad m => m a -> ReaderT Arguments m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift MP m' (EvalState m')
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
          case Maybe Integer
mbnum of
            Maybe Integer
Nothing -> String -> ReaderT Arguments (MP m') Val
forall a. String -> ReaderT Arguments (MP m') a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"counter not defined"
            Just Integer
num -> do
              Val
newval <- Int -> ReaderT Arguments (MP m') Val
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
              (Integer
newnum :: Integer) <-
                case Val
newval of
                  VFunction Maybe Identifier
_ Map Identifier Val
_ Function
fn ->
                    case Function -> [Val] -> Attempt Val
applyPureFunction Function
fn [Integer -> Val
VInteger Integer
num] of
                      Failure String
e -> String -> ReaderT Arguments (MP m') Integer
forall a. String -> ReaderT Arguments (MP m') a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
                      Success Val
v -> Val -> ReaderT Arguments (MP m') Integer
forall a (m :: * -> *).
(FromVal a, MonadPlus m, MonadFail m) =>
Val -> m a
forall (m :: * -> *).
(MonadPlus m, MonadFail m) =>
Val -> m Integer
fromVal Val
v
                  Val
_ -> Val -> ReaderT Arguments (MP m') Integer
forall a (m :: * -> *).
(FromVal a, MonadPlus m, MonadFail m) =>
Val -> m a
forall (m :: * -> *).
(MonadPlus m, MonadFail m) =>
Val -> m Integer
fromVal Val
newval
              MP m' () -> ReaderT Arguments (MP m') ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT Arguments m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (MP m' () -> ReaderT Arguments (MP m') ())
-> MP m' () -> ReaderT Arguments (MP m') ()
forall a b. (a -> b) -> a -> b
$ (EvalState m' -> EvalState m') -> MP m' ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((EvalState m' -> EvalState m') -> MP m' ())
-> (EvalState m' -> EvalState m') -> MP m' ()
forall a b. (a -> b) -> a -> b
$ \EvalState m'
st ->
                EvalState m'
st {evalCounters = M.adjust (const newnum) key $ evalCounters st}
              Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
VNone
        Text
"at" -> Text -> m Val
forall {m :: * -> *} {a} {a}. (MonadFail m, Show a) => a -> m a
methodUnimplemented Text
fld
        Text
"final" -> Text -> m Val
forall {m :: * -> *} {a} {a}. (MonadFail m, Show a) => a -> m a
methodUnimplemented Text
fld
        Text
_ -> String -> Text -> m Val
forall {m :: * -> *} {a} {a}.
(MonadFail m, Show a) =>
String -> a -> m a
noMethod String
"Counter" Text
fld
    VContent Seq Content
cs ->
      case Text
fld of
        Text
"func" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
          case Seq Content -> [Content]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Seq Content
cs of
            [Elt Identifier
name Maybe SourcePos
_ Map Identifier Val
_] -> MP m' Val -> ReaderT Arguments (MP m') Val
forall (m :: * -> *) a. Monad m => m a -> ReaderT Arguments m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (MP m' Val -> ReaderT Arguments (MP m') Val)
-> MP m' Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Identifier -> MP m' Val
forall (m :: * -> *). Monad m => Identifier -> MP m Val
lookupIdentifier Identifier
name
            [Txt Text
_] -> MP m' Val -> ReaderT Arguments (MP m') Val
forall (m :: * -> *) a. Monad m => m a -> ReaderT Arguments m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (MP m' Val -> ReaderT Arguments (MP m') Val)
-> MP m' Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Identifier -> MP m' Val
forall (m :: * -> *). Monad m => Identifier -> MP m Val
lookupIdentifier Identifier
"text"
            [Content]
_ -> Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
              [Val]
xs <- ReaderT Arguments (MP m') [Val]
forall (m :: * -> *). Monad m => ReaderT Arguments (MP m) [Val]
allArgs
              Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Seq Content -> Val
VContent (Seq Content -> Val) -> Seq Content -> Val
forall a b. (a -> b) -> a -> b
$ (Val -> Seq Content) -> [Val] -> Seq Content
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Val -> Seq Content
valToContent [Val]
xs
        Text
"has" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
          Text
f <- Int -> ReaderT Arguments (MP m') Text
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
          case Seq Content -> [Content]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Seq Content
cs of
            [Elt Identifier
_ Maybe SourcePos
_ Map Identifier Val
fields] -> do
              case Identifier -> Map Identifier Val -> Maybe Val
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Text -> Identifier
Identifier Text
f) Map Identifier Val
fields of
                Just Val
_ -> Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
True
                Maybe Val
Nothing -> Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
False
            [Content]
_ | Text
f Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"children" -> Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
True
            [Content]
_ ->
              String -> ReaderT Arguments (MP m') Val
forall a. String -> ReaderT Arguments (MP m') a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ReaderT Arguments (MP m') Val)
-> String -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$
                String
"Content is not a single element: "
                  String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (Val -> Text
repr (Seq Content -> Val
VContent Seq Content
cs))
        Text
"at" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
          (Text
field :: Text) <- ReaderT Arguments (MP m') Arguments
forall r (m :: * -> *). MonadReader r m => m r
ask ReaderT Arguments (MP m') Arguments
-> (Arguments -> ReaderT Arguments (MP m') Val)
-> ReaderT Arguments (MP m') Val
forall a b.
ReaderT Arguments (MP m') a
-> (a -> ReaderT Arguments (MP m') b)
-> ReaderT Arguments (MP m') b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Arguments -> ReaderT Arguments (MP m') Val
forall (m :: * -> *) a.
(MonadFail m, MonadPlus m, FromVal a) =>
Int -> Arguments -> m a
getPositionalArg Int
1 ReaderT Arguments (MP m') Val
-> (Val -> ReaderT Arguments (MP m') Text)
-> ReaderT Arguments (MP m') Text
forall a b.
ReaderT Arguments (MP m') a
-> (a -> ReaderT Arguments (MP m') b)
-> ReaderT Arguments (MP m') b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Val -> ReaderT Arguments (MP m') Text
forall a (m :: * -> *).
(FromVal a, MonadPlus m, MonadFail m) =>
Val -> m a
forall (m :: * -> *). (MonadPlus m, MonadFail m) => Val -> m Text
fromVal
          Val
defval <- Identifier -> Val -> ReaderT Arguments (MP m') Val
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Identifier -> a -> ReaderT Arguments (MP m) a
namedArg Identifier
"default" Val
VNone
          case Seq Content -> [Content]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Seq Content
cs of
            [Elt Identifier
_ Maybe SourcePos
_ Map Identifier Val
fields] ->
              case Identifier -> Map Identifier Val -> Maybe Val
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Text -> Identifier
Identifier Text
field) Map Identifier Val
fields of
                Just Val
v -> Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
v
                Maybe Val
Nothing -> Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
defval
            [Content]
_ -> Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
defval
        Text
"location" -> Text -> m Val
forall {m :: * -> *} {a} {a}. (MonadFail m, Show a) => a -> m a
methodUnimplemented Text
fld
        Text
"text" ->
          case Seq Content -> [Content]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Seq Content
cs of
            [Txt Text
t] -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ Text -> Val
VString Text
t
            [Elt Identifier
"text" Maybe SourcePos
_ [(Identifier
"body", VContent [Txt Text
t])]] -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ Text -> Val
VString Text
t
            [Elt Identifier
_ Maybe SourcePos
_ Map Identifier Val
fields]
              | Just Val
x <- Identifier -> Map Identifier Val -> Maybe Val
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Identifier
"text" Map Identifier Val
fields -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
x
            [Content]
_ -> String -> m Val
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Content is not a single text element"
        Text
"fields" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
          OMap Identifier Val -> Val
VDict (OMap Identifier Val -> Val)
-> ReaderT Arguments (MP m') (OMap Identifier Val)
-> ReaderT Arguments (MP m') Val
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            case Seq Content -> [Content]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Seq Content
cs of
              (Elt Identifier
_ Maybe SourcePos
_ Map Identifier Val
fields:[Content]
_) -> OMap Identifier Val
-> ReaderT Arguments (MP m') (OMap Identifier Val)
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OMap Identifier Val
 -> ReaderT Arguments (MP m') (OMap Identifier Val))
-> OMap Identifier Val
-> ReaderT Arguments (MP m') (OMap Identifier Val)
forall a b. (a -> b) -> a -> b
$ [(Identifier, Val)] -> OMap Identifier Val
forall k v. Ord k => [(k, v)] -> OMap k v
OM.fromList ([(Identifier, Val)] -> OMap Identifier Val)
-> [(Identifier, Val)] -> OMap Identifier Val
forall a b. (a -> b) -> a -> b
$ Map Identifier Val -> [(Identifier, Val)]
forall k a. Map k a -> [(k, a)]
M.toList Map Identifier Val
fields
              [Content]
_ -> OMap Identifier Val
-> ReaderT Arguments (MP m') (OMap Identifier Val)
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OMap Identifier Val
forall k v. OMap k v
OM.empty
        Text
_ ->
          let childrenOrFallback :: m Val
childrenOrFallback =
                if Text
fld Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"children"
                  then
                    Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$
                      Vector Val -> Val
VArray (Vector Val -> Val) -> Vector Val -> Val
forall a b. (a -> b) -> a -> b
$
                        [Val] -> Vector Val
forall a. [a] -> Vector a
V.fromList ([Val] -> Vector Val) -> [Val] -> Vector Val
forall a b. (a -> b) -> a -> b
$
                          (Content -> Val) -> [Content] -> [Val]
forall a b. (a -> b) -> [a] -> [b]
map (\Content
x -> Seq Content -> Val
VContent [Item (Seq Content)
Content
x]) ([Content] -> [Val]) -> [Content] -> [Val]
forall a b. (a -> b) -> a -> b
$
                            Seq Content -> [Content]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Seq Content
cs
                  else String -> Text -> m Val
forall {m :: * -> *} {a} {a}.
(MonadFail m, Show a) =>
String -> a -> m a
noMethod String
"Content" Text
fld
           in case Seq Content
cs of
                [Elt Identifier
_name Maybe SourcePos
_ Map Identifier Val
fields] ->
                  m Val -> (Val -> m Val) -> Maybe Val -> m Val
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m Val
childrenOrFallback Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Val -> m Val) -> Maybe Val -> m Val
forall a b. (a -> b) -> a -> b
$ Identifier -> Map Identifier Val -> Maybe Val
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Text -> Identifier
Identifier Text
fld) Map Identifier Val
fields
                Seq Content
_ -> m Val
childrenOrFallback
    VTermItem Seq Content
t Seq Content
d ->
      case Text
fld of
        Text
"term" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ Seq Content -> Val
VContent Seq Content
t
        Text
"description" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ Seq Content -> Val
VContent Seq Content
d
        Text
_ -> String -> Text -> m Val
forall {m :: * -> *} {a} {a}.
(MonadFail m, Show a) =>
String -> a -> m a
noMethod String
"TermItem" Text
fld
    VVersion [Integer]
xs ->
      case Text
fld of
        Text
"at" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
                  Int
i <- Int -> ReaderT Arguments (MP m') Int
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
                  Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Integer -> Val
VInteger (Integer -> Val) -> Integer -> Val
forall a b. (a -> b) -> a -> b
$ Integer -> Maybe Integer -> Integer
forall a. a -> Maybe a -> a
fromMaybe Integer
0 (Maybe Integer -> Integer) -> Maybe Integer -> Integer
forall a b. (a -> b) -> a -> b
$ [Integer] -> Maybe Integer
forall a. [a] -> Maybe a
listToMaybe ([Integer] -> Maybe Integer) -> [Integer] -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ Int -> [Integer] -> [Integer]
forall a. Int -> [a] -> [a]
drop Int
i [Integer]
xs
        Text
_ -> String -> Text -> m Val
forall {m :: * -> *} {a} {a}.
(MonadFail m, Show a) =>
String -> a -> m a
noMethod String
"Version" Text
fld
    VArray Vector Val
v -> do
      let toPos :: Int -> Int
toPos Int
n =
            if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
              then Vector Val -> Int
forall a. Vector a -> Int
V.length Vector Val
v Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n
              else Int
n
      case Text
fld of
        Text
"len" ->
          Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Integer -> Val
VInteger (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Vector Val -> Int
forall a. Vector a -> Int
V.length Vector Val
v)
        Text
"first" ->
          Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$
            (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$
              if Vector Val -> Bool
forall a. Vector a -> Bool
V.null Vector Val
v
                then String -> ReaderT Arguments (MP m') Val
forall a. String -> ReaderT Arguments (MP m') a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"empty array"
                else Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Vector Val -> Val
forall a. Vector a -> a
V.head Vector Val
v
        Text
"last" ->
          Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$
            (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$
              if Vector Val -> Bool
forall a. Vector a -> Bool
V.null Vector Val
v
                then String -> ReaderT Arguments (MP m') Val
forall a. String -> ReaderT Arguments (MP m') a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"empty array"
                else Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Vector Val -> Val
forall a. Vector a -> a
V.last Vector Val
v
        Text
"at" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
          Int
pos <- Int -> Int
toPos (Int -> Int)
-> ReaderT Arguments (MP m') Int -> ReaderT Arguments (MP m') Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ReaderT Arguments (MP m') Int
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
          Val
defval <- Identifier -> Val -> ReaderT Arguments (MP m') Val
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Identifier -> a -> ReaderT Arguments (MP m) a
namedArg Identifier
"default" Val
VNone
          Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Val -> Maybe Val -> Val
forall a. a -> Maybe a -> a
fromMaybe Val
defval (Maybe Val -> Val) -> Maybe Val -> Val
forall a b. (a -> b) -> a -> b
$ Vector Val
v Vector Val -> Int -> Maybe Val
forall a. Vector a -> Int -> Maybe a
V.!? Int
pos
        Text
"push" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
          Val
x <- Int -> ReaderT Arguments (MP m') Val
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
          MP m' () -> ReaderT Arguments (MP m') ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT Arguments m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (MP m' () -> ReaderT Arguments (MP m') ())
-> MP m' () -> ReaderT Arguments (MP m') ()
forall a b. (a -> b) -> a -> b
$ Val -> MP m' ()
forall (n :: * -> *). Monad n => Val -> MP n ()
updateVal (Val -> MP m' ()) -> Val -> MP m' ()
forall a b. (a -> b) -> a -> b
$ Vector Val -> Val
VArray (Vector Val -> Val) -> Vector Val -> Val
forall a b. (a -> b) -> a -> b
$ Vector Val -> Val -> Vector Val
forall a. Vector a -> a -> Vector a
V.snoc Vector Val
v Val
x
          Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
VNone
        Text
"pop" ->
          Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$
            (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$
              if Vector Val -> Bool
forall a. Vector a -> Bool
V.null Vector Val
v
                then String -> ReaderT Arguments (MP m') Val
forall a. String -> ReaderT Arguments (MP m') a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"empty array"
                else do
                  MP m' () -> ReaderT Arguments (MP m') ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT Arguments m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (MP m' () -> ReaderT Arguments (MP m') ())
-> MP m' () -> ReaderT Arguments (MP m') ()
forall a b. (a -> b) -> a -> b
$ Val -> MP m' ()
forall (n :: * -> *). Monad n => Val -> MP n ()
updateVal (Val -> MP m' ()) -> Val -> MP m' ()
forall a b. (a -> b) -> a -> b
$ Vector Val -> Val
VArray (Vector Val -> Val) -> Vector Val -> Val
forall a b. (a -> b) -> a -> b
$ Vector Val -> Vector Val
forall a. Vector a -> Vector a
V.init Vector Val
v
                  Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Vector Val -> Val
forall a. Vector a -> a
V.last Vector Val
v
        Text
"slice" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
          Int
start <- Int -> Int
toPos (Int -> Int)
-> ReaderT Arguments (MP m') Int -> ReaderT Arguments (MP m') Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ReaderT Arguments (MP m') Int
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
          Maybe Int
mbcount <- Identifier -> Maybe Int -> ReaderT Arguments (MP m') (Maybe Int)
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Identifier -> a -> ReaderT Arguments (MP m) a
namedArg Identifier
"count" Maybe Int
forall a. Maybe a
Nothing
          Int
end <- (Int -> Int
toPos (Int -> Int)
-> ReaderT Arguments (MP m') Int -> ReaderT Arguments (MP m') Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ReaderT Arguments (MP m') Int
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
2) ReaderT Arguments (MP m') Int
-> ReaderT Arguments (MP m') Int -> ReaderT Arguments (MP m') Int
forall a.
ReaderT Arguments (MP m') a
-> ReaderT Arguments (MP m') a -> ReaderT Arguments (MP m') a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
                    Int -> ReaderT Arguments (MP m') Int
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Vector Val -> Int
forall a. Vector a -> Int
V.length Vector Val
v) (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
start) Maybe Int
mbcount)
          if Vector Val -> Int
forall a. Vector a -> Int
V.length Vector Val
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
end
            then String -> ReaderT Arguments (MP m') Val
forall a. String -> ReaderT Arguments (MP m') a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"array contains insufficient elements for slice"
            else
              if Int
end Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
start
                then Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Vector Val -> Val
VArray Vector Val
forall a. Monoid a => a
mempty
                else Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Vector Val -> Val
VArray (Vector Val -> Val) -> Vector Val -> Val
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Vector Val -> Vector Val
forall a. Int -> Int -> Vector a -> Vector a
V.slice Int
start (Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start) Vector Val
v
        Text
"split" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
          Val
spliton <- Int -> ReaderT Arguments (MP m') Val
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
          let go :: Vector Val -> [Val]
go Vector Val
v' = case (Val -> Bool) -> Vector Val -> (Vector Val, Vector Val)
forall a. (a -> Bool) -> Vector a -> (Vector a, Vector a)
V.break (Val -> Val -> Bool
forall a. Eq a => a -> a -> Bool
== Val
spliton) Vector Val
v' of
                (Vector Val
a, Vector Val
b) | Vector Val -> Bool
forall a. Vector a -> Bool
V.null Vector Val
b -> [Vector Val -> Val
VArray Vector Val
a | Bool -> Bool
not (Vector Val -> Bool
forall a. Vector a -> Bool
V.null Vector Val
a)]
                (Vector Val
a, Vector Val
b) -> Vector Val -> Val
VArray Vector Val
a Val -> [Val] -> [Val]
forall a. a -> [a] -> [a]
: Vector Val -> [Val]
go (Int -> Vector Val -> Vector Val
forall a. Int -> Vector a -> Vector a
V.drop Int
1 Vector Val
b)
          Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Vector Val -> Val
VArray (Vector Val -> Val) -> Vector Val -> Val
forall a b. (a -> b) -> a -> b
$ [Val] -> Vector Val
forall a. [a] -> Vector a
V.fromList ([Val] -> Vector Val) -> [Val] -> Vector Val
forall a b. (a -> b) -> a -> b
$ Vector Val -> [Val]
go Vector Val
v
        Text
"intersperse" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
          Val
sep <- Int -> ReaderT Arguments (MP m') Val
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
          Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Vector Val -> Val
VArray (Vector Val -> Val)
-> (Vector Val -> Vector Val) -> Vector Val -> Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Val] -> Vector Val
forall a. [a] -> Vector a
V.fromList ([Val] -> Vector Val)
-> (Vector Val -> [Val]) -> Vector Val -> Vector Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Val -> [Val] -> [Val]
forall a. a -> [a] -> [a]
intersperse Val
sep ([Val] -> [Val]) -> (Vector Val -> [Val]) -> Vector Val -> [Val]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Val -> [Val]
forall a. Vector a -> [a]
V.toList (Vector Val -> Val) -> Vector Val -> Val
forall a b. (a -> b) -> a -> b
$ Vector Val
v
        Text
"dedup" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
          Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Vector Val -> Val
VArray (Vector Val -> Val) -> Vector Val -> Val
forall a b. (a -> b) -> a -> b
$ Vector Val -> Vector Val
forall a. Eq a => Vector a -> Vector a
deduplicateVector Vector Val
v
        Text
"insert" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
          Int
pos <- Int -> Int
toPos (Int -> Int)
-> ReaderT Arguments (MP m') Int -> ReaderT Arguments (MP m') Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ReaderT Arguments (MP m') Int
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
          Val
newval <- Int -> ReaderT Arguments (MP m') Val
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
2
          if Int
pos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Vector Val -> Int
forall a. Vector a -> Int
V.length Vector Val
v Bool -> Bool -> Bool
|| Int
pos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
            then String -> ReaderT Arguments (MP m') Val
forall a. String -> ReaderT Arguments (MP m') a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"insert position out of bounds in array"
            else do
              MP m' () -> ReaderT Arguments (MP m') ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT Arguments m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (MP m' () -> ReaderT Arguments (MP m') ())
-> MP m' () -> ReaderT Arguments (MP m') ()
forall a b. (a -> b) -> a -> b
$ Val -> MP m' ()
forall (n :: * -> *). Monad n => Val -> MP n ()
updateVal (Val -> MP m' ()) -> Val -> MP m' ()
forall a b. (a -> b) -> a -> b
$ Vector Val -> Val
VArray (Vector Val -> Val) -> Vector Val -> Val
forall a b. (a -> b) -> a -> b
$ Vector Val -> Val -> Vector Val
forall a. Vector a -> a -> Vector a
V.snoc (Int -> Vector Val -> Vector Val
forall a. Int -> Vector a -> Vector a
V.take Int
pos Vector Val
v) Val
newval Vector Val -> Vector Val -> Vector Val
forall a. Semigroup a => a -> a -> a
<> Int -> Vector Val -> Vector Val
forall a. Int -> Vector a -> Vector a
V.drop Int
pos Vector Val
v
              Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
VNone
        Text
"remove" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
          Int
pos <- Int -> Int
toPos (Int -> Int)
-> ReaderT Arguments (MP m') Int -> ReaderT Arguments (MP m') Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ReaderT Arguments (MP m') Int
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
          if Int
pos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Vector Val -> Int
forall a. Vector a -> Int
V.length Vector Val
v Bool -> Bool -> Bool
|| Int
pos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
            then String -> ReaderT Arguments (MP m') Val
forall a. String -> ReaderT Arguments (MP m') a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"remove position out of bounds in array"
            else do
              MP m' () -> ReaderT Arguments (MP m') ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT Arguments m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (MP m' () -> ReaderT Arguments (MP m') ())
-> MP m' () -> ReaderT Arguments (MP m') ()
forall a b. (a -> b) -> a -> b
$ Val -> MP m' ()
forall (n :: * -> *). Monad n => Val -> MP n ()
updateVal (Val -> MP m' ()) -> Val -> MP m' ()
forall a b. (a -> b) -> a -> b
$ Vector Val -> Val
VArray (Vector Val -> Val) -> Vector Val -> Val
forall a b. (a -> b) -> a -> b
$ Int -> Vector Val -> Vector Val
forall a. Int -> Vector a -> Vector a
V.take Int
pos Vector Val
v Vector Val -> Vector Val -> Vector Val
forall a. Semigroup a => a -> a -> a
<> Int -> Vector Val -> Vector Val
forall a. Int -> Vector a -> Vector a
V.drop (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Vector Val
v
              Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Val -> Maybe Val -> Val
forall a. a -> Maybe a -> a
fromMaybe Val
VNone (Maybe Val -> Val) -> Maybe Val -> Val
forall a b. (a -> b) -> a -> b
$ Vector Val
v Vector Val -> Int -> Maybe Val
forall a. Vector a -> Int -> Maybe a
V.!? Int
pos
        Text
"contains" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
          Val
item <- Int -> ReaderT Arguments (MP m') Val
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
          Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean (Bool -> Val) -> Bool -> Val
forall a b. (a -> b) -> a -> b
$ Val -> Vector Val -> Bool
forall a. Eq a => a -> Vector a -> Bool
V.elem Val
item Vector Val
v
        Text
"find" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
          Function forall (m :: * -> *). Monad m => Arguments -> MP m Val
fn <- Int -> ReaderT Arguments (MP m') Function
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
          let go :: Maybe Val
-> Val -> t (ParsecT [Markup] (EvalState m) m) (Maybe Val)
go Maybe Val
Nothing Val
y = do
                Val
res <- ParsecT [Markup] (EvalState m) m Val
-> t (ParsecT [Markup] (EvalState m) m) Val
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT [Markup] (EvalState m) m Val
 -> t (ParsecT [Markup] (EvalState m) m) Val)
-> ParsecT [Markup] (EvalState m) m Val
-> t (ParsecT [Markup] (EvalState m) m) Val
forall a b. (a -> b) -> a -> b
$ Arguments -> ParsecT [Markup] (EvalState m) m Val
forall (m :: * -> *). Monad m => Arguments -> MP m Val
fn Arguments {positional :: [Val]
positional = [Item [Val]
Val
y], named :: OMap Identifier Val
named = OMap Identifier Val
forall k v. OMap k v
OM.empty}
                case Val
res of
                  VBoolean Bool
True -> Maybe Val -> t (ParsecT [Markup] (EvalState m) m) (Maybe Val)
forall a. a -> t (ParsecT [Markup] (EvalState m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Val -> t (ParsecT [Markup] (EvalState m) m) (Maybe Val))
-> Maybe Val -> t (ParsecT [Markup] (EvalState m) m) (Maybe Val)
forall a b. (a -> b) -> a -> b
$ Val -> Maybe Val
forall a. a -> Maybe a
Just Val
y
                  VBoolean Bool
False -> Maybe Val -> t (ParsecT [Markup] (EvalState m) m) (Maybe Val)
forall a. a -> t (ParsecT [Markup] (EvalState m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Val
forall a. Maybe a
Nothing
                  Val
_ -> String -> t (ParsecT [Markup] (EvalState m) m) (Maybe Val)
forall a. String -> t (ParsecT [Markup] (EvalState m) m) a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"function does not return a boolean"
              go (Just Val
z) Val
_ = Maybe Val -> t (ParsecT [Markup] (EvalState m) m) (Maybe Val)
forall a. a -> t (ParsecT [Markup] (EvalState m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Val -> t (ParsecT [Markup] (EvalState m) m) (Maybe Val))
-> Maybe Val -> t (ParsecT [Markup] (EvalState m) m) (Maybe Val)
forall a b. (a -> b) -> a -> b
$ Val -> Maybe Val
forall a. a -> Maybe a
Just Val
z
          Maybe Val
res <- (Maybe Val -> Val -> ReaderT Arguments (MP m') (Maybe Val))
-> Maybe Val -> Vector Val -> ReaderT Arguments (MP m') (Maybe Val)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Maybe Val -> Val -> ReaderT Arguments (MP m') (Maybe Val)
forall {t :: (* -> *) -> * -> *} {m :: * -> *}.
(MonadTrans t, Monad m,
 MonadFail (t (ParsecT [Markup] (EvalState m) m))) =>
Maybe Val
-> Val -> t (ParsecT [Markup] (EvalState m) m) (Maybe Val)
go Maybe Val
forall a. Maybe a
Nothing Vector Val
v
          case Maybe Val
res of
            Just Val
z -> Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
z
            Maybe Val
Nothing -> Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
VNone
        Text
"position" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
          Function forall (m :: * -> *). Monad m => Arguments -> MP m Val
fn <- Int -> ReaderT Arguments (MP m') Function
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
          let go :: Either a a
-> Val -> t (ParsecT [Markup] (EvalState m) m) (Either a a)
go (Left a
i) Val
y = do
                Val
res <- ParsecT [Markup] (EvalState m) m Val
-> t (ParsecT [Markup] (EvalState m) m) Val
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT [Markup] (EvalState m) m Val
 -> t (ParsecT [Markup] (EvalState m) m) Val)
-> ParsecT [Markup] (EvalState m) m Val
-> t (ParsecT [Markup] (EvalState m) m) Val
forall a b. (a -> b) -> a -> b
$ Arguments -> ParsecT [Markup] (EvalState m) m Val
forall (m :: * -> *). Monad m => Arguments -> MP m Val
fn Arguments {positional :: [Val]
positional = [Item [Val]
Val
y], named :: OMap Identifier Val
named = OMap Identifier Val
forall k v. OMap k v
OM.empty}
                case Val
res of
                  VBoolean Bool
True -> Either a a -> t (ParsecT [Markup] (EvalState m) m) (Either a a)
forall a. a -> t (ParsecT [Markup] (EvalState m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either a a -> t (ParsecT [Markup] (EvalState m) m) (Either a a))
-> Either a a -> t (ParsecT [Markup] (EvalState m) m) (Either a a)
forall a b. (a -> b) -> a -> b
$ a -> Either a a
forall a b. b -> Either a b
Right a
i
                  VBoolean Bool
False -> Either a a -> t (ParsecT [Markup] (EvalState m) m) (Either a a)
forall a. a -> t (ParsecT [Markup] (EvalState m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either a a -> t (ParsecT [Markup] (EvalState m) m) (Either a a))
-> Either a a -> t (ParsecT [Markup] (EvalState m) m) (Either a a)
forall a b. (a -> b) -> a -> b
$ a -> Either a a
forall a b. a -> Either a b
Left (a
i a -> a -> a
forall a. Num a => a -> a -> a
+ a
1)
                  Val
_ -> String -> t (ParsecT [Markup] (EvalState m) m) (Either a a)
forall a. String -> t (ParsecT [Markup] (EvalState m) m) a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"function does not return a boolean"
              go (Right a
i) Val
_ = Either a a -> t (ParsecT [Markup] (EvalState m) m) (Either a a)
forall a. a -> t (ParsecT [Markup] (EvalState m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either a a -> t (ParsecT [Markup] (EvalState m) m) (Either a a))
-> Either a a -> t (ParsecT [Markup] (EvalState m) m) (Either a a)
forall a b. (a -> b) -> a -> b
$ a -> Either a a
forall a b. b -> Either a b
Right a
i
          Either Integer Integer
res <- (Either Integer Integer
 -> Val -> ReaderT Arguments (MP m') (Either Integer Integer))
-> Either Integer Integer
-> Vector Val
-> ReaderT Arguments (MP m') (Either Integer Integer)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Either Integer Integer
-> Val -> ReaderT Arguments (MP m') (Either Integer Integer)
forall {t :: (* -> *) -> * -> *} {m :: * -> *} {a}.
(MonadTrans t, Monad m, Num a,
 MonadFail (t (ParsecT [Markup] (EvalState m) m))) =>
Either a a
-> Val -> t (ParsecT [Markup] (EvalState m) m) (Either a a)
go (Integer -> Either Integer Integer
forall a b. a -> Either a b
Left Integer
0) Vector Val
v
          case Either Integer Integer
res of
            Right Integer
i -> Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Integer -> Val
VInteger Integer
i
            Left Integer
_ -> Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
VNone
        Text
"filter" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
          Function forall (m :: * -> *). Monad m => Arguments -> MP m Val
fn <- Int -> ReaderT Arguments (MP m') Function
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
          let predicate :: Val -> t (ParsecT [Markup] (EvalState m) m) Bool
predicate Val
y = do
                Val
res <- ParsecT [Markup] (EvalState m) m Val
-> t (ParsecT [Markup] (EvalState m) m) Val
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT [Markup] (EvalState m) m Val
 -> t (ParsecT [Markup] (EvalState m) m) Val)
-> ParsecT [Markup] (EvalState m) m Val
-> t (ParsecT [Markup] (EvalState m) m) Val
forall a b. (a -> b) -> a -> b
$ Arguments -> ParsecT [Markup] (EvalState m) m Val
forall (m :: * -> *). Monad m => Arguments -> MP m Val
fn Arguments {positional :: [Val]
positional = [Item [Val]
Val
y], named :: OMap Identifier Val
named = OMap Identifier Val
forall k v. OMap k v
OM.empty}
                case Val
res of
                  VBoolean Bool
True -> Bool -> t (ParsecT [Markup] (EvalState m) m) Bool
forall a. a -> t (ParsecT [Markup] (EvalState m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
                  VBoolean Bool
False -> Bool -> t (ParsecT [Markup] (EvalState m) m) Bool
forall a. a -> t (ParsecT [Markup] (EvalState m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
                  Val
_ -> String -> t (ParsecT [Markup] (EvalState m) m) Bool
forall a. String -> t (ParsecT [Markup] (EvalState m) m) a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"function does not return a boolean"
          Vector Val -> Val
VArray (Vector Val -> Val)
-> ReaderT Arguments (MP m') (Vector Val)
-> ReaderT Arguments (MP m') Val
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Val -> ReaderT Arguments (MP m') Bool)
-> Vector Val -> ReaderT Arguments (MP m') (Vector Val)
forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> Vector a -> m (Vector a)
V.filterM Val -> ReaderT Arguments (MP m') Bool
forall {t :: (* -> *) -> * -> *} {m :: * -> *}.
(MonadTrans t, Monad m,
 MonadFail (t (ParsecT [Markup] (EvalState m) m))) =>
Val -> t (ParsecT [Markup] (EvalState m) m) Bool
predicate Vector Val
v
        Text
"map" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
          Function forall (m :: * -> *). Monad m => Arguments -> MP m Val
fn <- Int -> ReaderT Arguments (MP m') Function
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
          let f :: Val -> t (ParsecT [Markup] (EvalState m) m) Val
f Val
y = ParsecT [Markup] (EvalState m) m Val
-> t (ParsecT [Markup] (EvalState m) m) Val
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT [Markup] (EvalState m) m Val
 -> t (ParsecT [Markup] (EvalState m) m) Val)
-> ParsecT [Markup] (EvalState m) m Val
-> t (ParsecT [Markup] (EvalState m) m) Val
forall a b. (a -> b) -> a -> b
$ Arguments -> ParsecT [Markup] (EvalState m) m Val
forall (m :: * -> *). Monad m => Arguments -> MP m Val
fn Arguments {positional :: [Val]
positional = [Item [Val]
Val
y], named :: OMap Identifier Val
named = OMap Identifier Val
forall k v. OMap k v
OM.empty}
          Vector Val -> Val
VArray (Vector Val -> Val)
-> ReaderT Arguments (MP m') (Vector Val)
-> ReaderT Arguments (MP m') Val
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Val -> ReaderT Arguments (MP m') Val)
-> Vector Val -> ReaderT Arguments (MP m') (Vector Val)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
V.mapM Val -> ReaderT Arguments (MP m') Val
forall {t :: (* -> *) -> * -> *} {m :: * -> *}.
(MonadTrans t, Monad m) =>
Val -> t (ParsecT [Markup] (EvalState m) m) Val
f Vector Val
v
        Text
"flatten" ->
          Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$
            (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$
              Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$
                Vector Val -> Val
VArray (Vector Val -> Val) -> Vector Val -> Val
forall a b. (a -> b) -> a -> b
$
                  [Vector Val] -> Vector Val
forall a. [Vector a] -> Vector a
V.concat [Vector Val
v' | VArray Vector Val
v' <- Vector Val -> [Val]
forall a. Vector a -> [a]
V.toList Vector Val
v]
        Text
"enumerate" ->
          Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$
            (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$
              Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$
                Vector Val -> Val
VArray (Vector Val -> Val) -> Vector Val -> Val
forall a b. (a -> b) -> a -> b
$
                  (Val -> Val -> Val) -> Vector Val -> Vector Val -> Vector Val
forall a b c. (a -> b -> c) -> Vector a -> Vector b -> Vector c
V.zipWith
                    (\Val
x Val
y -> Vector Val -> Val
VArray [Item (Vector Val)
Val
x, Item (Vector Val)
Val
y])
                    ((Integer -> Val) -> Vector Integer -> Vector Val
forall a b. (a -> b) -> Vector a -> Vector b
V.map Integer -> Val
VInteger [Integer
Item (Vector Integer)
0 .. (Int -> Item (Vector Integer)
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Item (Vector Integer)) -> Int -> Item (Vector Integer)
forall a b. (a -> b) -> a -> b
$ Vector Val -> Int
forall a. Vector a -> Int
V.length Vector Val
v)])
                    Vector Val
v
        Text
"fold" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
          (Val
start :: Val) <- Int -> ReaderT Arguments (MP m') Val
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
          Function forall (m :: * -> *). Monad m => Arguments -> MP m Val
fn <- Int -> ReaderT Arguments (MP m') Function
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
2
          let f :: Val -> Val -> MP m Val
f Val
acc Val
y = Arguments -> MP m Val
forall (m :: * -> *). Monad m => Arguments -> MP m Val
fn Arguments {positional :: [Val]
positional = [Item [Val]
Val
acc, Item [Val]
Val
y], named :: OMap Identifier Val
named = OMap Identifier Val
forall k v. OMap k v
OM.empty}
          MP m' Val -> ReaderT Arguments (MP m') Val
forall (m :: * -> *) a. Monad m => m a -> ReaderT Arguments m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (MP m' Val -> ReaderT Arguments (MP m') Val)
-> MP m' Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ (Val -> Val -> MP m' Val) -> Val -> [Val] -> MP m' Val
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Val -> Val -> MP m' Val
forall {m :: * -> *}. Monad m => Val -> Val -> MP m Val
f Val
start ([Val] -> MP m' Val) -> [Val] -> MP m' Val
forall a b. (a -> b) -> a -> b
$ Vector Val -> [Val]
forall a. Vector a -> [a]
V.toList Vector Val
v
        Text
"any" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
          Function forall (m :: * -> *). Monad m => Arguments -> MP m Val
fn <- Int -> ReaderT Arguments (MP m') Function
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
          let predicate :: Val -> t (ParsecT [Markup] (EvalState m) m) Bool
predicate Val
y = do
                Val
res <- ParsecT [Markup] (EvalState m) m Val
-> t (ParsecT [Markup] (EvalState m) m) Val
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT [Markup] (EvalState m) m Val
 -> t (ParsecT [Markup] (EvalState m) m) Val)
-> ParsecT [Markup] (EvalState m) m Val
-> t (ParsecT [Markup] (EvalState m) m) Val
forall a b. (a -> b) -> a -> b
$ Arguments -> ParsecT [Markup] (EvalState m) m Val
forall (m :: * -> *). Monad m => Arguments -> MP m Val
fn Arguments {positional :: [Val]
positional = [Item [Val]
Val
y], named :: OMap Identifier Val
named = OMap Identifier Val
forall k v. OMap k v
OM.empty}
                case Val
res of
                  VBoolean Bool
True -> Bool -> t (ParsecT [Markup] (EvalState m) m) Bool
forall a. a -> t (ParsecT [Markup] (EvalState m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
                  VBoolean Bool
False -> Bool -> t (ParsecT [Markup] (EvalState m) m) Bool
forall a. a -> t (ParsecT [Markup] (EvalState m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
                  Val
_ -> String -> t (ParsecT [Markup] (EvalState m) m) Bool
forall a. String -> t (ParsecT [Markup] (EvalState m) m) a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"function not return a boolean"
          (Bool -> Val
VBoolean (Bool -> Val) -> (Vector Bool -> Bool) -> Vector Bool -> Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Bool) -> Vector Bool -> Bool
forall a. (a -> Bool) -> Vector a -> Bool
V.any Bool -> Bool
forall a. a -> a
id) (Vector Bool -> Val)
-> ReaderT Arguments (MP m') (Vector Bool)
-> ReaderT Arguments (MP m') Val
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Val -> ReaderT Arguments (MP m') Bool)
-> Vector Val -> ReaderT Arguments (MP m') (Vector Bool)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
mapM Val -> ReaderT Arguments (MP m') Bool
forall {t :: (* -> *) -> * -> *} {m :: * -> *}.
(MonadTrans t, Monad m,
 MonadFail (t (ParsecT [Markup] (EvalState m) m))) =>
Val -> t (ParsecT [Markup] (EvalState m) m) Bool
predicate Vector Val
v
        Text
"all" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
          Function forall (m :: * -> *). Monad m => Arguments -> MP m Val
fn <- Int -> ReaderT Arguments (MP m') Function
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
          let predicate :: Val -> t (ParsecT [Markup] (EvalState m) m) Bool
predicate Val
y = do
                Val
res <- ParsecT [Markup] (EvalState m) m Val
-> t (ParsecT [Markup] (EvalState m) m) Val
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT [Markup] (EvalState m) m Val
 -> t (ParsecT [Markup] (EvalState m) m) Val)
-> ParsecT [Markup] (EvalState m) m Val
-> t (ParsecT [Markup] (EvalState m) m) Val
forall a b. (a -> b) -> a -> b
$ Arguments -> ParsecT [Markup] (EvalState m) m Val
forall (m :: * -> *). Monad m => Arguments -> MP m Val
fn Arguments {positional :: [Val]
positional = [Item [Val]
Val
y], named :: OMap Identifier Val
named = OMap Identifier Val
forall k v. OMap k v
OM.empty}
                case Val
res of
                  VBoolean Bool
True -> Bool -> t (ParsecT [Markup] (EvalState m) m) Bool
forall a. a -> t (ParsecT [Markup] (EvalState m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
                  VBoolean Bool
False -> Bool -> t (ParsecT [Markup] (EvalState m) m) Bool
forall a. a -> t (ParsecT [Markup] (EvalState m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
                  Val
_ -> String -> t (ParsecT [Markup] (EvalState m) m) Bool
forall a. String -> t (ParsecT [Markup] (EvalState m) m) a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"function not return a boolean"
          (Bool -> Val
VBoolean (Bool -> Val) -> (Vector Bool -> Bool) -> Vector Bool -> Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Bool) -> Vector Bool -> Bool
forall a. (a -> Bool) -> Vector a -> Bool
V.all Bool -> Bool
forall a. a -> a
id) (Vector Bool -> Val)
-> ReaderT Arguments (MP m') (Vector Bool)
-> ReaderT Arguments (MP m') Val
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Val -> ReaderT Arguments (MP m') Bool)
-> Vector Val -> ReaderT Arguments (MP m') (Vector Bool)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
mapM Val -> ReaderT Arguments (MP m') Bool
forall {t :: (* -> *) -> * -> *} {m :: * -> *}.
(MonadTrans t, Monad m,
 MonadFail (t (ParsecT [Markup] (EvalState m) m))) =>
Val -> t (ParsecT [Markup] (EvalState m) m) Bool
predicate Vector Val
v
        Text
"rev" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Vector Val -> Val
VArray (Vector Val -> Val) -> Vector Val -> Val
forall a b. (a -> b) -> a -> b
$ Vector Val -> Vector Val
forall a. Vector a -> Vector a
V.reverse Vector Val
v
        Text
"join" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
          Val
separator <- Int -> ReaderT Arguments (MP m') Val
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
          Val
lastsep <- Identifier -> Val -> ReaderT Arguments (MP m') Val
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Identifier -> a -> ReaderT Arguments (MP m) a
namedArg Identifier
"last" Val
separator
          let xs' :: [Val]
xs' = Vector Val -> [Val]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Vector Val
v
          let xs :: [Val]
xs = case [Val]
xs' of
                [] -> []
                [Val]
_ -> Val -> [Val] -> [Val]
forall a. a -> [a] -> [a]
intersperse Val
separator ([Val] -> [Val]
forall a. HasCallStack => [a] -> [a]
init [Val]
xs') [Val] -> [Val] -> [Val]
forall a. [a] -> [a] -> [a]
++ [Item [Val]
Val
lastsep, [Val] -> Val
forall a. HasCallStack => [a] -> a
last [Val]
xs']
          (Val -> Val -> ReaderT Arguments (MP m') Val)
-> Val -> [Val] -> ReaderT Arguments (MP m') Val
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Val -> Val -> ReaderT Arguments (MP m') Val
forall (m :: * -> *). MonadFail m => Val -> Val -> m Val
joinVals Val
VNone [Val]
xs
        Text
"sorted" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
          (Maybe Function
mbKeyFn :: Maybe Function) <- Identifier
-> Maybe Function -> ReaderT Arguments (MP m') (Maybe Function)
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Identifier -> a -> ReaderT Arguments (MP m) a
namedArg Identifier
"key" Maybe Function
forall a. Maybe a
Nothing
          case Maybe Function
mbKeyFn of
            Maybe Function
Nothing -> Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Vector Val -> Val
VArray (Vector Val -> Val) -> Vector Val -> Val
forall a b. (a -> b) -> a -> b
$ [Val] -> Vector Val
forall a. [a] -> Vector a
V.fromList ([Val] -> Vector Val) -> [Val] -> Vector Val
forall a b. (a -> b) -> a -> b
$ [Val] -> [Val]
forall a. Ord a => [a] -> [a]
sort ([Val] -> [Val]) -> [Val] -> [Val]
forall a b. (a -> b) -> a -> b
$ Vector Val -> [Val]
forall a. Vector a -> [a]
V.toList Vector Val
v
            Just (Function forall (m :: * -> *). Monad m => Arguments -> MP m Val
kf) -> do
              let kf' :: Val -> t (ParsecT [Markup] (EvalState m) m) Val
kf' Val
x = ParsecT [Markup] (EvalState m) m Val
-> t (ParsecT [Markup] (EvalState m) m) Val
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT [Markup] (EvalState m) m Val
 -> t (ParsecT [Markup] (EvalState m) m) Val)
-> ParsecT [Markup] (EvalState m) m Val
-> t (ParsecT [Markup] (EvalState m) m) Val
forall a b. (a -> b) -> a -> b
$ Arguments -> ParsecT [Markup] (EvalState m) m Val
forall (m :: * -> *). Monad m => Arguments -> MP m Val
kf Arguments {positional :: [Val]
positional = [Item [Val]
Val
x], named :: OMap Identifier Val
named = OMap Identifier Val
forall k v. OMap k v
OM.empty}
              Vector Val -> Val
VArray (Vector Val -> Val)
-> ([(Val, Val)] -> Vector Val) -> [(Val, Val)] -> Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Val] -> Vector Val
forall a. [a] -> Vector a
V.fromList ([Val] -> Vector Val)
-> ([(Val, Val)] -> [Val]) -> [(Val, Val)] -> Vector Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Val, Val) -> Val) -> [(Val, Val)] -> [Val]
forall a b. (a -> b) -> [a] -> [b]
map (Val, Val) -> Val
forall a b. (a, b) -> a
fst ([(Val, Val)] -> [Val])
-> ([(Val, Val)] -> [(Val, Val)]) -> [(Val, Val)] -> [Val]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Val, Val) -> Val) -> [(Val, Val)] -> [(Val, Val)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Val, Val) -> Val
forall a b. (a, b) -> b
snd
                ([(Val, Val)] -> Val)
-> ReaderT Arguments (MP m') [(Val, Val)]
-> ReaderT Arguments (MP m') Val
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Val -> ReaderT Arguments (MP m') (Val, Val))
-> [Val] -> ReaderT Arguments (MP m') [(Val, Val)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\Val
x -> (Val
x,) (Val -> (Val, Val))
-> ReaderT Arguments (MP m') Val
-> ReaderT Arguments (MP m') (Val, Val)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Val -> ReaderT Arguments (MP m') Val
forall {t :: (* -> *) -> * -> *} {m :: * -> *}.
(MonadTrans t, Monad m) =>
Val -> t (ParsecT [Markup] (EvalState m) m) Val
kf' Val
x) (Vector Val -> [Val]
forall a. Vector a -> [a]
V.toList Vector Val
v))
        Text
"zip" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
          ([Val]
xs :: [Val]) <- Arguments -> [Val]
positional (Arguments -> [Val])
-> ReaderT Arguments (MP m') Arguments
-> ReaderT Arguments (MP m') [Val]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT Arguments (MP m') Arguments
forall r (m :: * -> *). MonadReader r m => m r
ask
          let len :: Int
len = Vector Val -> Int
forall a. Vector a -> Int
V.length Vector Val
v
          Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Vector Val -> Val
VArray (Vector Val -> Val) -> Vector Val -> Val
forall a b. (a -> b) -> a -> b
$ (Val -> Bool) -> Vector Val -> Vector Val
forall a. (a -> Bool) -> Vector a -> Vector a
V.filter (Val -> Val -> Bool
forall a. Eq a => a -> a -> Bool
/= Val
VNone) (Vector Val -> Vector Val) -> Vector Val -> Vector Val
forall a b. (a -> b) -> a -> b
$
            (Int -> Val) -> Vector Int -> Vector Val
forall a b. (a -> b) -> Vector a -> Vector b
V.map (\Int
i -> Val -> ([Val] -> Val) -> Maybe [Val] -> Val
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Val
VNone (Vector Val -> Val
VArray (Vector Val -> Val) -> ([Val] -> Vector Val) -> [Val] -> Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Val] -> Vector Val
forall a. [a] -> Vector a
V.fromList)
                           ((Val -> Maybe Val) -> [Val] -> Maybe [Val]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\Val
x ->
                              case Val
x of
                                VArray Vector Val
v' -> Vector Val
v' Vector Val -> Int -> Maybe Val
forall a. Vector a -> Int -> Maybe a
V.!? Int
i
                                Val
_ -> Maybe Val
forall a. Maybe a
Nothing) (Val
val Val -> [Val] -> [Val]
forall a. a -> [a] -> [a]
: [Val]
xs)))
              (Int -> Int -> Vector Int
forall a. Enum a => a -> a -> Vector a
V.enumFromTo Int
0 (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
        Text
"sum" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
          Maybe Val
mbv <- Identifier -> Maybe Val -> ReaderT Arguments (MP m') (Maybe Val)
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Identifier -> a -> ReaderT Arguments (MP m) a
namedArg Identifier
"default" Maybe Val
forall a. Maybe a
Nothing
          case Vector Val -> Maybe (Val, Vector Val)
forall a. Vector a -> Maybe (a, Vector a)
V.uncons Vector Val
v of
            Maybe (Val, Vector Val)
Nothing ->
              ReaderT Arguments (MP m') Val
-> (Val -> ReaderT Arguments (MP m') Val)
-> Maybe Val
-> ReaderT Arguments (MP m') Val
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                (String -> ReaderT Arguments (MP m') Val
forall a. String -> ReaderT Arguments (MP m') a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"sum of empty array with no default value")
                Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                Maybe Val
mbv
            Just (Val
h, Vector Val
rest) ->
              Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$
                Val -> Maybe Val -> Val
forall a. a -> Maybe a -> a
fromMaybe Val
VNone (Maybe Val -> Val) -> Maybe Val -> Val
forall a b. (a -> b) -> a -> b
$
                  (Maybe Val -> Val -> Maybe Val)
-> Maybe Val -> Vector Val -> Maybe Val
forall a b. (a -> b -> a) -> a -> Vector b -> a
V.foldl
                    ( \Maybe Val
mbsum Val
x -> case Maybe Val
mbsum of
                        Maybe Val
Nothing -> Maybe Val
forall a. Maybe a
Nothing
                        Just Val
y -> Val -> Val -> Maybe Val
forall a. Summable a => a -> a -> Maybe a
maybePlus Val
y Val
x
                    )
                    (Val -> Maybe Val
forall a. a -> Maybe a
Just Val
h)
                    Vector Val
rest
        Text
"product" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
          Maybe Val
mbv <- Identifier -> Maybe Val -> ReaderT Arguments (MP m') (Maybe Val)
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Identifier -> a -> ReaderT Arguments (MP m) a
namedArg Identifier
"default" Maybe Val
forall a. Maybe a
Nothing
          case Vector Val -> Maybe (Val, Vector Val)
forall a. Vector a -> Maybe (a, Vector a)
V.uncons Vector Val
v of
            Maybe (Val, Vector Val)
Nothing ->
              ReaderT Arguments (MP m') Val
-> (Val -> ReaderT Arguments (MP m') Val)
-> Maybe Val
-> ReaderT Arguments (MP m') Val
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                (String -> ReaderT Arguments (MP m') Val
forall a. String -> ReaderT Arguments (MP m') a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"product of empty array with no default value")
                Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                Maybe Val
mbv
            Just (Val
h, Vector Val
rest) ->
              Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$
                Val -> Maybe Val -> Val
forall a. a -> Maybe a -> a
fromMaybe Val
VNone (Maybe Val -> Val) -> Maybe Val -> Val
forall a b. (a -> b) -> a -> b
$
                  (Maybe Val -> Val -> Maybe Val)
-> Maybe Val -> Vector Val -> Maybe Val
forall a b. (a -> b -> a) -> a -> Vector b -> a
V.foldl
                    ( \Maybe Val
mbsum Val
x -> case Maybe Val
mbsum of
                        Maybe Val
Nothing -> Maybe Val
forall a. Maybe a
Nothing
                        Just Val
y -> Val -> Val -> Maybe Val
forall a. Multipliable a => a -> a -> Maybe a
maybeTimes Val
y Val
x
                    )
                    (Val -> Maybe Val
forall a. a -> Maybe a
Just Val
h)
                    Vector Val
rest
        Text
_ -> String -> Text -> m Val
forall {m :: * -> *} {a} {a}.
(MonadFail m, Show a) =>
String -> a -> m a
noMethod String
"Array" Text
fld
    VFunction Maybe Identifier
mbName Map Identifier Val
scope (Function forall (m :: * -> *). Monad m => Arguments -> MP m Val
f) ->
      case Text
fld of
        Text
"with" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
          Arguments
args <- ReaderT Arguments (MP m') Arguments
forall r (m :: * -> *). MonadReader r m => m r
ask
          Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$
            Maybe Identifier -> Map Identifier Val -> Function -> Val
VFunction Maybe Identifier
mbName Map Identifier Val
scope (Function -> Val) -> Function -> Val
forall a b. (a -> b) -> a -> b
$
              (forall (m :: * -> *). Monad m => Arguments -> MP m Val)
-> Function
Function ((forall (m :: * -> *). Monad m => Arguments -> MP m Val)
 -> Function)
-> (forall (m :: * -> *). Monad m => Arguments -> MP m Val)
-> Function
forall a b. (a -> b) -> a -> b
$
                \Arguments
args' -> Arguments -> MP m Val
forall (m :: * -> *). Monad m => Arguments -> MP m Val
f (Arguments
args Arguments -> Arguments -> Arguments
forall a. Semigroup a => a -> a -> a
<> Arguments
args')
        Text
"where" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
          Arguments
args <- ReaderT Arguments (MP m') Arguments
forall r (m :: * -> *). MonadReader r m => m r
ask
          case Maybe Identifier
mbName of
            Maybe Identifier
Nothing -> String -> ReaderT Arguments (MP m') Val
forall a. String -> ReaderT Arguments (MP m') a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"function is not an element function"
            Just Identifier
name ->
              Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$
                Selector -> Val
VSelector (Selector -> Val) -> Selector -> Val
forall a b. (a -> b) -> a -> b
$
                  Identifier -> [(Identifier, Val)] -> Selector
SelectElement Identifier
name (OMap Identifier Val -> [(Identifier, Val)]
forall k v. OMap k v -> [(k, v)]
OM.assocs (Arguments -> OMap Identifier Val
named Arguments
args))
        Text
_ -> String -> Text -> m Val
forall {m :: * -> *} {a} {a}.
(MonadFail m, Show a) =>
String -> a -> m a
noMethod String
"Function" Text
fld
    VSelector Selector
sel ->
      case Text
fld of
        Text
"or" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
          (Selector
other :: Selector) <- Int -> ReaderT Arguments (MP m') Selector
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
          Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Selector -> Val
VSelector (Selector -> Val) -> Selector -> Val
forall a b. (a -> b) -> a -> b
$ Selector -> Selector -> Selector
SelectOr Selector
other Selector
sel
        Text
"and" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
          (Selector
other :: Selector) <- Int -> ReaderT Arguments (MP m') Selector
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
          Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Selector -> Val
VSelector (Selector -> Val) -> Selector -> Val
forall a b. (a -> b) -> a -> b
$ Selector -> Selector -> Selector
SelectAnd Selector
other Selector
sel
        Text
"before" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
          (Selector
other :: Selector) <- Int -> ReaderT Arguments (MP m') Selector
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
          Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Selector -> Val
VSelector (Selector -> Val) -> Selector -> Val
forall a b. (a -> b) -> a -> b
$ Selector -> Selector -> Selector
SelectBefore Selector
other Selector
sel
        Text
"after" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
          (Selector
other :: Selector) <- Int -> ReaderT Arguments (MP m') Selector
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
          Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Selector -> Val
VSelector (Selector -> Val) -> Selector -> Val
forall a b. (a -> b) -> a -> b
$ Selector -> Selector -> Selector
SelectAfter Selector
other Selector
sel
        Text
_ -> String -> Text -> m Val
forall {m :: * -> *} {a} {a}.
(MonadFail m, Show a) =>
String -> a -> m a
noMethod String
"Selector" Text
fld
    VArguments Arguments
args ->
      case Text
fld of
        Text
"pos" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Vector Val -> Val
VArray (Vector Val -> Val) -> Vector Val -> Val
forall a b. (a -> b) -> a -> b
$ [Val] -> Vector Val
forall a. [a] -> Vector a
V.fromList (Arguments -> [Val]
positional Arguments
args)
        Text
"named" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ OMap Identifier Val -> Val
VDict (OMap Identifier Val -> Val) -> OMap Identifier Val -> Val
forall a b. (a -> b) -> a -> b
$ Arguments -> OMap Identifier Val
named Arguments
args
        Text
_ -> String -> Text -> m Val
forall {m :: * -> *} {a} {a}.
(MonadFail m, Show a) =>
String -> a -> m a
noMethod String
"Arguments" Text
fld
    VDateTime Maybe Day
mbdate Maybe DiffTime
mbtime -> do
      let toSeconds :: DiffTime -> Integer
toSeconds = (Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor :: Double -> Integer) (Double -> Integer) -> (DiffTime -> Double) -> DiffTime -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffTime -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac
      case Text
fld of
        Text
"year" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$
          Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ case Day -> (Integer, Int, Int)
toGregorian (Day -> (Integer, Int, Int))
-> Maybe Day -> Maybe (Integer, Int, Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Day
mbdate of
                   Maybe (Integer, Int, Int)
Nothing -> Val
VNone
                   Just (Integer
y,Int
_,Int
_) -> Integer -> Val
VInteger (Integer -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
y)
        Text
"month" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$
          Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ case Day -> (Integer, Int, Int)
toGregorian (Day -> (Integer, Int, Int))
-> Maybe Day -> Maybe (Integer, Int, Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Day
mbdate of
                   Maybe (Integer, Int, Int)
Nothing -> Val
VNone
                   Just (Integer
_,Int
m,Int
_) -> Integer -> Val
VInteger (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m)
        Text
"day" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$
          Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ case Day -> (Integer, Int, Int)
toGregorian (Day -> (Integer, Int, Int))
-> Maybe Day -> Maybe (Integer, Int, Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Day
mbdate of
                   Maybe (Integer, Int, Int)
Nothing -> Val
VNone
                   Just (Integer
_,Int
_,Int
d) -> Integer -> Val
VInteger (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
d)
        Text
"weekday" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$
          Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ case Day -> DayOfWeek
dayOfWeek (Day -> DayOfWeek) -> Maybe Day -> Maybe DayOfWeek
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Day
mbdate of
                   Maybe DayOfWeek
Nothing -> Val
VNone
                   Just DayOfWeek
d-> Integer -> Val
VInteger (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ DayOfWeek -> Int
forall a. Enum a => a -> Int
fromEnum DayOfWeek
d)
        Text
"hour" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$
          Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ case DiffTime -> Integer
toSeconds (DiffTime -> Integer) -> Maybe DiffTime -> Maybe Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe DiffTime
mbtime of
            Maybe Integer
Nothing -> Val
VNone
            Just Integer
t -> Integer -> Val
VInteger (Integer -> Val) -> Integer -> Val
forall a b. (a -> b) -> a -> b
$ Integer
t Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
3600
        Text
"minute" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$
          Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ case DiffTime -> Integer
toSeconds (DiffTime -> Integer) -> Maybe DiffTime -> Maybe Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe DiffTime
mbtime of
            Maybe Integer
Nothing -> Val
VNone
            Just Integer
t -> Integer -> Val
VInteger (Integer -> Val) -> Integer -> Val
forall a b. (a -> b) -> a -> b
$ (Integer
t Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
3600) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
60
        Text
"second" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$
          Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ case DiffTime -> Integer
toSeconds (DiffTime -> Integer) -> Maybe DiffTime -> Maybe Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe DiffTime
mbtime of
            Maybe Integer
Nothing -> Val
VNone
            Just Integer
t -> Integer -> Val
VInteger (Integer -> Val) -> Integer -> Val
forall a b. (a -> b) -> a -> b
$ Integer
t Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
60
        Text
"display" -> Val -> m Val
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> m Val) -> Val -> m Val
forall a b. (a -> b) -> a -> b
$ (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
          Maybe String
mbfmt <- Int -> ReaderT Arguments (MP m') (Maybe String)
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1 ReaderT Arguments (MP m') (Maybe String)
-> ReaderT Arguments (MP m') (Maybe String)
-> ReaderT Arguments (MP m') (Maybe String)
forall a.
ReaderT Arguments (MP m') a
-> ReaderT Arguments (MP m') a -> ReaderT Arguments (MP m') a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe String -> ReaderT Arguments (MP m') (Maybe String)
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
forall a. Maybe a
Nothing
          Maybe String
mbformat <- case Maybe String
mbfmt of
            Maybe String
Nothing -> Maybe String -> ReaderT Arguments (MP m') (Maybe String)
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
forall a. Maybe a
Nothing
            Just String
fmt ->
              case [FormatPart] -> String
toTimeFormat ([FormatPart] -> String)
-> Either ParseError [FormatPart] -> Either ParseError String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either ParseError [FormatPart]
parseDisplayFormat String
fmt of
                Left ParseError
e -> String -> ReaderT Arguments (MP m') (Maybe String)
forall a. String -> ReaderT Arguments (MP m') a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ReaderT Arguments (MP m') (Maybe String))
-> String -> ReaderT Arguments (MP m') (Maybe String)
forall a b. (a -> b) -> a -> b
$ String
"Could not parse display format: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ParseError -> String
forall a. Show a => a -> String
show ParseError
e
                Right String
f -> Maybe String -> ReaderT Arguments (MP m') (Maybe String)
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe String -> ReaderT Arguments (MP m') (Maybe String))
-> Maybe String -> ReaderT Arguments (MP m') (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just String
f
          Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Text -> Val
VString (Text -> Val) -> Text -> Val
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$
            case (Maybe Day
mbdate, Maybe DiffTime
mbtime) of
              (Maybe Day
Nothing, Just DiffTime
t) -> TimeLocale -> String -> DiffTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"%X" Maybe String
mbformat) DiffTime
t
              (Just Day
d, Maybe DiffTime
Nothing) -> TimeLocale -> String -> Day -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"%F" Maybe String
mbformat) Day
d
              (Maybe Day
Nothing, Maybe DiffTime
Nothing) -> String
""
              (Just Day
d, Just DiffTime
t) -> TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"%X %F" Maybe String
mbformat)
                                    (Day -> DiffTime -> UTCTime
UTCTime Day
d DiffTime
t)
        Text
_ -> String -> Text -> m Val
forall {m :: * -> *} {a} {a}.
(MonadFail m, Show a) =>
String -> a -> m a
noMethod String
"DateTime" Text
fld
    Val
_ -> String -> Text -> m Val
forall {m :: * -> *} {a} {a}.
(MonadFail m, Show a) =>
String -> a -> m a
noMethod (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ') (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Val -> String
forall a. Show a => a -> String
show Val
val) Text
fld

formatNumber :: Text -> Int -> Text
formatNumber :: Text -> Int -> Text
formatNumber Text
t Int
n = (Char -> Text) -> String -> Text
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap Char -> Text
go (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
t
  where
    go :: Char -> Text
go Char
'1' | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 = String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
n)
    go Char
'a' | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 = Char -> Text
T.singleton (Char -> Text) -> Char -> Text
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. HasCallStack => [a] -> [a]
cycle [Char
Item String
'a' .. Char
Item String
'z'] String -> Int -> Char
forall a. HasCallStack => [a] -> Int -> a
!! (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
26)
    go Char
'A' | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 = Char -> Text
T.singleton (Char -> Text) -> Char -> Text
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. HasCallStack => [a] -> [a]
cycle [Char
Item String
'A' .. Char
Item String
'Z'] String -> Int -> Char
forall a. HasCallStack => [a] -> Int -> a
!! (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
26)
    go Char
'i' | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 = Text -> Text
T.toLower (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text
toRomanNumeral Int
n
    go Char
'I' | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 = Int -> Text
toRomanNumeral Int
n
    go Char
'い' | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 = String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
n) -- TODO
    go Char
'イ' | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 = String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
n) -- TODO
    go Char
'א' | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 = String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
n) -- TODO
    go Char
'*'
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 =
          Char -> Text
T.singleton (Char -> Text) -> Char -> Text
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. HasCallStack => [a] -> [a]
cycle [Char
Item String
'*', Char
Item String
'†', Char
Item String
'‡', Char
Item String
'§', Char
Item String
'¶', Char
Item String
'‖'] String -> Int -> Char
forall a. HasCallStack => [a] -> Int -> a
!! (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
6)
      | Bool
otherwise = Text
"-"
    go Char
c = Char -> Text
T.singleton Char
c

toRomanNumeral :: Int -> T.Text
toRomanNumeral :: Int -> Text
toRomanNumeral Int
x
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
4000 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Text
"?"
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1000 = Text
"M" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1000)
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
900 = Text
"CM" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
900)
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
500 = Text
"D" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
500)
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
400 = Text
"CD" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
400)
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
100 = Text
"C" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
100)
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
90 = Text
"XC" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
90)
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
50 = Text
"L" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
50)
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
40 = Text
"XL" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
40)
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
10 = Text
"X" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
10)
  | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
9 = Text
"IX"
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
5 = Text
"V" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
5)
  | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4 = Text
"IV"
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 = Text
"I" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  | Bool
otherwise = Text
""

-- parser for DateTime display format

data FormatPart =
    Literal String
  | Variable String [(String, String)]
  deriving Int -> FormatPart -> String -> String
[FormatPart] -> String -> String
FormatPart -> String
(Int -> FormatPart -> String -> String)
-> (FormatPart -> String)
-> ([FormatPart] -> String -> String)
-> Show FormatPart
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> FormatPart -> String -> String
showsPrec :: Int -> FormatPart -> String -> String
$cshow :: FormatPart -> String
show :: FormatPart -> String
$cshowList :: [FormatPart] -> String -> String
showList :: [FormatPart] -> String -> String
Show

parseDisplayFormat :: String -> Either ParseError [FormatPart]
parseDisplayFormat :: String -> Either ParseError [FormatPart]
parseDisplayFormat = Parsec String () [FormatPart]
-> String -> String -> Either ParseError [FormatPart]
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse (ParsecT String () Identity FormatPart
-> Parsec String () [FormatPart]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT String () Identity FormatPart
pFormatPart Parsec String () [FormatPart]
-> ParsecT String () Identity () -> Parsec String () [FormatPart]
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof) String
""

pFormatPart :: Parser FormatPart
pFormatPart :: ParsecT String () Identity FormatPart
pFormatPart = ParsecT String () Identity FormatPart
pVariable ParsecT String () Identity FormatPart
-> ParsecT String () Identity FormatPart
-> ParsecT String () Identity FormatPart
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity FormatPart
pLiteral

pLiteral :: Parser FormatPart
pLiteral :: ParsecT String () Identity FormatPart
pLiteral = String -> FormatPart
Literal (String -> FormatPart)
-> ParsecT String () Identity String
-> ParsecT String () Identity FormatPart
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ((Char -> Bool) -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'['))

pVariable :: Parser FormatPart
pVariable :: ParsecT String () Identity FormatPart
pVariable = do
  ParsecT String () Identity Char -> ParsecT String () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT String () Identity Char -> ParsecT String () Identity ())
-> ParsecT String () Identity Char -> ParsecT String () Identity ()
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'['
  String
name <- ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter
  ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
  [(String, String)]
modifiers <- ParsecT String () Identity (String, String)
-> ParsecT String () Identity [(String, String)]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT String () Identity (String, String)
pModifier
  ParsecT String () Identity Char -> ParsecT String () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT String () Identity Char -> ParsecT String () Identity ())
-> ParsecT String () Identity Char -> ParsecT String () Identity ()
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']'
  FormatPart -> ParsecT String () Identity FormatPart
forall a. a -> ParsecT String () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FormatPart -> ParsecT String () Identity FormatPart)
-> FormatPart -> ParsecT String () Identity FormatPart
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> FormatPart
Variable String
name [(String, String)]
modifiers

pModifier :: Parser (String, String)
pModifier :: ParsecT String () Identity (String, String)
pModifier = do
  String
name <- ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter
  ParsecT String () Identity Char -> ParsecT String () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT String () Identity Char -> ParsecT String () Identity ())
-> ParsecT String () Identity Char -> ParsecT String () Identity ()
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':'
  ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
  String
val <- ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum
  ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
  (String, String) -> ParsecT String () Identity (String, String)
forall a. a -> ParsecT String () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
name, String
val)

-- convert formatparts into Data.Time format string

toTimeFormat :: [FormatPart] -> String
toTimeFormat :: [FormatPart] -> String
toTimeFormat = (FormatPart -> String) -> [FormatPart] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap FormatPart -> String
toTimeFormatPart

toTimeFormatPart :: FormatPart -> String
toTimeFormatPart :: FormatPart -> String
toTimeFormatPart (Literal String
s) = (Char -> String -> String) -> String -> String -> String
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Char -> String -> String
esc String
"" String
s
 where
  esc :: Char -> String -> String
esc Char
'%' = (String
"%%" String -> String -> String
forall a. [a] -> [a] -> [a]
++)
  esc Char
'\t' = (String
"%t" String -> String -> String
forall a. [a] -> [a] -> [a]
++)
  esc Char
'\n' = (String
"%n" String -> String -> String
forall a. [a] -> [a] -> [a]
++)
  esc Char
c = (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:)
toTimeFormatPart (Variable String
"year" [(String, String)]
mods) =
  [(String, String)] -> String -> String
withPadding [(String, String)]
mods (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
    case String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"repr" [(String, String)]
mods of
       Just String
"last_two" -> String
"y"
       Maybe String
_ -> String
"Y"
toTimeFormatPart (Variable String
"month" [(String, String)]
mods) =
  [(String, String)] -> String -> String
withPadding [(String, String)]
mods (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
    case String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"repr" [(String, String)]
mods of
       Just String
"numerical" -> String
"%m"
       Just String
"long" -> String
"b"
       Just String
"short" -> String
"h"
       Maybe String
_ -> String
"m"
toTimeFormatPart (Variable String
"day" [(String, String)]
mods) =
  case String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"padding" [(String, String)]
mods of
    Just String
"space" -> String
"%e"
    Just String
"zero" -> String
"%d"
    Maybe String
_ -> String
"%e"
toTimeFormatPart (Variable String
"week_number" [(String, String)]
mods) =
  [(String, String)] -> String -> String
withPadding [(String, String)]
mods (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
    case String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"repr" [(String, String)]
mods of
      Just String
"ISO" -> String
"V"
      Just String
"sunday" -> String
"U"
      Just String
"monday" -> String
"W"
      Maybe String
_ -> String
"V"
toTimeFormatPart (Variable String
"weekday" [(String, String)]
mods) =
  [(String, String)] -> String -> String
withPadding [(String, String)]
mods (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
     case String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"repr" [(String, String)]
mods of
      Just String
"long" -> String
"A"
      Just String
"short" -> String
"a"
      Just String
"sunday" -> String
"w"
      Just String
"monday" -> String
"u"
      Maybe String
_ -> String
""
toTimeFormatPart (Variable String
"hour" [(String, String)]
mods) =
  case String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"hour" [(String, String)]
mods of
    Just String
"24" | String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"padding" [(String, String)]
mods Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Maybe String
forall a. a -> Maybe a
Just String
"zero" -> String
"%H"
              | Bool
otherwise -> String
"%k"
    Just String
"12" | String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"padding" [(String, String)]
mods Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Maybe String
forall a. a -> Maybe a
Just String
"zero" -> String
"%I"
              | Bool
otherwise -> String
"%l"
    Maybe String
_ -> String
"%k"
toTimeFormatPart (Variable String
"period" [(String, String)]
mods) =
  case String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"case" [(String, String)]
mods of
    Just String
"lower" -> String
"%P"
    Maybe String
_ -> String
"%p"
toTimeFormatPart (Variable String
"minute" [(String, String)]
_) = String
"%M"
toTimeFormatPart (Variable String
"second" [(String, String)]
_) = String
"%S"
toTimeFormatPart FormatPart
_ = String
"?"

withPadding :: [(String, String)] -> String -> String
withPadding :: [(String, String)] -> String -> String
withPadding [(String, String)]
mods String
s = Char
'%' Char -> String -> String
forall a. a -> [a] -> [a]
:
  case String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"padding" [(String, String)]
mods of
       Just String
"zero" -> Char
'0' Char -> String -> String
forall a. a -> [a] -> [a]
: String
s
       Just String
"space" -> Char
'_' Char -> String -> String
forall a. a -> [a] -> [a]
: String
s
       Maybe String
_ -> String
s

deduplicateVector :: Eq a => V.Vector a -> V.Vector a
deduplicateVector :: forall a. Eq a => Vector a -> Vector a
deduplicateVector =
  (Vector a -> a -> Vector a) -> Vector a -> Vector a -> Vector a
forall a b. (a -> b -> a) -> a -> Vector b -> a
V.foldl' (\Vector a
acc a
x -> if a
x a -> Vector a -> Bool
forall a. Eq a => a -> Vector a -> Bool
`V.elem` Vector a
acc then Vector a
acc else Vector a
acc Vector a -> a -> Vector a
forall a. Vector a -> a -> Vector a
`V.snoc` a
x) Vector a
forall a. Monoid a => a
mempty