{-# 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, isJust)
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(..))
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
key <- Int -> ReaderT Arguments (MP m') Text
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
defval <- namedArg "default" VNone
case OM.lookup (Identifier key) 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
key <- Int -> ReaderT Arguments (MP m') Text
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
v <- nthArg 2
lift $ updateVal $ VDict $ m OM.|> (Identifier key, v)
pure 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
key <- Int -> ReaderT Arguments (MP m') Text
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
case OM.lookup (Identifier key) 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
(n :: Rational) <- Int -> ReaderT Arguments (MP m') Rational
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
pure $ VColor $ case 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
(n :: Rational) <- Int -> ReaderT Arguments (MP m') Rational
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
pure $ VColor $ case 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
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
pure $ VString $ T.take 1 $ T.drop n 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
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
mbcount <- namedArg "count" Nothing
end <- (toPos <$> nthArg 2) `mplus`
pure (maybe (T.length t) (+ start) mbcount)
if end < start
then pure $ VString ""
else pure $ VString $ T.take (end - start) $ T.drop start 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
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
(patt :: RE) <- Int -> ReaderT Arguments (MP m') RE
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
pure $ VBoolean $ match patt 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 reStr _) <- Int -> ReaderT Arguments (MP m') RE
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
patt <- makeRE ("^" <> reStr)
pure $ VBoolean $ match patt 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 reStr _) <- Int -> ReaderT Arguments (MP m') RE
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
patt <- makeRE (reStr <> "$")
pure $ VBoolean $ match patt 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
(patt :: RE) <- Int -> ReaderT Arguments (MP m') RE
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
pure $
let ((_, m, _) :: (Text, Text, Text)) = match patt t
in VString 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
(patt :: RE) <- Int -> ReaderT Arguments (MP m') RE
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
pure $
let ((off, _) :: (Int, Int)) = match patt t
in VInteger (fromIntegral 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
(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 (pre, whole, (_post :: Text), subs) = match patt t
if T.null whole
then pure VNone
else
pure $
VDict $
OM.fromList
[ ("start", VInteger (fromIntegral $ T.length pre)),
("end", VInteger (fromIntegral $ T.length pre + T.length whole)),
("text", VString whole),
("captures", VArray $ V.fromList $ map VString 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
(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)
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 = (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
pure $ VArray $ V.fromList 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
patt :: RE <- Int -> ReaderT Arguments (MP m') RE
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
(replacement :: Val) <- nthArg 2
mbCount :: Maybe Int <- namedArg "count" Nothing
case 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 patt _) <- 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:]]*"
(repeated :: Bool) <- namedArg "repeat" True
(mbAt :: Maybe Val) <- namedArg "at" Nothing
let 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
patt'' <- case 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'"
pure $ VString $ replaceRegex patt'' Nothing (const mempty) 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
arg <- Int -> ReaderT Arguments (MP m') Val
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
case 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]
++ [Item [Text]
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
_ ->
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
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
maybe (fail "counter not defined") (pure . VInteger) 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
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 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
newval <- Int -> ReaderT Arguments (MP m') Val
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
(newnum :: Integer) <-
case 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
lift $ updateState $ \EvalState m'
st ->
EvalState m'
st {evalCounters = M.adjust (const newnum) key $ evalCounters st}
pure 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
xs <- ReaderT Arguments (MP m') [Val]
forall (m :: * -> *). Monad m => ReaderT Arguments (MP m) [Val]
allArgs
pure $ VContent $ foldMap valToContent 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
f <- Int -> ReaderT Arguments (MP m') Text
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
let hasField (Elt Identifier
_ Maybe SourcePos
_ Map Identifier Val
fields) = Maybe Val -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Val -> Bool) -> Maybe Val -> Bool
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
f) Map Identifier Val
fields
hasField Content
_ = Bool
False
pure $ VBoolean $ any hasField 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
(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
defval <- namedArg "default" VNone
case F.toList 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
i <- Int -> ReaderT Arguments (MP m') Int
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
pure $ VInteger $ fromMaybe 0 $ listToMaybe $ drop i 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
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
defval <- namedArg "default" VNone
pure $ fromMaybe defval $ v V.!? 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
x <- Int -> ReaderT Arguments (MP m') Val
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
lift $ updateVal $ VArray $ V.snoc v x
pure 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
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
mbcount <- namedArg "count" Nothing
end <- (toPos <$> nthArg 2) `mplus`
pure (maybe (V.length v) (+ start) mbcount)
if V.length v < end
then fail "array contains insufficient elements for slice"
else
if end < start
then pure $ VArray mempty
else pure $ VArray $ V.slice start (end - start) 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
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
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)
pure $ VArray $ V.fromList $ go 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
sep <- Int -> ReaderT Arguments (MP m') Val
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
pure $ VArray . V.fromList . intersperse sep . V.toList $ 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
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
newval <- nthArg 2
if pos >= V.length v || pos < 0
then fail "insert position out of bounds in array"
else do
lift $ updateVal $ VArray $ V.snoc (V.take pos v) newval <> V.drop pos v
pure 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
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 pos >= V.length v || pos < 0
then fail "remove position out of bounds in array"
else do
lift $ updateVal $ VArray $ V.take pos v <> V.drop (pos + 1) v
pure $ fromMaybe VNone $ v V.!? 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
item <- Int -> ReaderT Arguments (MP m') Val
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
pure $ VBoolean $ V.elem item 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 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
Nothing Val
y = do
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 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
res <- foldM go Nothing v
case 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 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 (Left a
i) Val
y = do
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 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
res <- foldM go (Left 0) v
case 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 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
y = do
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 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"
VArray <$> V.filterM predicate 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 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
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}
VArray <$> V.mapM f 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
(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 fn <- nthArg 2
let 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}
lift $ foldM f start $ V.toList v
Text
"reduce" -> 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 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
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}
case V.toList v of
[] -> 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
(Val
x:[Val]
xs) -> 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
x [Val]
xs
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 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
y = do
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 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"
(VBoolean . V.any id) <$> mapM predicate 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 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
y = do
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 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"
(VBoolean . V.all id) <$> mapM predicate 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
separator <- Int -> ReaderT Arguments (MP m') Val
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
lastsep <- namedArg "last" separator
let xs' = Vector Val -> [Val]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Vector Val
v
let 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']
foldM joinVals VNone 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
(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 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
(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 = Vector Val -> Int
forall a. Vector a -> Int
V.length Vector Val
v
pure $ VArray $ V.filter (/= VNone) $
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)))
(V.enumFromTo 0 (len - 1))
Text
"to-dict" -> 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
$
OMap Identifier Val -> Val
VDict (OMap Identifier Val -> Val)
-> ([(Identifier, Val)] -> OMap Identifier Val)
-> [(Identifier, Val)]
-> Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Identifier, Val)] -> OMap Identifier Val
forall k v. Ord k => [(k, v)] -> OMap k v
OM.fromList ([(Identifier, Val)] -> Val)
-> ReaderT Arguments (MP m') [(Identifier, Val)]
-> ReaderT Arguments (MP m') Val
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(Val -> ReaderT Arguments (MP m') (Identifier, Val))
-> [Val] -> ReaderT Arguments (MP m') [(Identifier, 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 -> do
vx <- Val -> ReaderT Arguments (MP m') (Vector Val)
forall a (m :: * -> *).
(FromVal a, MonadPlus m, MonadFail m) =>
Val -> m a
forall (m :: * -> *).
(MonadPlus m, MonadFail m) =>
Val -> m (Vector Val)
fromVal Val
x
case V.toList vx of
[Item [Val]
a,Item [Val]
b] -> do
k <- 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 Item [Val]
Val
a
pure (Identifier k, b)
[Val]
_ -> String -> ReaderT Arguments (MP m') (Identifier, Val)
forall a. String -> ReaderT Arguments (MP m') a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"vector has wrong shape") (Vector Val -> [Val]
forall a. Vector a -> [a]
V.toList Vector Val
v)
Text
"windows" -> 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
(windowsize :: Int) <- Int -> ReaderT Arguments (MP m') Int
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
case V.length v - windowsize of
Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 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
$ Vector Val -> Val
VArray Vector Val
forall a. Monoid a => a
mempty
| Bool
otherwise -> 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
$
(Int -> Val) -> [Int] -> [Val]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
x -> 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
windowsize (Vector Val -> Vector Val) -> Vector Val -> Vector Val
forall a b. (a -> b) -> a -> b
$ Int -> Vector Val -> Vector Val
forall a. Int -> Vector a -> Vector a
V.drop Int
x Vector Val
v) [Int
Item [Int]
0..Int
Item [Int]
n]
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
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 V.uncons 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
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 V.uncons 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
args <- ReaderT Arguments (MP m') Arguments
forall r (m :: * -> *). MonadReader r m => m r
ask
pure $
VFunction mbName scope $
Function $
\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
args <- ReaderT Arguments (MP m') Arguments
forall r (m :: * -> *). MonadReader r m => m r
ask
case 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
(other :: Selector) <- Int -> ReaderT Arguments (MP m') Selector
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
pure $ VSelector $ SelectOr other 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
(other :: Selector) <- Int -> ReaderT Arguments (MP m') Selector
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
pure $ VSelector $ SelectAnd other 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
(other :: Selector) <- Int -> ReaderT Arguments (MP m') Selector
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
pure $ VSelector $ SelectBefore other 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
(other :: Selector) <- Int -> ReaderT Arguments (MP m') Selector
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
pure $ VSelector $ SelectAfter other 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
"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
(x :: Val) <- Int -> ReaderT Arguments (MP m') Val
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
defval <- namedArg "default" VNone
case x of
VInteger{} -> do
i <- Val -> ReaderT Arguments (MP m') Int
forall a (m :: * -> *).
(FromVal a, MonadPlus m, MonadFail m) =>
Val -> m a
forall (m :: * -> *). (MonadPlus m, MonadFail m) => Val -> m Int
fromVal Val
x
case positional args of
[Val]
xs | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [Val] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Val]
xs -> 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]
xs [Val] -> Int -> Val
forall a. HasCallStack => [a] -> Int -> a
!! Int
i
| Bool
otherwise -> 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
VString Text
t ->
case Identifier -> OMap Identifier Val -> Maybe Val
forall k v. Ord k => k -> OMap k v -> Maybe v
OM.lookup (Text -> Identifier
Identifier Text
t) (Arguments -> OMap Identifier Val
named Arguments
args) of
Just Val
a -> Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
a
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
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
defval
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
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
mbformat <- case 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
pure $ VString $ T.pack $
case (mbdate, 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)
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)
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)
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
""
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 u (m :: * -> *) a. 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
'['
name <- ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. 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
spaces
modifiers <- many pModifier
void $ char ']'
pure $ Variable name modifiers
pModifier :: Parser (String, String)
pModifier :: ParsecT String () Identity (String, String)
pModifier = do
name <- ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. 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
void $ char ':'
spaces
val <- many1 alphaNum
spaces
pure (name, val)
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