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

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

import Control.Monad (MonadPlus (mplus), foldM)
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)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Vector as V
import Text.Parsec (getState, runParserT, updateState)
import Typst.Module.Standard (standardModule)
import Typst.Regex
  ( RE (..),
    RegexMatch (..),
    extract,
    makeRE,
    match,
    matchAll,
    replaceRegex,
    splitRegex,
  )
import Typst.Types
import Typst.Util (allArgs, makeFunction, namedArg, nthArg)

-- import Debug.Trace

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

pairToArray :: (Val, Val) -> Val
pairToArray :: (Val, Val) -> Val
pairToArray (Val
x, Val
y) = Vector Val -> Val
VArray forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Vector a
V.fromList [Val
x, Val
y]

applyPureFunction :: Function -> [Val] -> Attempt Val
applyPureFunction :: Function -> [Val] -> Attempt Val
applyPureFunction (Function forall (m :: * -> *). Monad m => Arguments -> MP m Val
f) [Val]
vals =
  let args :: Arguments
args = [Val] -> OMap Identifier Val -> Arguments
Arguments [Val]
vals forall k v. OMap k v
OM.empty
   in case forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> u -> String -> s -> m (Either ParseError a)
runParserT (forall (m :: * -> *). Monad m => Arguments -> MP m Val
f Arguments
args) forall (m :: * -> *). MonadFail m => EvalState m
initialEvalState String
"" [] of
        Failure String
s -> forall a. String -> Attempt a
Failure String
s
        Success (Left ParseError
s) -> forall a. String -> Attempt a
Failure forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show ParseError
s
        Success (Right Val
v) -> forall a. a -> Attempt a
Success Val
v

initialEvalState :: MonadFail m => EvalState m
initialEvalState :: forall (m :: * -> *). MonadFail m => EvalState m
initialEvalState =
  forall (m :: * -> *). EvalState m
emptyEvalState { evalIdentifiers :: [(Scope, Map Identifier Val)]
evalIdentifiers = [(Scope
BlockScope, Map Identifier Val
standardModule)] }

formatNumber :: Text -> Int -> Text
formatNumber :: Text -> Int -> Text
formatNumber Text
t Int
n = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap Char -> Text
go forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
t
  where
    go :: Char -> Text
go Char
'1' | Int
n forall a. Ord a => a -> a -> Bool
>= Int
0 = String -> Text
T.pack (forall a. Show a => a -> String
show Int
n)
    go Char
'a' | Int
n forall a. Ord a => a -> a -> Bool
>= Int
1 = Char -> Text
T.singleton forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
cycle [Char
'a' .. Char
'z'] forall a. [a] -> Int -> a
!! (Int
n forall a. Num a => a -> a -> a
- Int
1 forall a. Integral a => a -> a -> a
`mod` Int
26)
    go Char
'A' | Int
n forall a. Ord a => a -> a -> Bool
>= Int
1 = Char -> Text
T.singleton forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
cycle [Char
'A' .. Char
'Z'] forall a. [a] -> Int -> a
!! (Int
n forall a. Num a => a -> a -> a
- Int
1 forall a. Integral a => a -> a -> a
`mod` Int
26)
    go Char
'i' | Int
n forall a. Ord a => a -> a -> Bool
>= Int
1 = Text -> Text
T.toLower forall a b. (a -> b) -> a -> b
$ Int -> Text
toRomanNumeral Int
n
    go Char
'I' | Int
n forall a. Ord a => a -> a -> Bool
>= Int
1 = Int -> Text
toRomanNumeral Int
n
    go Char
'い' | Int
n forall a. Ord a => a -> a -> Bool
>= Int
1 = String -> Text
T.pack (forall a. Show a => a -> String
show Int
n) -- TODO
    go Char
'イ' | Int
n forall a. Ord a => a -> a -> Bool
>= Int
1 = String -> Text
T.pack (forall a. Show a => a -> String
show Int
n) -- TODO
    go Char
'א' | Int
n forall a. Ord a => a -> a -> Bool
>= Int
1 = String -> Text
T.pack (forall a. Show a => a -> String
show Int
n) -- TODO
    go Char
'*'
      | Int
n forall a. Ord a => a -> a -> Bool
>= Int
1 =
          Char -> Text
T.singleton forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
cycle [Char
'*', Char
'†', Char
'‡', Char
'§', Char
'¶', Char
'‖'] forall a. [a] -> Int -> a
!! (Int
n forall a. Num a => a -> a -> a
- Int
1 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 forall a. Ord a => a -> a -> Bool
>= Int
4000 Bool -> Bool -> Bool
|| Int
x forall a. Ord a => a -> a -> Bool
< Int
0 = Text
"?"
  | Int
x forall a. Ord a => a -> a -> Bool
>= Int
1000 = Text
"M" forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x forall a. Num a => a -> a -> a
- Int
1000)
  | Int
x forall a. Ord a => a -> a -> Bool
>= Int
900 = Text
"CM" forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x forall a. Num a => a -> a -> a
- Int
900)
  | Int
x forall a. Ord a => a -> a -> Bool
>= Int
500 = Text
"D" forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x forall a. Num a => a -> a -> a
- Int
500)
  | Int
x forall a. Ord a => a -> a -> Bool
>= Int
400 = Text
"CD" forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x forall a. Num a => a -> a -> a
- Int
400)
  | Int
x forall a. Ord a => a -> a -> Bool
>= Int
100 = Text
"C" forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x forall a. Num a => a -> a -> a
- Int
100)
  | Int
x forall a. Ord a => a -> a -> Bool
>= Int
90 = Text
"XC" forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x forall a. Num a => a -> a -> a
- Int
90)
  | Int
x forall a. Ord a => a -> a -> Bool
>= Int
50 = Text
"L" forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x forall a. Num a => a -> a -> a
- Int
50)
  | Int
x forall a. Ord a => a -> a -> Bool
>= Int
40 = Text
"XL" forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x forall a. Num a => a -> a -> a
- Int
40)
  | Int
x forall a. Ord a => a -> a -> Bool
>= Int
10 = Text
"X" forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x forall a. Num a => a -> a -> a
- Int
10)
  | Int
x forall a. Eq a => a -> a -> Bool
== Int
9 = Text
"IX"
  | Int
x forall a. Ord a => a -> a -> Bool
>= Int
5 = Text
"V" forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x forall a. Num a => a -> a -> a
- Int
5)
  | Int
x forall a. Eq a => a -> a -> Bool
== Int
4 = Text
"IV"
  | Int
x forall a. Ord a => a -> a -> Bool
>= Int
1 = Text
"I" forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x forall a. Num a => a -> a -> a
- Int
1)
  | Bool
otherwise = Text
""