{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Typst.Module.Standard
  ( standardModule,
    loadFileText,
    applyPureFunction
  )
where

import Data.Char (ord, chr)
import Control.Applicative ((<|>))
import Control.Monad (mplus, unless)
import Control.Monad.Reader (lift)
import qualified Data.Aeson as Aeson
import qualified Data.ByteString.Lazy as BL
import qualified Data.Csv as Csv
import qualified Data.Map as M
import qualified Data.Map.Ordered as OM
import Data.Maybe (mapMaybe)
import Data.Ratio ((%))
import qualified Data.Sequence as Seq
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified Data.Vector as V
import qualified Data.Yaml as Yaml
import Text.Parsec (getPosition, getState, updateState, runParserT)
import Text.Read (readMaybe)
import qualified Text.XML as XML
import Typst.Emoji (typstEmojis)
import Typst.Module.Calc (calcModule)
import Typst.Module.Math (mathModule)
import Typst.Regex (makeRE)
import Typst.Symbols (typstSymbols)
import Typst.Types
import Typst.Util
import Data.Time (UTCTime(..))
import Data.Time.Calendar (fromGregorianValid)
import Data.Time.Clock (secondsToDiffTime)
import Data.Digits (mDigits)

standardModule :: M.Map Identifier Val
standardModule :: Map Identifier Val
standardModule =
  forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$
    [ (Identifier
"math", Identifier -> Map Identifier Val -> Val
VModule Identifier
"math" Map Identifier Val
mathModule),
      (Identifier
"sym", Identifier -> Map Identifier Val -> Val
VModule Identifier
"sym" Map Identifier Val
symModule),
      (Identifier
"emoji", Identifier -> Map Identifier Val -> Val
VModule Identifier
"emoji" Map Identifier Val
emojiModule),
      (Identifier
"calc", Identifier -> Map Identifier Val -> Val
VModule Identifier
"calc" Map Identifier Val
calcModule)
    ]
      forall a. [a] -> [a] -> [a]
++ [(Identifier, Val)]
colors
      forall a. [a] -> [a] -> [a]
++ [(Identifier, Val)]
directions
      forall a. [a] -> [a] -> [a]
++ [(Identifier, Val)]
alignments
      forall a. [a] -> [a] -> [a]
++ [(Identifier, Val)]
textual
      forall a. [a] -> [a] -> [a]
++ [(Identifier, Val)]
layout
      forall a. [a] -> [a] -> [a]
++ [(Identifier, Val)]
visualize
      forall a. [a] -> [a] -> [a]
++ [(Identifier, Val)]
meta
      forall a. [a] -> [a] -> [a]
++ [(Identifier, Val)]
foundations
      forall a. [a] -> [a] -> [a]
++ [(Identifier, Val)]
construct
      forall a. [a] -> [a] -> [a]
++ [(Identifier, Val)]
time
      forall a. [a] -> [a] -> [a]
++ [(Identifier, Val)]
dataLoading

symModule :: M.Map Identifier Val
symModule :: Map Identifier Val
symModule = forall a b k. (a -> b) -> Map k a -> Map k b
M.map Symbol -> Val
VSymbol forall a b. (a -> b) -> a -> b
$ [(Text, Bool, Text)] -> Map Identifier Symbol
makeSymbolMap [(Text, Bool, Text)]
typstSymbols

emojiModule :: M.Map Identifier Val
emojiModule :: Map Identifier Val
emojiModule = forall a b k. (a -> b) -> Map k a -> Map k b
M.map Symbol -> Val
VSymbol forall a b. (a -> b) -> a -> b
$ [(Text, Bool, Text)] -> Map Identifier Symbol
makeSymbolMap [(Text, Bool, Text)]
typstEmojis

textual :: [(Identifier, Val)]
textual :: [(Identifier, Val)]
textual =
  [ Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement
      forall a. Maybe a
Nothing
      Identifier
"text"
      [ (Identifier
"color", ValType -> TypeSpec
One ValType
TColor),
        (Identifier
"size", ValType -> TypeSpec
One ValType
TLength),
        (Identifier
"body", ValType -> TypeSpec
One (ValType
TContent ValType -> ValType -> ValType
:|: ValType
TString ValType -> ValType -> ValType
:|: ValType
TSymbol))
      ],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement forall a. Maybe a
Nothing Identifier
"emph" [(Identifier
"body", ValType -> TypeSpec
One ValType
TContent)],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement forall a. Maybe a
Nothing Identifier
"linebreak" [],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement forall a. Maybe a
Nothing Identifier
"strong" [(Identifier
"body", ValType -> TypeSpec
One ValType
TContent)],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement forall a. Maybe a
Nothing Identifier
"sub" [(Identifier
"body", ValType -> TypeSpec
One ValType
TContent)],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement forall a. Maybe a
Nothing Identifier
"super" [(Identifier
"body", ValType -> TypeSpec
One ValType
TContent)],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement forall a. Maybe a
Nothing Identifier
"strike" [(Identifier
"body", ValType -> TypeSpec
One ValType
TContent)],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement forall a. Maybe a
Nothing Identifier
"smallcaps" [(Identifier
"body", ValType -> TypeSpec
One ValType
TContent)],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement forall a. Maybe a
Nothing Identifier
"underline" [(Identifier
"body", ValType -> TypeSpec
One ValType
TContent)],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement forall a. Maybe a
Nothing Identifier
"overline" [(Identifier
"body", ValType -> TypeSpec
One ValType
TContent)],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement forall a. Maybe a
Nothing Identifier
"raw" [(Identifier
"text", ValType -> TypeSpec
One ValType
TString)],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement forall a. Maybe a
Nothing Identifier
"smartquote" [],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement forall a. Maybe a
Nothing Identifier
"lower" [(Identifier
"text", ValType -> TypeSpec
One (ValType
TString ValType -> ValType -> ValType
:|: ValType
TContent))],
    ( Identifier
"lower",
      (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction forall a b. (a -> b) -> a -> b
$ do
        Val
val <- forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
        case Val
val of
          VString Text
t -> 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
$ Text -> Text
T.toLower Text
t
          VContent Seq Content
cs -> do
            SourcePos
pos <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Seq Content -> Val
VContent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Seq a
Seq.singleton forall a b. (a -> b) -> a -> b
$ Identifier -> Maybe SourcePos -> Map Identifier Val -> Content
Elt Identifier
"lower" (forall a. a -> Maybe a
Just SourcePos
pos) [(Identifier
"text", Seq Content -> Val
VContent Seq Content
cs)]
          Val
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"argument must be string or content"
    ),
    ( Identifier
"upper",
      (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction forall a b. (a -> b) -> a -> b
$ do
        Val
val <- forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
        case Val
val of
          VString Text
t -> 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
$ Text -> Text
T.toUpper Text
t
          VContent Seq Content
cs -> do
            SourcePos
pos <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Seq Content -> Val
VContent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Seq a
Seq.singleton forall a b. (a -> b) -> a -> b
$ Identifier -> Maybe SourcePos -> Map Identifier Val -> Content
Elt Identifier
"upper" (forall a. a -> Maybe a
Just SourcePos
pos) [(Identifier
"text", Seq Content -> Val
VContent Seq Content
cs)]
          Val
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"argument must be string or content"
    )
  ]

layout :: [(Identifier, Val)]
layout :: [(Identifier, Val)]
layout =
  [ Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement
      forall a. Maybe a
Nothing
      Identifier
"align"
      [ (Identifier
"alignment", ValType -> TypeSpec
One ValType
TAlignment),
        (Identifier
"body", ValType -> TypeSpec
One ValType
TContent)
      ],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement forall a. Maybe a
Nothing Identifier
"block" [(Identifier
"body", ValType -> TypeSpec
One ValType
TContent)],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement forall a. Maybe a
Nothing Identifier
"box" [(Identifier
"body", ValType -> TypeSpec
One ValType
TContent)],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement forall a. Maybe a
Nothing Identifier
"colbreak" [],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement forall a. Maybe a
Nothing Identifier
"columns" [(Identifier
"count", ValType -> TypeSpec
One ValType
TInteger), (Identifier
"body", ValType -> TypeSpec
One ValType
TContent)],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement forall a. Maybe a
Nothing Identifier
"grid" [(Identifier
"children", ValType -> TypeSpec
Many ValType
TContent)],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement forall a. Maybe a
Nothing Identifier
"h" [(Identifier
"amount", ValType -> TypeSpec
One (ValType
TLength ValType -> ValType -> ValType
:|: ValType
TRatio ValType -> ValType -> ValType
:|: ValType
TFraction))],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement forall a. Maybe a
Nothing Identifier
"v" [(Identifier
"amount", ValType -> TypeSpec
One (ValType
TLength ValType -> ValType -> ValType
:|: ValType
TRatio ValType -> ValType -> ValType
:|: ValType
TFraction))],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement forall a. Maybe a
Nothing Identifier
"hide" [(Identifier
"body", ValType -> TypeSpec
One ValType
TContent)],
    Maybe Identifier
-> Identifier
-> [(Identifier, TypeSpec)]
-> Map Identifier Val
-> (Identifier, Val)
makeElementWithScope
      forall a. Maybe a
Nothing
      Identifier
"enum"
      [(Identifier
"children", ValType -> TypeSpec
Many ValType
TContent)]
      [ Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement
          (forall a. a -> Maybe a
Just Identifier
"enum")
          Identifier
"item"
          [ (Identifier
"number", ValType -> TypeSpec
One (ValType
TInteger ValType -> ValType -> ValType
:|: ValType
TNone)),
            (Identifier
"body", ValType -> TypeSpec
One ValType
TContent)
          ]
      ],
    Maybe Identifier
-> Identifier
-> [(Identifier, TypeSpec)]
-> Map Identifier Val
-> (Identifier, Val)
makeElementWithScope
      forall a. Maybe a
Nothing
      Identifier
"list"
      [(Identifier
"children", ValType -> TypeSpec
Many ValType
TContent)]
      [Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement (forall a. a -> Maybe a
Just Identifier
"list") Identifier
"item" [(Identifier
"body", ValType -> TypeSpec
One ValType
TContent)]],
    -- for "measure" see below
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement forall a. Maybe a
Nothing Identifier
"move" [(Identifier
"body", ValType -> TypeSpec
One ValType
TContent)],
    -- the fact that pad can take a positional param for a length (= rest) is undocumented!
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement forall a. Maybe a
Nothing Identifier
"pad" [(Identifier
"rest", ValType -> TypeSpec
One (ValType
TLength ValType -> ValType -> ValType
:|: ValType
TRatio ValType -> ValType -> ValType
:|: ValType
TNone)), (Identifier
"body", ValType -> TypeSpec
One ValType
TContent)],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement forall a. Maybe a
Nothing Identifier
"page" [(Identifier
"body", ValType -> TypeSpec
One ValType
TContent)],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement forall a. Maybe a
Nothing Identifier
"pagebreak" [],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement forall a. Maybe a
Nothing Identifier
"par" [(Identifier
"body", ValType -> TypeSpec
One ValType
TContent)],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement forall a. Maybe a
Nothing Identifier
"parbreak" [],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement forall a. Maybe a
Nothing Identifier
"place" [(Identifier
"alignment", ValType -> TypeSpec
One (ValType
TAlignment ValType -> ValType -> ValType
:|: ValType
TNone)), (Identifier
"body", ValType -> TypeSpec
One ValType
TContent)],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement forall a. Maybe a
Nothing Identifier
"repeat" [(Identifier
"body", ValType -> TypeSpec
One ValType
TContent)],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement forall a. Maybe a
Nothing Identifier
"rotate" [(Identifier
"angle", ValType -> TypeSpec
One ValType
TAngle), (Identifier
"body", ValType -> TypeSpec
One ValType
TContent)],
    -- the fact that scale can take a positional factor is undocumented!
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement forall a. Maybe a
Nothing Identifier
"scale" [(Identifier
"factor", ValType -> TypeSpec
One (ValType
TRatio ValType -> ValType -> ValType
:|: ValType
TNone)), (Identifier
"body", ValType -> TypeSpec
One ValType
TContent)],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement
      forall a. Maybe a
Nothing
      Identifier
"stack"
      [(Identifier
"children", ValType -> TypeSpec
Many (ValType
TLength ValType -> ValType -> ValType
:|: ValType
TRatio ValType -> ValType -> ValType
:|: ValType
TFraction ValType -> ValType -> ValType
:|: ValType
TContent))],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement forall a. Maybe a
Nothing Identifier
"table" [(Identifier
"children", ValType -> TypeSpec
Many ValType
TContent)],
    Maybe Identifier
-> Identifier
-> [(Identifier, TypeSpec)]
-> Map Identifier Val
-> (Identifier, Val)
makeElementWithScope
      forall a. Maybe a
Nothing
      Identifier
"terms"
      [(Identifier
"children", ValType -> TypeSpec
Many ValType
TTermItem)]
      [ Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement
          (forall a. a -> Maybe a
Just Identifier
"terms")
          Identifier
"item"
          [ (Identifier
"term", ValType -> TypeSpec
One ValType
TContent),
            (Identifier
"description", ValType -> TypeSpec
One ValType
TContent)
          ]
      ],
    ( Identifier
"measure",
      (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction forall a b. (a -> b) -> a -> b
$ do
        -- content <- nthArg 1
        -- styles <- nthArg 2
        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
"width", Length -> Val
VLength (Double -> LUnit -> Length
LExact Double
1.0 LUnit
LEm)),
                (Identifier
"height", Length -> Val
VLength (Double -> LUnit -> Length
LExact Double
1.0 LUnit
LEm))
              ]
    )
    -- these are fake widths so we don't crash...
  ]

visualize :: [(Identifier, Val)]
visualize :: [(Identifier, Val)]
visualize =
  [ Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement forall a. Maybe a
Nothing Identifier
"circle" [(Identifier
"body", ValType -> TypeSpec
One (ValType
TContent ValType -> ValType -> ValType
:|: ValType
TNone))],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement forall a. Maybe a
Nothing Identifier
"ellipse" [(Identifier
"body", ValType -> TypeSpec
One (ValType
TContent ValType -> ValType -> ValType
:|: ValType
TNone))],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement forall a. Maybe a
Nothing Identifier
"image" [(Identifier
"path", ValType -> TypeSpec
One ValType
TString)],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement forall a. Maybe a
Nothing Identifier
"line" [],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement forall a. Maybe a
Nothing Identifier
"path" [(Identifier
"vertices", ValType -> TypeSpec
Many ValType
TArray)],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement forall a. Maybe a
Nothing Identifier
"polygon" [(Identifier
"vertices", ValType -> TypeSpec
Many ValType
TArray)],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement forall a. Maybe a
Nothing Identifier
"rect" [(Identifier
"body", ValType -> TypeSpec
One (ValType
TContent ValType -> ValType -> ValType
:|: ValType
TNone))],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement forall a. Maybe a
Nothing Identifier
"square" [(Identifier
"body", ValType -> TypeSpec
One (ValType
TContent ValType -> ValType -> ValType
:|: ValType
TNone))]
  ]

meta :: [(Identifier, Val)]
meta :: [(Identifier, Val)]
meta =
  [ Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement forall a. Maybe a
Nothing Identifier
"bibliography" [(Identifier
"path", ValType -> TypeSpec
One (ValType
TString ValType -> ValType -> ValType
:|: ValType
TArray))],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement
      forall a. Maybe a
Nothing
      Identifier
"cite"
      [ (Identifier
"keys", ValType -> TypeSpec
Many ValType
TString),
        (Identifier
"supplement", ValType -> TypeSpec
One (ValType
TContent ValType -> ValType -> ValType
:|: ValType
TNone))
      ],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement forall a. Maybe a
Nothing Identifier
"document" [],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement forall a. Maybe a
Nothing Identifier
"figure" [(Identifier
"body", ValType -> TypeSpec
One ValType
TContent)],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement forall a. Maybe a
Nothing Identifier
"heading" [(Identifier
"body", ValType -> TypeSpec
One ValType
TContent)],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement forall a. Maybe a
Nothing Identifier
"layout" [(Identifier
"func", ValType -> TypeSpec
One ValType
TFunction)],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement
      forall a. Maybe a
Nothing
      Identifier
"link"
      [ (Identifier
"dest", ValType -> TypeSpec
One (ValType
TString ValType -> ValType -> ValType
:|: ValType
TLabel ValType -> ValType -> ValType
:|: ValType
TDict ValType -> ValType -> ValType
:|: ValType
TLocation)),
        (Identifier
"body", ValType -> TypeSpec
One ValType
TContent)
      ],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement forall a. Maybe a
Nothing Identifier
"locate" [(Identifier
"func", ValType -> TypeSpec
One ValType
TFunction)],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement
      forall a. Maybe a
Nothing
      Identifier
"numbering"
      [ (Identifier
"numbering", ValType -> TypeSpec
One (ValType
TString ValType -> ValType -> ValType
:|: ValType
TFunction)),
        (Identifier
"numbers", ValType -> TypeSpec
Many ValType
TInteger)
      ],
    Maybe Identifier
-> Identifier
-> [(Identifier, TypeSpec)]
-> Map Identifier Val
-> (Identifier, Val)
makeElementWithScope forall a. Maybe a
Nothing Identifier
"outline"
      []
      [Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement (forall a. a -> Maybe a
Just Identifier
"outline") Identifier
"entry"
        [(Identifier
"level", ValType -> TypeSpec
One ValType
TInteger),
         (Identifier
"element", ValType -> TypeSpec
One ValType
TContent),
         (Identifier
"body", ValType -> TypeSpec
One ValType
TContent),
         (Identifier
"fill", ValType -> TypeSpec
One (ValType
TContent ValType -> ValType -> ValType
:|: ValType
TNone)),
         (Identifier
"page", ValType -> TypeSpec
One ValType
TContent)]],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement
      forall a. Maybe a
Nothing
      Identifier
"query"
      [ (Identifier
"target", ValType -> TypeSpec
One (ValType
TLabel ValType -> ValType -> ValType
:|: ValType
TFunction)),
        (Identifier
"location", ValType -> TypeSpec
One ValType
TLocation)
      ],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement forall a. Maybe a
Nothing Identifier
"ref" [(Identifier
"target", ValType -> TypeSpec
One ValType
TLabel)],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement forall a. Maybe a
Nothing Identifier
"state" [(Identifier
"key", ValType -> TypeSpec
One ValType
TString), (Identifier
"init", ValType -> TypeSpec
One ValType
TAny)],
    Maybe Identifier
-> Identifier
-> [(Identifier, TypeSpec)]
-> Map Identifier Val
-> (Identifier, Val)
makeElementWithScope
      forall a. Maybe a
Nothing
      Identifier
"footnote"
      [(Identifier
"body", ValType -> TypeSpec
One ValType
TContent)]
      [Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement (forall a. a -> Maybe a
Just Identifier
"footnote") Identifier
"entry" [(Identifier
"note", ValType -> TypeSpec
One ValType
TContent)]],
    (Identifier
"style", (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
f <- forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
        case Function -> [Val] -> Attempt Val
applyPureFunction ((forall (m :: * -> *). Monad m => Arguments -> MP m Val)
-> Function
Function forall (m :: * -> *). Monad m => Arguments -> MP m Val
f) [Val
VStyles] of
          Success Val
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
x
          Failure String
e -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e)
  ]

colors :: [(Identifier, Val)]
colors :: [(Identifier, Val)]
colors =
  [ (Identifier
"red", Color -> Val
VColor forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational -> Rational -> Color
RGB (Integer
0xff forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x41 forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x36 forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) Rational
1),
    (Identifier
"blue", Color -> Val
VColor forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational -> Rational -> Color
RGB (Integer
0x00 forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x74 forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0xd9 forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) Rational
1),
    (Identifier
"black", Color -> Val
VColor forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational -> Rational -> Color
RGB (Integer
0x00 forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x00 forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x00 forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) Rational
1),
    (Identifier
"gray", Color -> Val
VColor forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational -> Rational -> Color
RGB (Integer
0xaa forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0xaa forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0xaa forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) Rational
1),
    (Identifier
"silver", Color -> Val
VColor forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational -> Rational -> Color
RGB (Integer
0xdd forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0xdd forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0xdd forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) Rational
1),
    (Identifier
"white", Color -> Val
VColor forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational -> Rational -> Color
RGB (Integer
0xff forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0xff forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0xff forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) Rational
1),
    (Identifier
"navy", Color -> Val
VColor forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational -> Rational -> Color
RGB (Integer
0x00 forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x1f forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x3f forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) Rational
1),
    (Identifier
"aqua", Color -> Val
VColor forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational -> Rational -> Color
RGB (Integer
0x7f forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0xdb forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0xff forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) Rational
1),
    (Identifier
"teal", Color -> Val
VColor forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational -> Rational -> Color
RGB (Integer
0x39 forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0xcc forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0xcc forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) Rational
1),
    (Identifier
"eastern", Color -> Val
VColor forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational -> Rational -> Color
RGB (Integer
0x23 forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x9d forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0xad forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) Rational
1),
    (Identifier
"purple", Color -> Val
VColor forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational -> Rational -> Color
RGB (Integer
0xb1 forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x0d forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0xc9 forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) Rational
1),
    (Identifier
"fuchsia", Color -> Val
VColor forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational -> Rational -> Color
RGB (Integer
0xf0 forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x12 forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0xbe forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) Rational
1),
    (Identifier
"maroon", Color -> Val
VColor forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational -> Rational -> Color
RGB (Integer
0x85 forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x14 forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x4b forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) Rational
1),
    (Identifier
"yellow", Color -> Val
VColor forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational -> Rational -> Color
RGB (Integer
0xff forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0xdc forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x00 forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) Rational
1),
    (Identifier
"orange", Color -> Val
VColor forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational -> Rational -> Color
RGB (Integer
0xff forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x85 forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x1b forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) Rational
1),
    (Identifier
"olive", Color -> Val
VColor forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational -> Rational -> Color
RGB (Integer
0x3d forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x99 forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x70 forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) Rational
1),
    (Identifier
"green", Color -> Val
VColor forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational -> Rational -> Color
RGB (Integer
0x2e forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0xcc forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x40 forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) Rational
1),
    (Identifier
"lime", Color -> Val
VColor forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational -> Rational -> Color
RGB (Integer
0x01 forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0xff forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x70 forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) Rational
1)
  ]

directions :: [(Identifier, Val)]
directions :: [(Identifier, Val)]
directions =
  [ (Identifier
"ltr", Direction -> Val
VDirection Direction
Ltr),
    (Identifier
"rtl", Direction -> Val
VDirection Direction
Rtl),
    (Identifier
"ttb", Direction -> Val
VDirection Direction
Ttb),
    (Identifier
"btt", Direction -> Val
VDirection Direction
Btt)
  ]

alignments :: [(Identifier, Val)]
alignments :: [(Identifier, Val)]
alignments =
  [ (Identifier
"start", Maybe Horiz -> Maybe Vert -> Val
VAlignment (forall a. a -> Maybe a
Just Horiz
HorizStart) forall a. Maybe a
Nothing),
    (Identifier
"end", Maybe Horiz -> Maybe Vert -> Val
VAlignment (forall a. a -> Maybe a
Just Horiz
HorizEnd) forall a. Maybe a
Nothing),
    (Identifier
"left", Maybe Horiz -> Maybe Vert -> Val
VAlignment (forall a. a -> Maybe a
Just Horiz
HorizLeft) forall a. Maybe a
Nothing),
    (Identifier
"center", Maybe Horiz -> Maybe Vert -> Val
VAlignment (forall a. a -> Maybe a
Just Horiz
HorizCenter) forall a. Maybe a
Nothing),
    (Identifier
"right", Maybe Horiz -> Maybe Vert -> Val
VAlignment (forall a. a -> Maybe a
Just Horiz
HorizRight) forall a. Maybe a
Nothing),
    (Identifier
"top", Maybe Horiz -> Maybe Vert -> Val
VAlignment forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just Vert
VertTop)),
    (Identifier
"horizon", Maybe Horiz -> Maybe Vert -> Val
VAlignment forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just Vert
VertHorizon)),
    (Identifier
"bottom", Maybe Horiz -> Maybe Vert -> Val
VAlignment forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just Vert
VertBottom))
  ]

foundations :: [(Identifier, Val)]
foundations :: [(Identifier, Val)]
foundations =
  [ ( Identifier
"assert",
      (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Map Identifier Val -> Val
makeFunctionWithScope
        ( do
            (Bool
cond :: Bool) <- forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
cond forall a b. (a -> b) -> a -> b
$ do
              (String
msg :: String) <- forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Identifier -> a -> ReaderT Arguments (MP m) a
namedArg Identifier
"message" String
"Assertion failed"
              forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
msg
            forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
VNone
        )
        [ ( Identifier
"eq",
            (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction forall a b. (a -> b) -> a -> b
$ do
              (Val
v1 :: Val) <- forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
              (Val
v2 :: Val) <- forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
2
              forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall a. Compare a => a -> a -> Maybe Ordering
comp Val
v1 Val
v2 forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Ordering
EQ) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Assertion failed"
              forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
VNone
          ),
          ( Identifier
"ne",
            (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction forall a b. (a -> b) -> a -> b
$ do
              (Val
v1 :: Val) <- forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
              (Val
v2 :: Val) <- forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
2
              forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall a. Compare a => a -> a -> Maybe Ordering
comp Val
v1 Val
v2 forall a. Eq a => a -> a -> Bool
/= forall a. a -> Maybe a
Just Ordering
EQ) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Assertion failed"
              forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
VNone
          )
        ]
    ),
    (Identifier
"panic", (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Monad m => ReaderT Arguments (MP m) [Val]
allArgs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                 ((Text
"panicked with: " forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Val -> Text
repr)),
    (Identifier
"repr", (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Val
VString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Val -> Text
repr),
    ( Identifier
"type",
      (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction forall a b. (a -> b) -> a -> b
$ do
        (Val
x :: Val) <- 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
$
            case Val -> ValType
valType Val
x of
              ValType
TAlignment ->
                case Val
x of
                  VAlignment (Just Horiz
_) (Just Vert
_) -> Text
"2d alignment"
                  Val
_ -> Text
"alignment"
              ValType
TDict -> Text
"dictionary"
              ValType
ty -> Text -> Text
T.toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
T.drop Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ ValType
ty
    )
  ]

construct :: [(Identifier, Val)]
construct :: [(Identifier, Val)]
construct =
  [ ( Identifier
"cmyk",
      (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction forall a b. (a -> b) -> a -> b
$
        Color -> Val
VColor forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Rational -> Rational -> Rational -> Rational -> Color
CMYK 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 b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
2 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
3 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
4)
    ),
    (Identifier
"float", (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction forall a b. (a -> b) -> a -> b
$ Double -> Val
VFloat 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),
    (Identifier
"int", (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction forall a b. (a -> b) -> a -> b
$ Integer -> Val
VInteger 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),
    (Identifier
"label", (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction forall a b. (a -> b) -> a -> b
$ Text -> Val
VLabel 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),
    ( Identifier
"counter",
      (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction forall a b. (a -> b) -> a -> b
$ do
        (Counter
counter :: Counter) <- forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
        let initializeIfMissing :: Maybe a -> Maybe a
initializeIfMissing Maybe a
Nothing = forall a. a -> Maybe a
Just a
0
            initializeIfMissing (Just a
x) = forall a. a -> Maybe a
Just a
x
        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 =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter forall {a}. Num a => Maybe a -> Maybe a
initializeIfMissing Counter
counter 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 forall a b. (a -> b) -> a -> b
$ Counter -> Val
VCounter Counter
counter
    ),
    (Identifier
"luma", (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction forall a b. (a -> b) -> a -> b
$ Color -> Val
VColor forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Rational -> Color
Luma 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)),
    ( Identifier
"range",
      (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction forall a b. (a -> b) -> a -> b
$ do
        Integer
first <- forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
        Maybe Integer
mbsecond <- forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
2
        Integer
step <- forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Identifier -> a -> ReaderT Arguments (MP m) a
namedArg Identifier
"step" Integer
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. [a] -> Vector a
V.fromList forall a b. (a -> b) -> a -> b
$
              forall a b. (a -> b) -> [a] -> [b]
map Integer -> Val
VInteger forall a b. (a -> b) -> a -> b
$
                case (Integer
first, Maybe Integer
mbsecond) of
                  (Integer
end, Maybe Integer
Nothing) -> forall a. Enum a => a -> a -> a -> [a]
enumFromThenTo Integer
0 Integer
step (Integer
end forall a. Num a => a -> a -> a
- Integer
1)
                  (Integer
start, Just Integer
end) ->
                    forall a. Enum a => a -> a -> a -> [a]
enumFromThenTo
                      Integer
start
                      (Integer
start forall a. Num a => a -> a -> a
+ Integer
step)
                      ( if Integer
start forall a. Ord a => a -> a -> Bool
< Integer
end
                          then Integer
end forall a. Num a => a -> a -> a
- Integer
1
                          else Integer
end forall a. Num a => a -> a -> a
+ Integer
1
                      )
    ),
    (Identifier
"regex", (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction forall a b. (a -> b) -> a -> b
$ RE -> Val
VRegex 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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *). MonadFail m => Text -> m RE
makeRE)),
    ( Identifier
"rgb",
      (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction forall a b. (a -> b) -> a -> b
$
        Color -> Val
VColor
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( ( Rational -> Rational -> Rational -> Rational -> Color
RGB
                    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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *). MonadFail m => Val -> m Rational
toRatio)
                    forall (f :: * -> *) a b. Applicative f => 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 b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *). MonadFail m => Val -> m Rational
toRatio)
                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
3 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *). MonadFail m => Val -> m Rational
toRatio)
                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
4 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *). MonadFail m => Val -> m Rational
toRatio) forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` forall (f :: * -> *) a. Applicative f => a -> f a
pure Rational
1.0)
                )
                  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *). MonadFail m => Val -> m Color
hexToRGB)
              )
    ),
    ( Identifier
"str",
      (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Map Identifier Val -> Val
makeFunctionWithScope
      (do
        Val
val <- forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
        Integer
base <- forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Identifier -> a -> ReaderT Arguments (MP m) a
namedArg Identifier
"base" (Integer
10 :: Integer)
        let digitVector :: V.Vector Char
            digitVector :: Vector Char
digitVector = forall a. [a] -> Vector a
V.fromList forall a b. (a -> b) -> a -> b
$ [Char
'0'..Char
'9'] forall a. [a] -> [a] -> [a]
++ [Char
'A'..Char
'Z']
        let renderDigit :: a -> Maybe Char
renderDigit a
n = Vector Char
digitVector forall a. Vector a -> Int -> Maybe a
V.!? (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n)
        Text -> Val
VString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
          case Val
val of
            VInteger Integer
n | Integer
base forall a. Eq a => a -> a -> Bool
/= Integer
10
              -> case forall n. Integral n => n -> n -> Maybe [n]
mDigits Integer
base Integer
n of
                   Maybe [Integer]
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Could not convert number to base"
                   Just [Integer]
ds -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                     (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Could not convert number to base")
                     (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack)
                     (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {a}. Integral a => a -> Maybe Char
renderDigit [Integer]
ds)
            Val
_ -> forall a (m :: * -> *).
(FromVal a, MonadPlus m, MonadFail m) =>
Val -> m a
fromVal Val
val forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Text
repr Val
val))
      [ ( Identifier
"to-unicode",
           (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction forall a b. (a -> b) -> a -> b
$ do
             (Text
val :: Text) <- forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
             case Text -> Maybe (Char, Text)
T.uncons Text
val of
               Just (Char
c, Text
t) | Text -> Bool
T.null Text
t ->
                 forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Integer -> Val
VInteger forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
c
               Maybe (Char, Text)
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"to-unicode expects a single character" )
      , ( Identifier
"from-unicode",
           (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction forall a b. (a -> b) -> a -> b
$ do
             (Int
val :: Int) <- 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
$ String -> Text
T.pack [Int -> Char
chr Int
val] )
      ]
    ),
    ( Identifier
"symbol",
      (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction forall a b. (a -> b) -> a -> b
$ do
        (Text
t :: Text) <- forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
        [Val]
vs <- forall a. Int -> [a] -> [a]
drop Int
1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Monad m => ReaderT Arguments (MP m) [Val]
allArgs
        [(Set Text, Text)]
variants <-
          forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
            ( \case
                VArray [VString Text
k, VString Text
v] ->
                  forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Ord a => [a] -> Set a
Set.fromList ((Char -> Bool) -> Text -> [Text]
T.split (forall a. Eq a => a -> a -> Bool
== Char
'.') Text
k), Text
v)
                Val
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"wrong type in symbol arguments"
            )
            [Val]
vs
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Symbol -> Val
VSymbol forall a b. (a -> b) -> a -> b
$ Text -> Bool -> [(Set Text, Text)] -> Symbol
Symbol Text
t Bool
False [(Set Text, Text)]
variants
    ),
    ( Identifier
"lorem",
      (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction forall a b. (a -> b) -> a -> b
$ do
        (Int
num :: Int) <- 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
$ [Text] -> Text
T.unwords forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take Int
num [Text]
loremWords
    )
  ]

loremWords :: [Text]
loremWords :: [Text]
loremWords =
  forall a. [a] -> [a]
cycle forall a b. (a -> b) -> a -> b
$
    Text -> [Text]
T.words forall a b. (a -> b) -> a -> b
$
      Text
"Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do\
      \ eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut\
      \ enim ad minim veniam, quis nostrud exercitation ullamco laboris\
      \ nisi ut aliquip ex ea commodo consequat.  Duis aute irure dolor in\
      \ reprehenderit in voluptate velit esse cillum dolore eu fugiat\
      \ nulla pariatur. Excepteur sint occaecat cupidatat non proident,\
      \ sunt in culpa qui officia deserunt mollit anim id est laborum."

toRatio :: MonadFail m => Val -> m Rational
toRatio :: forall (m :: * -> *). MonadFail m => Val -> m Rational
toRatio (VRatio Rational
r) = forall (f :: * -> *) a. Applicative f => a -> f a
pure Rational
r
toRatio (VInteger Integer
i) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Integer
i forall a. Integral a => a -> a -> Ratio a
% Integer
255
toRatio Val
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"cannot convert to rational"

hexToRGB :: MonadFail m => Val -> m Color
hexToRGB :: forall (m :: * -> *). MonadFail m => Val -> m Color
hexToRGB (VString Text
s) = do
  let s' :: Text
s' = (Char -> Bool) -> Text -> Text
T.dropWhile (forall a. Eq a => a -> a -> Bool
== Char
'#') Text
s
  [Maybe Rational]
parts <-
    forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Integral a => a -> a -> Ratio a
% Integer
255) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> Maybe a
readMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"0x" forall a. Semigroup a => a -> a -> a
<>))
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Text -> Int
T.length Text
s' of
        Int
3 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Int -> Text -> [Text]
T.chunksOf Int
1 Text
s'
        Int
4 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Int -> Text -> [Text]
T.chunksOf Int
1 Text
s'
        Int
6 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Int -> Text -> [Text]
T.chunksOf Int
2 Text
s'
        Int
8 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Int -> Text -> [Text]
T.chunksOf Int
2 Text
s'
        Int
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"hex string must be 3, 4, 6, or 8 digits"
  case [Maybe Rational]
parts of
    [Just Rational
r, Just Rational
g, Just Rational
b] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational -> Rational -> Color
RGB Rational
r Rational
g Rational
b Rational
1.0
    [Just Rational
r, Just Rational
g, Just Rational
b, Just Rational
o] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational -> Rational -> Color
RGB Rational
r Rational
g Rational
b Rational
o
    [Maybe Rational]
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"could not read string as hex color"
hexToRGB Val
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected string"

loadFileLazyBytes :: Monad m => FilePath -> MP m BL.ByteString
loadFileLazyBytes :: forall (m :: * -> *). Monad m => String -> MP m ByteString
loadFileLazyBytes String
fp = do
  Operations m
operations <- forall (m :: * -> *). EvalState m -> Operations m
evalOperations forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.fromStrict forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Operations m -> String -> m ByteString
loadBytes Operations m
operations String
fp

loadFileText :: Monad m => FilePath -> MP m T.Text
loadFileText :: forall (m :: * -> *). Monad m => String -> MP m Text
loadFileText String
fp = do
  Operations m
operations <- forall (m :: * -> *). EvalState m -> Operations m
evalOperations forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ ByteString -> Text
TE.decodeUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Operations m -> String -> m ByteString
loadBytes Operations m
operations String
fp

getUTCTime :: Monad m => MP m UTCTime
getUTCTime :: forall (m :: * -> *). Monad m => MP m UTCTime
getUTCTime = (forall (m :: * -> *). Operations m -> m UTCTime
currentUTCTime forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). EvalState m -> Operations m
evalOperations forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

time :: [(Identifier, Val)]
time :: [(Identifier, Val)]
time =
  [ ( Identifier
"datetime", (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Map Identifier Val -> Val
makeFunctionWithScope
      (do
         Maybe Integer
mbyear <- forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Identifier -> a -> ReaderT Arguments (MP m) a
namedArg Identifier
"year" forall a. Maybe a
Nothing
         Maybe Int
mbmonth <- forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Identifier -> a -> ReaderT Arguments (MP m) a
namedArg Identifier
"month" forall a. Maybe a
Nothing
         Maybe Int
mbday <- forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Identifier -> a -> ReaderT Arguments (MP m) a
namedArg Identifier
"day" forall a. Maybe a
Nothing
         let mbdate :: Maybe Day
mbdate = case (Maybe Integer
mbyear, Maybe Int
mbmonth, Maybe Int
mbday) of
                        (Just Integer
yr, Just Int
mo, Just Int
da) -> Integer -> Int -> Int -> Maybe Day
fromGregorianValid Integer
yr Int
mo Int
da
                        (Maybe Integer, Maybe Int, Maybe Int)
_ -> forall a. Maybe a
Nothing
         Maybe Integer
mbhour <- forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Identifier -> a -> ReaderT Arguments (MP m) a
namedArg Identifier
"hour" forall a. Maybe a
Nothing
         Maybe Integer
mbminute <- forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Identifier -> a -> ReaderT Arguments (MP m) a
namedArg Identifier
"minute" forall a. Maybe a
Nothing
         Maybe Integer
mbsecond <- forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Identifier -> a -> ReaderT Arguments (MP m) a
namedArg Identifier
"second" forall a. Maybe a
Nothing
         let mbtime :: Maybe DiffTime
mbtime = case (Maybe Integer
mbhour, Maybe Integer
mbminute, Maybe Integer
mbsecond) of
                        (Just Integer
hr, Just Integer
mi, Just Integer
se) ->
                          forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Integer -> DiffTime
secondsToDiffTime forall a b. (a -> b) -> a -> b
$ (Integer
hr forall a. Num a => a -> a -> a
* Integer
60 forall a. Num a => a -> a -> a
* Integer
60) forall a. Num a => a -> a -> a
+ (Integer
mi forall a. Num a => a -> a -> a
* Integer
60) forall a. Num a => a -> a -> a
+ Integer
se
                        (Maybe Integer, Maybe Integer, Maybe Integer)
_ -> forall a. Maybe a
Nothing
         forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Maybe Day -> Maybe DiffTime -> Val
VDateTime Maybe Day
mbdate Maybe DiffTime
mbtime)
      [ (Identifier
"today", (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction forall a b. (a -> b) -> a -> b
$ do
            UTCTime
utcTime <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). Monad m => MP m UTCTime
getUTCTime
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Maybe Day -> Maybe DiffTime -> Val
VDateTime (forall a. a -> Maybe a
Just (UTCTime -> Day
utctDay UTCTime
utcTime)) (forall a. a -> Maybe a
Just (UTCTime -> DiffTime
utctDayTime UTCTime
utcTime)) ) ]
     )
  ]

dataLoading :: [(Identifier, Val)]
dataLoading :: [(Identifier, Val)]
dataLoading =
  [ ( Identifier
"csv",
      (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction forall a b. (a -> b) -> a -> b
$ do
        String
fp <- forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
        ByteString
bs <- 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 => String -> MP m ByteString
loadFileLazyBytes String
fp
        case forall a.
FromRecord a =>
HasHeader -> ByteString -> Either String (Vector a)
Csv.decode HasHeader
Csv.NoHeader ByteString
bs of
          Left String
e -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
          Right (Vector (Vector String)
v :: V.Vector (V.Vector String)) ->
            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 (Vector Val -> Val
VArray forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> Vector a -> Vector b
V.map (Text -> Val
VString forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack)) Vector (Vector String)
v
    ),
    ( Identifier
"json",
      (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction forall a b. (a -> b) -> a -> b
$ do
        String
fp <- forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
        ByteString
bs <- 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 => String -> MP m ByteString
loadFileLazyBytes String
fp
        case forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecode ByteString
bs of
          Left String
e -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
          Right (Val
v :: Val) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
v
    ),
    ( Identifier
"yaml",
      (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction forall a b. (a -> b) -> a -> b
$ do
        String
fp <- forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
        ByteString
bs <- 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 => String -> MP m ByteString
loadFileLazyBytes String
fp
        case forall a. FromJSON a => ByteString -> Either ParseException a
Yaml.decodeEither' (ByteString -> ByteString
BL.toStrict ByteString
bs) of
          Left ParseException
e -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show ParseException
e
          Right (Val
v :: Val) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
v
    ),
    ( Identifier
"read",
      (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction forall a b. (a -> b) -> a -> b
$ do
        String
fp <- forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
        Text
t <- 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 => String -> MP m Text
loadFileText String
fp
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Val
VString Text
t
    ),
    (Identifier
"toml", (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unimplemented toml"),
    ( Identifier
"xml",
      (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction forall a b. (a -> b) -> a -> b
$ do
        String
fp <- forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
        ByteString
bs <- 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 => String -> MP m ByteString
loadFileLazyBytes String
fp
        case ParseSettings -> ByteString -> Either SomeException Document
XML.parseLBS forall a. Default a => a
XML.def ByteString
bs of
          Left SomeException
e -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show SomeException
e
          Right Document
doc ->
            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 -> Maybe b) -> [a] -> [b]
mapMaybe
                    Node -> Maybe Val
nodeToVal
                    [Element -> Node
XML.NodeElement (Document -> Element
XML.documentRoot Document
doc)]
            where
              showname :: Name -> Text
showname Name
n = Name -> Text
XML.nameLocalName Name
n
              nodeToVal :: Node -> Maybe Val
nodeToVal (XML.NodeElement Element
elt) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Element -> Val
eltToDict Element
elt
              nodeToVal (XML.NodeContent Text
t) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> Val
VString Text
t
              nodeToVal Node
_ = forall a. Maybe a
Nothing
              eltToDict :: Element -> Val
eltToDict Element
elt =
                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
"tag", Text -> Val
VString forall a b. (a -> b) -> a -> b
$ Name -> Text
showname (Element -> Name
XML.elementName Element
elt)),
                      ( Identifier
"attrs",
                        OMap Identifier Val -> Val
VDict forall a b. (a -> b) -> a -> b
$
                          forall k v. Ord k => [(k, v)] -> OMap k v
OM.fromList forall a b. (a -> b) -> a -> b
$
                            forall a b. (a -> b) -> [a] -> [b]
map
                              (\(Name
k, Text
v) -> (Text -> Identifier
Identifier (Name -> Text
showname Name
k), Text -> Val
VString Text
v))
                              (forall k a. Map k a -> [(k, a)]
M.toList forall a b. (a -> b) -> a -> b
$ Element -> Map Name Text
XML.elementAttributes Element
elt)
                      ),
                      ( Identifier
"children",
                        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 -> Maybe b) -> [a] -> [b]
mapMaybe Node -> Maybe Val
nodeToVal (Element -> [Node]
XML.elementNodes Element
elt)
                      )
                    ]
    )
  ]

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)] }