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

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

import Data.Char (ord, chr)
import Control.Applicative ((<|>))
import Control.Monad (mplus, unless)
import Control.Monad.Reader (lift, asks)
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 qualified Toml
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 System.FilePath ((</>))
import Data.List (genericTake)
import Data.Time (UTCTime(..))
import Data.Time.Calendar (fromGregorianValid)
import Data.Time.Clock (secondsToDiffTime)

standardModule :: M.Map Identifier Val
standardModule :: Map Identifier Val
standardModule =
  [(Identifier, Val)] -> Map Identifier Val
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Identifier, Val)] -> Map Identifier Val)
-> [(Identifier, Val)] -> Map Identifier Val
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
"sys", Identifier -> Map Identifier Val -> Val
VModule Identifier
"sys" Map Identifier Val
sysModule),
      (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)
    ]
      [(Identifier, Val)] -> [(Identifier, Val)] -> [(Identifier, Val)]
forall a. [a] -> [a] -> [a]
++ [(Identifier, Val)]
colors
      [(Identifier, Val)] -> [(Identifier, Val)] -> [(Identifier, Val)]
forall a. [a] -> [a] -> [a]
++ [(Identifier, Val)]
directions
      [(Identifier, Val)] -> [(Identifier, Val)] -> [(Identifier, Val)]
forall a. [a] -> [a] -> [a]
++ [(Identifier, Val)]
alignments
      [(Identifier, Val)] -> [(Identifier, Val)] -> [(Identifier, Val)]
forall a. [a] -> [a] -> [a]
++ [(Identifier, Val)]
textual
      [(Identifier, Val)] -> [(Identifier, Val)] -> [(Identifier, Val)]
forall a. [a] -> [a] -> [a]
++ [(Identifier, Val)]
layout
      [(Identifier, Val)] -> [(Identifier, Val)] -> [(Identifier, Val)]
forall a. [a] -> [a] -> [a]
++ [(Identifier, Val)]
visualize
      [(Identifier, Val)] -> [(Identifier, Val)] -> [(Identifier, Val)]
forall a. [a] -> [a] -> [a]
++ [(Identifier, Val)]
meta
      [(Identifier, Val)] -> [(Identifier, Val)] -> [(Identifier, Val)]
forall a. [a] -> [a] -> [a]
++ [(Identifier, Val)]
foundations
      [(Identifier, Val)] -> [(Identifier, Val)] -> [(Identifier, Val)]
forall a. [a] -> [a] -> [a]
++ [(Identifier, Val)]
construct
      [(Identifier, Val)] -> [(Identifier, Val)] -> [(Identifier, Val)]
forall a. [a] -> [a] -> [a]
++ [(Identifier, Val)]
time
      [(Identifier, Val)] -> [(Identifier, Val)] -> [(Identifier, Val)]
forall a. [a] -> [a] -> [a]
++ [(Identifier, Val)]
dataLoading

sysModule :: M.Map Identifier Val
sysModule :: Map Identifier Val
sysModule =
  [(Identifier, Val)] -> Map Identifier Val
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [ Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement (Identifier -> Maybe Identifier
forall a. a -> Maybe a
Just Identifier
"sys") Identifier
"version" [] ]

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

layout :: [(Identifier, Val)]
layout :: [(Identifier, Val)]
layout =
  [ Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement
      Maybe Identifier
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 Maybe Identifier
forall a. Maybe a
Nothing Identifier
"block" [(Identifier
"body", ValType -> TypeSpec
One ValType
TContent)],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement Maybe Identifier
forall a. Maybe a
Nothing Identifier
"box" [(Identifier
"body", ValType -> TypeSpec
One ValType
TContent)],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement Maybe Identifier
forall a. Maybe a
Nothing Identifier
"colbreak" [],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement Maybe Identifier
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 Maybe Identifier
forall a. Maybe a
Nothing Identifier
"grid" [(Identifier
"children", ValType -> TypeSpec
Many ValType
TContent)],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement Maybe Identifier
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 Maybe Identifier
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 Maybe Identifier
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
      Maybe Identifier
forall a. Maybe a
Nothing
      Identifier
"enum"
      [(Identifier
"children", ValType -> TypeSpec
Many ValType
TContent)]
      [ Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement
          (Identifier -> Maybe Identifier
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
      Maybe Identifier
forall a. Maybe a
Nothing
      Identifier
"list"
      [(Identifier
"children", ValType -> TypeSpec
Many ValType
TContent)]
      [Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement (Identifier -> Maybe Identifier
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 Maybe Identifier
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 Maybe Identifier
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 Maybe Identifier
forall a. Maybe a
Nothing Identifier
"page" [(Identifier
"body", ValType -> TypeSpec
One ValType
TContent)],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement Maybe Identifier
forall a. Maybe a
Nothing Identifier
"pagebreak" [],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement Maybe Identifier
forall a. Maybe a
Nothing Identifier
"par" [(Identifier
"body", ValType -> TypeSpec
One ValType
TContent)],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement Maybe Identifier
forall a. Maybe a
Nothing Identifier
"parbreak" [],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement Maybe Identifier
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 Maybe Identifier
forall a. Maybe a
Nothing Identifier
"repeat" [(Identifier
"body", ValType -> TypeSpec
One ValType
TContent)],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement Maybe Identifier
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 Maybe Identifier
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
      Maybe Identifier
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 Maybe Identifier
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
      Maybe Identifier
forall a. Maybe a
Nothing
      Identifier
"terms"
      [(Identifier
"children", ValType -> TypeSpec
Many ValType
TTermItem)]
      [ Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement
          (Identifier -> Maybe Identifier
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 (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
        -- content <- nthArg 1
        -- styles <- nthArg 2
        Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$
          OMap Identifier Val -> Val
VDict (OMap Identifier Val -> Val) -> OMap Identifier Val -> Val
forall a b. (a -> b) -> a -> b
$
            [(Identifier, Val)] -> OMap Identifier Val
forall k v. Ord k => [(k, v)] -> OMap k v
OM.fromList
              [ (Identifier
"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 Maybe Identifier
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 Maybe Identifier
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 Maybe Identifier
forall a. Maybe a
Nothing Identifier
"image" [(Identifier
"path", ValType -> TypeSpec
One ValType
TString)],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement Maybe Identifier
forall a. Maybe a
Nothing Identifier
"line" [],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement Maybe Identifier
forall a. Maybe a
Nothing Identifier
"path" [(Identifier
"vertices", ValType -> TypeSpec
Many ValType
TArray)],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement Maybe Identifier
forall a. Maybe a
Nothing Identifier
"polygon" [(Identifier
"vertices", ValType -> TypeSpec
Many ValType
TArray)],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement Maybe Identifier
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 Maybe Identifier
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 Maybe Identifier
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 Maybe Identifier
forall a. Maybe a
Nothing Identifier
"cite" [(Identifier
"key", ValType -> TypeSpec
One ValType
TLabel)],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement Maybe Identifier
forall a. Maybe a
Nothing Identifier
"document" [],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement Maybe Identifier
forall a. Maybe a
Nothing Identifier
"figure" [(Identifier
"body", ValType -> TypeSpec
One ValType
TContent)],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement Maybe Identifier
forall a. Maybe a
Nothing Identifier
"heading" [(Identifier
"body", ValType -> TypeSpec
One ValType
TContent)],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement Maybe Identifier
forall a. Maybe a
Nothing Identifier
"quote" [(Identifier
"body", ValType -> TypeSpec
One ValType
TContent)],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement Maybe Identifier
forall a. Maybe a
Nothing Identifier
"layout" [(Identifier
"func", ValType -> TypeSpec
One ValType
TFunction)],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement
      Maybe Identifier
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 Maybe Identifier
forall a. Maybe a
Nothing Identifier
"locate" [(Identifier
"func", ValType -> TypeSpec
One ValType
TFunction)],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement
      Maybe Identifier
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 Maybe Identifier
forall a. Maybe a
Nothing Identifier
"outline"
      []
      [Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement (Identifier -> Maybe Identifier
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
      Maybe Identifier
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 Maybe Identifier
forall a. Maybe a
Nothing Identifier
"metadata" [ (Identifier
"value", ValType -> TypeSpec
One ValType
TAny) ],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement Maybe Identifier
forall a. Maybe a
Nothing Identifier
"ref" [(Identifier
"target", ValType -> TypeSpec
One ValType
TLabel)],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement Maybe Identifier
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
      Maybe Identifier
forall a. Maybe a
Nothing
      Identifier
"footnote"
      [(Identifier
"body", ValType -> TypeSpec
One ValType
TContent)]
      [Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement (Identifier -> Maybe Identifier
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 (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
        Function forall (m :: * -> *). Monad m => Arguments -> MP m Val
f <- Int -> ReaderT Arguments (MP m') Function
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 Arguments -> MP m Val
forall (m :: * -> *). Monad m => Arguments -> MP m Val
f) [Item [Val]
Val
VStyles] of
          Success Val
x -> Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
x
          Failure String
e -> String -> ReaderT Arguments (MP m') Val
forall a. String -> ReaderT Arguments (MP m') a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e)
  ]

colors :: [(Identifier, Val)]
colors :: [(Identifier, Val)]
colors =
  [ (Identifier
"red", Color -> Val
VColor (Color -> Val) -> Color -> Val
forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational -> Rational -> Color
RGB (Integer
0xff Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x41 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x36 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) Rational
1),
    (Identifier
"blue", Color -> Val
VColor (Color -> Val) -> Color -> Val
forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational -> Rational -> Color
RGB (Integer
0x00 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x74 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0xd9 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) Rational
1),
    (Identifier
"black", Color -> Val
VColor (Color -> Val) -> Color -> Val
forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational -> Rational -> Color
RGB (Integer
0x00 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x00 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x00 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) Rational
1),
    (Identifier
"gray", Color -> Val
VColor (Color -> Val) -> Color -> Val
forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational -> Rational -> Color
RGB (Integer
0xaa Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0xaa Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0xaa Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) Rational
1),
    (Identifier
"silver", Color -> Val
VColor (Color -> Val) -> Color -> Val
forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational -> Rational -> Color
RGB (Integer
0xdd Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0xdd Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0xdd Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) Rational
1),
    (Identifier
"white", Color -> Val
VColor (Color -> Val) -> Color -> Val
forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational -> Rational -> Color
RGB (Integer
0xff Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0xff Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0xff Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) Rational
1),
    (Identifier
"navy", Color -> Val
VColor (Color -> Val) -> Color -> Val
forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational -> Rational -> Color
RGB (Integer
0x00 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x1f Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x3f Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) Rational
1),
    (Identifier
"aqua", Color -> Val
VColor (Color -> Val) -> Color -> Val
forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational -> Rational -> Color
RGB (Integer
0x7f Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0xdb Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0xff Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) Rational
1),
    (Identifier
"teal", Color -> Val
VColor (Color -> Val) -> Color -> Val
forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational -> Rational -> Color
RGB (Integer
0x39 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0xcc Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0xcc Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) Rational
1),
    (Identifier
"eastern", Color -> Val
VColor (Color -> Val) -> Color -> Val
forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational -> Rational -> Color
RGB (Integer
0x23 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x9d Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0xad Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) Rational
1),
    (Identifier
"purple", Color -> Val
VColor (Color -> Val) -> Color -> Val
forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational -> Rational -> Color
RGB (Integer
0xb1 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x0d Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0xc9 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) Rational
1),
    (Identifier
"fuchsia", Color -> Val
VColor (Color -> Val) -> Color -> Val
forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational -> Rational -> Color
RGB (Integer
0xf0 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x12 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0xbe Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) Rational
1),
    (Identifier
"maroon", Color -> Val
VColor (Color -> Val) -> Color -> Val
forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational -> Rational -> Color
RGB (Integer
0x85 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x14 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x4b Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) Rational
1),
    (Identifier
"yellow", Color -> Val
VColor (Color -> Val) -> Color -> Val
forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational -> Rational -> Color
RGB (Integer
0xff Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0xdc Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x00 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) Rational
1),
    (Identifier
"orange", Color -> Val
VColor (Color -> Val) -> Color -> Val
forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational -> Rational -> Color
RGB (Integer
0xff Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x85 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x1b Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) Rational
1),
    (Identifier
"olive", Color -> Val
VColor (Color -> Val) -> Color -> Val
forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational -> Rational -> Color
RGB (Integer
0x3d Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x99 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x70 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) Rational
1),
    (Identifier
"green", Color -> Val
VColor (Color -> Val) -> Color -> Val
forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational -> Rational -> Color
RGB (Integer
0x2e Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0xcc Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x40 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) Rational
1),
    (Identifier
"lime", Color -> Val
VColor (Color -> Val) -> Color -> Val
forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational -> Rational -> Color
RGB (Integer
0x01 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0xff Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x70 Integer -> Integer -> Rational
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 (Horiz -> Maybe Horiz
forall a. a -> Maybe a
Just Horiz
HorizStart) Maybe Vert
forall a. Maybe a
Nothing),
    (Identifier
"end", Maybe Horiz -> Maybe Vert -> Val
VAlignment (Horiz -> Maybe Horiz
forall a. a -> Maybe a
Just Horiz
HorizEnd) Maybe Vert
forall a. Maybe a
Nothing),
    (Identifier
"left", Maybe Horiz -> Maybe Vert -> Val
VAlignment (Horiz -> Maybe Horiz
forall a. a -> Maybe a
Just Horiz
HorizLeft) Maybe Vert
forall a. Maybe a
Nothing),
    (Identifier
"center", Maybe Horiz -> Maybe Vert -> Val
VAlignment (Horiz -> Maybe Horiz
forall a. a -> Maybe a
Just Horiz
HorizCenter) Maybe Vert
forall a. Maybe a
Nothing),
    (Identifier
"right", Maybe Horiz -> Maybe Vert -> Val
VAlignment (Horiz -> Maybe Horiz
forall a. a -> Maybe a
Just Horiz
HorizRight) Maybe Vert
forall a. Maybe a
Nothing),
    (Identifier
"top", Maybe Horiz -> Maybe Vert -> Val
VAlignment Maybe Horiz
forall a. Maybe a
Nothing (Vert -> Maybe Vert
forall a. a -> Maybe a
Just Vert
VertTop)),
    (Identifier
"horizon", Maybe Horiz -> Maybe Vert -> Val
VAlignment Maybe Horiz
forall a. Maybe a
Nothing (Vert -> Maybe Vert
forall a. a -> Maybe a
Just Vert
VertHorizon)),
    (Identifier
"bottom", Maybe Horiz -> Maybe Vert -> Val
VAlignment Maybe Horiz
forall a. Maybe a
Nothing (Vert -> Maybe Vert
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) <- Int -> ReaderT Arguments (MP m') Bool
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
            Bool
-> ReaderT Arguments (MP m') () -> ReaderT Arguments (MP m') ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
cond (ReaderT Arguments (MP m') () -> ReaderT Arguments (MP m') ())
-> ReaderT Arguments (MP m') () -> ReaderT Arguments (MP m') ()
forall a b. (a -> b) -> a -> b
$ do
              (String
msg :: String) <- Identifier -> String -> ReaderT Arguments (MP m') String
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Identifier -> a -> ReaderT Arguments (MP m) a
namedArg Identifier
"message" String
"Assertion failed"
              String -> ReaderT Arguments (MP m') ()
forall a. String -> ReaderT Arguments (MP m') a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
msg
            Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
VNone
        )
        [ ( Identifier
"eq",
            (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
              (Val
v1 :: Val) <- Int -> ReaderT Arguments (MP m') Val
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
              (Val
v2 :: Val) <- Int -> ReaderT Arguments (MP m') Val
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
2
              Bool
-> ReaderT Arguments (MP m') () -> ReaderT Arguments (MP m') ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Val -> Val -> Maybe Ordering
forall a. Compare a => a -> a -> Maybe Ordering
comp Val
v1 Val
v2 Maybe Ordering -> Maybe Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering -> Maybe Ordering
forall a. a -> Maybe a
Just Ordering
EQ) (ReaderT Arguments (MP m') () -> ReaderT Arguments (MP m') ())
-> ReaderT Arguments (MP m') () -> ReaderT Arguments (MP m') ()
forall a b. (a -> b) -> a -> b
$ String -> ReaderT Arguments (MP m') ()
forall a. String -> ReaderT Arguments (MP m') a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Assertion failed"
              Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
VNone
          ),
          ( Identifier
"ne",
            (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
              (Val
v1 :: Val) <- Int -> ReaderT Arguments (MP m') Val
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
              (Val
v2 :: Val) <- Int -> ReaderT Arguments (MP m') Val
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
2
              Bool
-> ReaderT Arguments (MP m') () -> ReaderT Arguments (MP m') ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Val -> Val -> Maybe Ordering
forall a. Compare a => a -> a -> Maybe Ordering
comp Val
v1 Val
v2 Maybe Ordering -> Maybe Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering -> Maybe Ordering
forall a. a -> Maybe a
Just Ordering
EQ) (ReaderT Arguments (MP m') () -> ReaderT Arguments (MP m') ())
-> ReaderT Arguments (MP m') () -> ReaderT Arguments (MP m') ()
forall a b. (a -> b) -> a -> b
$ String -> ReaderT Arguments (MP m') ()
forall a. String -> ReaderT Arguments (MP m') a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Assertion failed"
              Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
VNone
          )
        ]
    ),
    (Identifier
"panic", (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ ReaderT Arguments (MP m') [Val]
forall (m :: * -> *). Monad m => ReaderT Arguments (MP m) [Val]
allArgs ReaderT Arguments (MP m') [Val]
-> ([Val] -> ReaderT Arguments (MP m') Val)
-> ReaderT Arguments (MP m') Val
forall a b.
ReaderT Arguments (MP m') a
-> (a -> ReaderT Arguments (MP m') b)
-> ReaderT Arguments (MP m') b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ReaderT Arguments (MP m') Val
forall a. String -> ReaderT Arguments (MP m') a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ReaderT Arguments (MP m') Val)
-> ([Val] -> String) -> [Val] -> ReaderT Arguments (MP m') Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> ([Val] -> Text) -> [Val] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                 ((Text
"panicked with: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> ([Val] -> Text) -> [Val] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines ([Text] -> Text) -> ([Val] -> [Text]) -> [Val] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Val -> Text) -> [Val] -> [Text]
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 (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ Int -> ReaderT Arguments (MP m') Val
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1 ReaderT Arguments (MP m') Val
-> (Val -> ReaderT Arguments (MP m') Val)
-> ReaderT Arguments (MP m') Val
forall a b.
ReaderT Arguments (MP m') a
-> (a -> ReaderT Arguments (MP m') b)
-> ReaderT Arguments (MP m') b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> (Val -> Val) -> Val -> ReaderT Arguments (MP m') Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Val
VString (Text -> Val) -> (Val -> Text) -> Val -> Val
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 (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
        (Val
x :: Val) <- Int -> ReaderT Arguments (MP m') Val
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
        Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ ValType -> Val
VType (ValType -> Val) -> ValType -> Val
forall a b. (a -> b) -> a -> b
$ Val -> ValType
valType Val
x
    )
  ]

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

loremWords :: [Text]
loremWords :: [Text]
loremWords =
  [Text] -> [Text]
forall a. HasCallStack => [a] -> [a]
cycle ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$
    Text -> [Text]
T.words (Text -> [Text]) -> Text -> [Text]
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) = Rational -> m Rational
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Rational
r
toRatio (VInteger Integer
i) = Rational -> m Rational
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Rational -> m Rational) -> Rational -> m Rational
forall a b. (a -> b) -> a -> b
$ Integer
i Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
255
toRatio Val
_ = String -> m Rational
forall a. String -> m a
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 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'#') Text
s
  [Maybe Rational]
parts <-
    (Text -> Maybe Rational) -> [Text] -> [Maybe Rational]
forall a b. (a -> b) -> [a] -> [b]
map ((Integer -> Rational) -> Maybe Integer -> Maybe Rational
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
255) (Maybe Integer -> Maybe Rational)
-> (Text -> Maybe Integer) -> Text -> Maybe Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Integer
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Integer)
-> (Text -> String) -> Text -> Maybe Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> (Text -> Text) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"0x" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>))
      ([Text] -> [Maybe Rational]) -> m [Text] -> m [Maybe Rational]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Text -> Int
T.length Text
s' of
        Int
3 -> [Text] -> m [Text]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Text] -> m [Text]) -> [Text] -> m [Text]
forall a b. (a -> b) -> a -> b
$ Int -> Text -> [Text]
T.chunksOf Int
1 Text
s'
        Int
4 -> [Text] -> m [Text]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Text] -> m [Text]) -> [Text] -> m [Text]
forall a b. (a -> b) -> a -> b
$ Int -> Text -> [Text]
T.chunksOf Int
1 Text
s'
        Int
6 -> [Text] -> m [Text]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Text] -> m [Text]) -> [Text] -> m [Text]
forall a b. (a -> b) -> a -> b
$ Int -> Text -> [Text]
T.chunksOf Int
2 Text
s'
        Int
8 -> [Text] -> m [Text]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Text] -> m [Text]) -> [Text] -> m [Text]
forall a b. (a -> b) -> a -> b
$ Int -> Text -> [Text]
T.chunksOf Int
2 Text
s'
        Int
_ -> String -> m [Text]
forall a. String -> m a
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] -> Color -> m Color
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Color -> m Color) -> Color -> m Color
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] -> Color -> m Color
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Color -> m Color) -> Color -> m Color
forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational -> Rational -> Color
RGB Rational
r Rational
g Rational
b Rational
o
    [Maybe Rational]
_ -> String -> m Color
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"could not read string as hex color"
hexToRGB Val
_ = String -> m Color
forall a. String -> m a
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 <- EvalState m -> Operations m
forall (m :: * -> *). EvalState m -> Operations m
evalOperations (EvalState m -> Operations m)
-> ParsecT [Markup] (EvalState m) m (EvalState m)
-> ParsecT [Markup] (EvalState m) m (Operations m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Markup] (EvalState m) m (EvalState m)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  String
root <- EvalState m -> String
forall (m :: * -> *). EvalState m -> String
evalPackageRoot (EvalState m -> String)
-> ParsecT [Markup] (EvalState m) m (EvalState m)
-> ParsecT [Markup] (EvalState m) m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Markup] (EvalState m) m (EvalState m)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  m ByteString -> MP m ByteString
forall (m :: * -> *) a.
Monad m =>
m a -> ParsecT [Markup] (EvalState m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> MP m ByteString)
-> m ByteString -> MP m ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.fromStrict (ByteString -> ByteString) -> m ByteString -> m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Operations m -> String -> m ByteString
forall (m :: * -> *). Operations m -> String -> m ByteString
loadBytes Operations m
operations (String
root String -> String -> String
</> 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 <- EvalState m -> Operations m
forall (m :: * -> *). EvalState m -> Operations m
evalOperations (EvalState m -> Operations m)
-> ParsecT [Markup] (EvalState m) m (EvalState m)
-> ParsecT [Markup] (EvalState m) m (Operations m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Markup] (EvalState m) m (EvalState m)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  String
root <- EvalState m -> String
forall (m :: * -> *). EvalState m -> String
evalPackageRoot (EvalState m -> String)
-> ParsecT [Markup] (EvalState m) m (EvalState m)
-> ParsecT [Markup] (EvalState m) m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Markup] (EvalState m) m (EvalState m)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  m Text -> MP m Text
forall (m :: * -> *) a.
Monad m =>
m a -> ParsecT [Markup] (EvalState m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Text -> MP m Text) -> m Text -> MP m Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
TE.decodeUtf8 (ByteString -> Text) -> m ByteString -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Operations m -> String -> m ByteString
forall (m :: * -> *). Operations m -> String -> m ByteString
loadBytes Operations m
operations (String
root String -> String -> String
</> String
fp)

getUTCTime :: Monad m => MP m UTCTime
getUTCTime :: forall (m :: * -> *). Monad m => MP m UTCTime
getUTCTime = (Operations m -> m UTCTime
forall (m :: * -> *). Operations m -> m UTCTime
currentUTCTime (Operations m -> m UTCTime)
-> (EvalState m -> Operations m) -> EvalState m -> m UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalState m -> Operations m
forall (m :: * -> *). EvalState m -> Operations m
evalOperations (EvalState m -> m UTCTime)
-> ParsecT [Markup] (EvalState m) m (EvalState m)
-> ParsecT [Markup] (EvalState m) m (m UTCTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Markup] (EvalState m) m (EvalState m)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState) ParsecT [Markup] (EvalState m) m (m UTCTime)
-> (m UTCTime -> ParsecT [Markup] (EvalState m) m UTCTime)
-> ParsecT [Markup] (EvalState m) m UTCTime
forall a b.
ParsecT [Markup] (EvalState m) m a
-> (a -> ParsecT [Markup] (EvalState m) m b)
-> ParsecT [Markup] (EvalState m) m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m UTCTime -> ParsecT [Markup] (EvalState m) m UTCTime
forall (m :: * -> *) a.
Monad m =>
m a -> ParsecT [Markup] (EvalState m) m a
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 <- Identifier
-> Maybe Integer -> ReaderT Arguments (MP m') (Maybe Integer)
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Identifier -> a -> ReaderT Arguments (MP m) a
namedArg Identifier
"year" Maybe Integer
forall a. Maybe a
Nothing
         Maybe Int
mbmonth <- Identifier -> Maybe Int -> ReaderT Arguments (MP m') (Maybe Int)
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Identifier -> a -> ReaderT Arguments (MP m) a
namedArg Identifier
"month" Maybe Int
forall a. Maybe a
Nothing
         Maybe Int
mbday <- Identifier -> Maybe Int -> ReaderT Arguments (MP m') (Maybe Int)
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Identifier -> a -> ReaderT Arguments (MP m) a
namedArg Identifier
"day" Maybe Int
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)
_ -> Maybe Day
forall a. Maybe a
Nothing
         Maybe Integer
mbhour <- Identifier
-> Maybe Integer -> ReaderT Arguments (MP m') (Maybe Integer)
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Identifier -> a -> ReaderT Arguments (MP m) a
namedArg Identifier
"hour" Maybe Integer
forall a. Maybe a
Nothing
         Maybe Integer
mbminute <- Identifier
-> Maybe Integer -> ReaderT Arguments (MP m') (Maybe Integer)
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Identifier -> a -> ReaderT Arguments (MP m) a
namedArg Identifier
"minute" Maybe Integer
forall a. Maybe a
Nothing
         Maybe Integer
mbsecond <- Identifier
-> Maybe Integer -> ReaderT Arguments (MP m') (Maybe Integer)
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Identifier -> a -> ReaderT Arguments (MP m) a
namedArg Identifier
"second" Maybe Integer
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) ->
                          DiffTime -> Maybe DiffTime
forall a. a -> Maybe a
Just (DiffTime -> Maybe DiffTime) -> DiffTime -> Maybe DiffTime
forall a b. (a -> b) -> a -> b
$ Integer -> DiffTime
secondsToDiffTime (Integer -> DiffTime) -> Integer -> DiffTime
forall a b. (a -> b) -> a -> b
$ (Integer
hr Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
60 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
60) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ (Integer
mi Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
60) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
se
                        (Maybe Integer, Maybe Integer, Maybe Integer)
_ -> Maybe DiffTime
forall a. Maybe a
Nothing
         Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ 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 (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
            UTCTime
utcTime <- MP m' UTCTime -> ReaderT Arguments (MP m') UTCTime
forall (m :: * -> *) a. Monad m => m a -> ReaderT Arguments m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift MP m' UTCTime
forall (m :: * -> *). Monad m => MP m UTCTime
getUTCTime
            Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Maybe Day -> Maybe DiffTime -> Val
VDateTime (Day -> Maybe Day
forall a. a -> Maybe a
Just (UTCTime -> Day
utctDay UTCTime
utcTime)) (DiffTime -> Maybe DiffTime
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 (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
        String
fp <- Int -> ReaderT Arguments (MP m') String
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
        ByteString
bs <- MP m' ByteString -> ReaderT Arguments (MP m') ByteString
forall (m :: * -> *) a. Monad m => m a -> ReaderT Arguments m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (MP m' ByteString -> ReaderT Arguments (MP m') ByteString)
-> MP m' ByteString -> ReaderT Arguments (MP m') ByteString
forall a b. (a -> b) -> a -> b
$ String -> MP m' ByteString
forall (m :: * -> *). Monad m => String -> MP m ByteString
loadFileLazyBytes String
fp
        case HasHeader -> ByteString -> Either String (Vector (Vector String))
forall a.
FromRecord a =>
HasHeader -> ByteString -> Either String (Vector a)
Csv.decode HasHeader
Csv.NoHeader ByteString
bs of
          Left String
e -> String -> ReaderT Arguments (MP m') Val
forall a. String -> ReaderT Arguments (MP m') a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
          Right (Vector (Vector String)
v :: V.Vector (V.Vector String)) ->
            Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Vector Val -> Val
VArray (Vector Val -> Val) -> Vector Val -> Val
forall a b. (a -> b) -> a -> b
$ (Vector String -> Val) -> Vector (Vector String) -> Vector Val
forall a b. (a -> b) -> Vector a -> Vector b
V.map (Vector Val -> Val
VArray (Vector Val -> Val)
-> (Vector String -> Vector Val) -> Vector String -> Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Val) -> Vector String -> Vector Val
forall a b. (a -> b) -> Vector a -> Vector b
V.map (Text -> Val
VString (Text -> Val) -> (String -> Text) -> String -> Val
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 (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
        String
fp <- Int -> ReaderT Arguments (MP m') String
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
        ByteString
bs <- MP m' ByteString -> ReaderT Arguments (MP m') ByteString
forall (m :: * -> *) a. Monad m => m a -> ReaderT Arguments m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (MP m' ByteString -> ReaderT Arguments (MP m') ByteString)
-> MP m' ByteString -> ReaderT Arguments (MP m') ByteString
forall a b. (a -> b) -> a -> b
$ String -> MP m' ByteString
forall (m :: * -> *). Monad m => String -> MP m ByteString
loadFileLazyBytes String
fp
        case ByteString -> Either String Val
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecode ByteString
bs of
          Left String
e -> String -> ReaderT Arguments (MP m') Val
forall a. String -> ReaderT Arguments (MP m') a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
          Right (Val
v :: Val) -> Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
v
    ),
    ( Identifier
"yaml",
      (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
        String
fp <- Int -> ReaderT Arguments (MP m') String
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
        ByteString
bs <- MP m' ByteString -> ReaderT Arguments (MP m') ByteString
forall (m :: * -> *) a. Monad m => m a -> ReaderT Arguments m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (MP m' ByteString -> ReaderT Arguments (MP m') ByteString)
-> MP m' ByteString -> ReaderT Arguments (MP m') ByteString
forall a b. (a -> b) -> a -> b
$ String -> MP m' ByteString
forall (m :: * -> *). Monad m => String -> MP m ByteString
loadFileLazyBytes String
fp
        case ByteString -> Either ParseException Val
forall a. FromJSON a => ByteString -> Either ParseException a
Yaml.decodeEither' (ByteString -> ByteString
BL.toStrict ByteString
bs) of
          Left ParseException
e -> String -> ReaderT Arguments (MP m') Val
forall a. String -> ReaderT Arguments (MP m') a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ReaderT Arguments (MP m') Val)
-> String -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ ParseException -> String
forall a. Show a => a -> String
show ParseException
e
          Right (Val
v :: Val) -> Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
v
    ),
    ( Identifier
"read",
      (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
        String
fp <- Int -> ReaderT Arguments (MP m') String
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
        Text
t <- MP m' Text -> ReaderT Arguments (MP m') Text
forall (m :: * -> *) a. Monad m => m a -> ReaderT Arguments m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (MP m' Text -> ReaderT Arguments (MP m') Text)
-> MP m' Text -> ReaderT Arguments (MP m') Text
forall a b. (a -> b) -> a -> b
$ String -> MP m' Text
forall (m :: * -> *). Monad m => String -> MP m Text
loadFileText String
fp
        Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ Text -> Val
VString Text
t
    ),
    ( Identifier
"toml",
      (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
        String
fp <- Int -> ReaderT Arguments (MP m') String
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
        Text
t <- MP m' Text -> ReaderT Arguments (MP m') Text
forall (m :: * -> *) a. Monad m => m a -> ReaderT Arguments m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (MP m' Text -> ReaderT Arguments (MP m') Text)
-> MP m' Text -> ReaderT Arguments (MP m') Text
forall a b. (a -> b) -> a -> b
$ String -> MP m' Text
forall (m :: * -> *). Monad m => String -> MP m Text
loadFileText String
fp
        case String -> Result String Val
forall a. FromValue a => String -> Result String a
Toml.decode (Text -> String
T.unpack Text
t) of
          Toml.Failure [String]
e -> String -> ReaderT Arguments (MP m') Val
forall a. String -> ReaderT Arguments (MP m') a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ([String] -> String
unlines (String
"toml errors:" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
e))
          Toml.Success [String]
_ Val
v -> Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
v
    ),
    ( Identifier
"xml",
      (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
        String
fp <- Int -> ReaderT Arguments (MP m') String
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
        ByteString
bs <- MP m' ByteString -> ReaderT Arguments (MP m') ByteString
forall (m :: * -> *) a. Monad m => m a -> ReaderT Arguments m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (MP m' ByteString -> ReaderT Arguments (MP m') ByteString)
-> MP m' ByteString -> ReaderT Arguments (MP m') ByteString
forall a b. (a -> b) -> a -> b
$ String -> MP m' ByteString
forall (m :: * -> *). Monad m => String -> MP m ByteString
loadFileLazyBytes String
fp
        case ParseSettings -> ByteString -> Either SomeException Document
XML.parseLBS ParseSettings
forall a. Default a => a
XML.def ByteString
bs of
          Left SomeException
e -> String -> ReaderT Arguments (MP m') Val
forall a. String -> ReaderT Arguments (MP m') a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ReaderT Arguments (MP m') Val)
-> String -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ SomeException -> String
forall a. Show a => a -> String
show SomeException
e
          Right Document
doc ->
            Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$
              Vector Val -> Val
VArray (Vector Val -> Val) -> Vector Val -> Val
forall a b. (a -> b) -> a -> b
$
                [Val] -> Vector Val
forall a. [a] -> Vector a
V.fromList ([Val] -> Vector Val) -> [Val] -> Vector Val
forall a b. (a -> b) -> a -> b
$
                  (Node -> Maybe Val) -> [Node] -> [Val]
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) = Val -> Maybe Val
forall a. a -> Maybe a
Just (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Element -> Val
eltToDict Element
elt
              nodeToVal (XML.NodeContent Text
t) = Val -> Maybe Val
forall a. a -> Maybe a
Just (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Text -> Val
VString Text
t
              nodeToVal Node
_ = Maybe Val
forall a. Maybe a
Nothing
              eltToDict :: Element -> Val
eltToDict Element
elt =
                OMap Identifier Val -> Val
VDict (OMap Identifier Val -> Val) -> OMap Identifier Val -> Val
forall a b. (a -> b) -> a -> b
$
                  [(Identifier, Val)] -> OMap Identifier Val
forall k v. Ord k => [(k, v)] -> OMap k v
OM.fromList
                    [ (Identifier
"tag", Text -> Val
VString (Text -> Val) -> Text -> Val
forall a b. (a -> b) -> a -> b
$ Name -> Text
showname (Element -> Name
XML.elementName Element
elt)),
                      ( Identifier
"attrs",
                        OMap Identifier Val -> Val
VDict (OMap Identifier Val -> Val) -> OMap Identifier Val -> Val
forall a b. (a -> b) -> a -> b
$
                          [(Identifier, Val)] -> OMap Identifier Val
forall k v. Ord k => [(k, v)] -> OMap k v
OM.fromList ([(Identifier, Val)] -> OMap Identifier Val)
-> [(Identifier, Val)] -> OMap Identifier Val
forall a b. (a -> b) -> a -> b
$
                            ((Name, Text) -> (Identifier, Val))
-> [(Name, Text)] -> [(Identifier, Val)]
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))
                              (Map Name Text -> [(Name, Text)]
forall k a. Map k a -> [(k, a)]
M.toList (Map Name Text -> [(Name, Text)])
-> Map Name Text -> [(Name, Text)]
forall a b. (a -> b) -> a -> b
$ Element -> Map Name Text
XML.elementAttributes Element
elt)
                      ),
                      ( Identifier
"children",
                        Vector Val -> Val
VArray (Vector Val -> Val) -> Vector Val -> Val
forall a b. (a -> b) -> a -> b
$
                          [Val] -> Vector Val
forall a. [a] -> Vector a
V.fromList ([Val] -> Vector Val) -> [Val] -> Vector Val
forall a b. (a -> b) -> a -> b
$
                            (Node -> Maybe Val) -> [Node] -> [Val]
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 OMap Identifier Val
forall k v. OMap k v
OM.empty
   in case ParsecT [Markup] (EvalState Attempt) Attempt Val
-> EvalState Attempt
-> String
-> [Markup]
-> Attempt (Either ParseError Val)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> u -> String -> s -> m (Either ParseError a)
runParserT (Arguments -> ParsecT [Markup] (EvalState Attempt) Attempt Val
forall (m :: * -> *). Monad m => Arguments -> MP m Val
f Arguments
args) EvalState Attempt
forall (m :: * -> *). MonadFail m => EvalState m
initialEvalState String
"" [] of
        Failure String
s -> String -> Attempt Val
forall a. String -> Attempt a
Failure String
s
        Success (Left ParseError
s) -> String -> Attempt Val
forall a. String -> Attempt a
Failure (String -> Attempt Val) -> String -> Attempt Val
forall a b. (a -> b) -> a -> b
$ ParseError -> String
forall a. Show a => a -> String
show ParseError
s
        Success (Right Val
v) -> Val -> Attempt Val
forall a. a -> Attempt a
Success Val
v

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

-- mDigitsRev, mDigits from the unmaintained digits package
-- https://hackage.haskell.org/package/digits-0.3.1
-- (c) 2009-2016 Henry Bucklow, Charlie Harvey -- BSD-3-Clause license.
mDigitsRev :: Integral n
    => n         -- ^ The base to use.
    -> n         -- ^ The number to convert to digit form.
    -> Maybe [n] -- ^ Nothing or Just the digits of the number in list form, in reverse.
mDigitsRev :: forall n. Integral n => n -> n -> Maybe [n]
mDigitsRev n
base n
i = if n
base n -> n -> Bool
forall a. Ord a => a -> a -> Bool
< n
1
                    then Maybe [n]
forall a. Maybe a
Nothing -- We do not support zero or negative bases
                    else [n] -> Maybe [n]
forall a. a -> Maybe a
Just ([n] -> Maybe [n]) -> [n] -> Maybe [n]
forall a b. (a -> b) -> a -> b
$ n -> n -> [n]
forall {t}. Integral t => t -> t -> [t]
dr n
base n
i
    where
      dr :: t -> t -> [t]
dr t
_ t
0 = []
      dr t
b t
x = case n
base of
                n
1 -> t -> [t] -> [t]
forall i a. Integral i => i -> [a] -> [a]
genericTake t
x ([t] -> [t]) -> [t] -> [t]
forall a b. (a -> b) -> a -> b
$ t -> [t]
forall a. a -> [a]
repeat t
1
                n
_ -> let (t
rest, t
lastDigit) = t -> t -> (t, t)
forall a. Integral a => a -> a -> (a, a)
quotRem t
x t
b
                     in t
lastDigit t -> [t] -> [t]
forall a. a -> [a] -> [a]
: t -> t -> [t]
dr t
b t
rest

-- | Returns the digits of a positive integer as a Maybe list.
--   or Nothing if a zero or negative base is given
mDigits :: Integral n
    => n -- ^ The base to use.
    -> n -- ^ The number to convert to digit form.
    -> Maybe [n] -- ^ Nothing or Just the digits of the number in list form
mDigits :: forall n. Integral n => n -> n -> Maybe [n]
mDigits n
base n
i = [n] -> [n]
forall a. [a] -> [a]
reverse ([n] -> [n]) -> Maybe [n] -> Maybe [n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> n -> n -> Maybe [n]
forall n. Integral n => n -> n -> Maybe [n]
mDigitsRev n
base n
i