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

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

import Control.Applicative ((<|>))
import Control.Monad (mplus, unless)
import Control.Monad.Reader (lift, ReaderT)
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 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.Module.Calc (calcModule)
import Typst.Module.Math (mathModule)
import Typst.Symbols (typstSymbols, typstEmojis)
import Typst.Types
import Typst.Util
import System.FilePath.Posix ((</>), normalise)
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
"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)
      -- sys module is added in initialEvalState
    ]
      [(Identifier, Val)] -> [(Identifier, Val)] -> [(Identifier, Val)]
forall a. [a] -> [a] -> [a]
++ [(Identifier, Val)]
types
      [(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

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
$ [Sym] -> Map Identifier Symbol
makeSymbolMap [Sym]
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
$ [Sym] -> Map Identifier Symbol
makeSymbolMap [Sym]
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 <- Int -> ReaderT Arguments (MP m') Val
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
        case 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
            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
            pure $ VContent . Seq.singleton $ Elt "lower" (Just pos) [("text", VContent cs)]
          Val
_ -> String -> ReaderT Arguments (MP m') Val
forall a. HasCallStack => String -> ReaderT Arguments (MP m') a
forall (m :: * -> *) a.
(MonadFail m, HasCallStack) =>
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 <- Int -> ReaderT Arguments (MP m') Val
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
        case 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
            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
            pure $ VContent . Seq.singleton $ Elt "upper" (Just pos) [("text", VContent cs)]
          Val
_ -> String -> ReaderT Arguments (MP m') Val
forall a. HasCallStack => String -> ReaderT Arguments (MP m') a
forall (m :: * -> *) a.
(MonadFail m, HasCallStack) =>
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
"skew" [(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
"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)]
-> Map Identifier Val
-> (Identifier, Val)
makeElementWithScope Maybe Identifier
forall a. Maybe a
Nothing
      Identifier
"table"
      [(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
"table") Identifier
"cell" [ (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
"table") Identifier
"hline" []
      , Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement (Identifier -> Maybe Identifier
forall a. a -> Maybe a
Just Identifier
"table") Identifier
"vline" []
      , Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement (Identifier -> Maybe Identifier
forall a. a -> Maybe a
Just Identifier
"table") Identifier
"header" [ (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
"table") Identifier
"footer" [ (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
"grid"
      [(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
"grid") Identifier
"cell" [ (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
"grid") Identifier
"hline" []
      , Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement (Identifier -> Maybe Identifier
forall a. a -> Maybe a
Just Identifier
"grid") Identifier
"vline" []
      , Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement (Identifier -> Maybe Identifier
forall a. a -> Maybe a
Just Identifier
"grid") Identifier
"header" [ (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
"grid") Identifier
"footer" [ (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
"source", ValType -> TypeSpec
One (ValType
TString ValType -> ValType -> ValType
:|: ValType
TBytes))],
    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
"sources", ValType -> TypeSpec
One (ValType
TString ValType -> ValType -> ValType
:|: ValType
TArray ValType -> ValType -> ValType
:|: ValType
TBytes))],
    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" [(Identifier
"body", ValType -> TypeSpec
One ValType
TContent)],
    Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement Maybe Identifier
forall a. Maybe a
Nothing Identifier
"title" [(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
"figure"
      [(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
"figure") Identifier
"caption" [(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 f <- Int -> ReaderT Arguments (MP m') Function
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
        case applyPureFunction (Function f) [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. HasCallStack => String -> ReaderT Arguments (MP m') a
forall (m :: * -> *) a.
(MonadFail m, HasCallStack) =>
String -> m a
fail String
e)
  ]

types :: [(Identifier, Val)]
types :: [(Identifier, Val)]
types =
  [ (Identifier
"array", ValType -> Val
VType ValType
TArray)
  , (Identifier
"bool", ValType -> Val
VType ValType
TBoolean)
  , (Identifier
"content", ValType -> Val
VType ValType
TContent)
  , (Identifier
"dictionary", ValType -> Val
VType ValType
TDict)
  , (Identifier
"int", ValType -> Val
VType ValType
TInteger)
  , (Identifier
"float", ValType -> Val
VType ValType
TFloat)
  , (Identifier
"regex", ValType -> Val
VType ValType
TRegex)
  , (Identifier
"length", ValType -> Val
VType ValType
TLength)
  , (Identifier
"alignment", ValType -> Val
VType ValType
TAlignment)
  , (Identifier
"color", ValType -> Val
VType ValType
TColor)
  , (Identifier
"symbol", ValType -> Val
VType ValType
TSymbol)
  , (Identifier
"str", ValType -> Val
VType ValType
TString)
  , (Identifier
"label", ValType -> Val
VType ValType
TLabel)
  , (Identifier
"version", ValType -> Val
VType ValType
TVersion)
  , (Identifier
"bytes", ValType -> Val
VType ValType
TBytes)
  ]

colors :: [(Identifier, Val)]
colors :: [(Identifier, Val)]
colors =
  [ (Identifier
"red", Color -> Val
VColor (Color -> Val) -> Color -> Val
forall a b. (a -> b) -> a -> b
$ Ratio Integer
-> Ratio Integer -> Ratio Integer -> Ratio Integer -> Color
RGB (Integer
0xff Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x41 Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x36 Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) Ratio Integer
1),
    (Identifier
"blue", Color -> Val
VColor (Color -> Val) -> Color -> Val
forall a b. (a -> b) -> a -> b
$ Ratio Integer
-> Ratio Integer -> Ratio Integer -> Ratio Integer -> Color
RGB (Integer
0x00 Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x74 Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0xd9 Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) Ratio Integer
1),
    (Identifier
"black", Color -> Val
VColor (Color -> Val) -> Color -> Val
forall a b. (a -> b) -> a -> b
$ Ratio Integer
-> Ratio Integer -> Ratio Integer -> Ratio Integer -> Color
RGB (Integer
0x00 Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x00 Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x00 Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) Ratio Integer
1),
    (Identifier
"gray", Color -> Val
VColor (Color -> Val) -> Color -> Val
forall a b. (a -> b) -> a -> b
$ Ratio Integer
-> Ratio Integer -> Ratio Integer -> Ratio Integer -> Color
RGB (Integer
0xaa Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0xaa Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0xaa Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) Ratio Integer
1),
    (Identifier
"silver", Color -> Val
VColor (Color -> Val) -> Color -> Val
forall a b. (a -> b) -> a -> b
$ Ratio Integer
-> Ratio Integer -> Ratio Integer -> Ratio Integer -> Color
RGB (Integer
0xdd Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0xdd Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0xdd Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) Ratio Integer
1),
    (Identifier
"white", Color -> Val
VColor (Color -> Val) -> Color -> Val
forall a b. (a -> b) -> a -> b
$ Ratio Integer
-> Ratio Integer -> Ratio Integer -> Ratio Integer -> Color
RGB (Integer
0xff Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0xff Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0xff Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) Ratio Integer
1),
    (Identifier
"navy", Color -> Val
VColor (Color -> Val) -> Color -> Val
forall a b. (a -> b) -> a -> b
$ Ratio Integer
-> Ratio Integer -> Ratio Integer -> Ratio Integer -> Color
RGB (Integer
0x00 Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x1f Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x3f Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) Ratio Integer
1),
    (Identifier
"aqua", Color -> Val
VColor (Color -> Val) -> Color -> Val
forall a b. (a -> b) -> a -> b
$ Ratio Integer
-> Ratio Integer -> Ratio Integer -> Ratio Integer -> Color
RGB (Integer
0x7f Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0xdb Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0xff Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) Ratio Integer
1),
    (Identifier
"teal", Color -> Val
VColor (Color -> Val) -> Color -> Val
forall a b. (a -> b) -> a -> b
$ Ratio Integer
-> Ratio Integer -> Ratio Integer -> Ratio Integer -> Color
RGB (Integer
0x39 Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0xcc Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0xcc Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) Ratio Integer
1),
    (Identifier
"eastern", Color -> Val
VColor (Color -> Val) -> Color -> Val
forall a b. (a -> b) -> a -> b
$ Ratio Integer
-> Ratio Integer -> Ratio Integer -> Ratio Integer -> Color
RGB (Integer
0x23 Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x9d Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0xad Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) Ratio Integer
1),
    (Identifier
"purple", Color -> Val
VColor (Color -> Val) -> Color -> Val
forall a b. (a -> b) -> a -> b
$ Ratio Integer
-> Ratio Integer -> Ratio Integer -> Ratio Integer -> Color
RGB (Integer
0xb1 Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x0d Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0xc9 Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) Ratio Integer
1),
    (Identifier
"fuchsia", Color -> Val
VColor (Color -> Val) -> Color -> Val
forall a b. (a -> b) -> a -> b
$ Ratio Integer
-> Ratio Integer -> Ratio Integer -> Ratio Integer -> Color
RGB (Integer
0xf0 Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x12 Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0xbe Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) Ratio Integer
1),
    (Identifier
"maroon", Color -> Val
VColor (Color -> Val) -> Color -> Val
forall a b. (a -> b) -> a -> b
$ Ratio Integer
-> Ratio Integer -> Ratio Integer -> Ratio Integer -> Color
RGB (Integer
0x85 Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x14 Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x4b Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) Ratio Integer
1),
    (Identifier
"yellow", Color -> Val
VColor (Color -> Val) -> Color -> Val
forall a b. (a -> b) -> a -> b
$ Ratio Integer
-> Ratio Integer -> Ratio Integer -> Ratio Integer -> Color
RGB (Integer
0xff Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0xdc Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x00 Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) Ratio Integer
1),
    (Identifier
"orange", Color -> Val
VColor (Color -> Val) -> Color -> Val
forall a b. (a -> b) -> a -> b
$ Ratio Integer
-> Ratio Integer -> Ratio Integer -> Ratio Integer -> Color
RGB (Integer
0xff Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x85 Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x1b Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) Ratio Integer
1),
    (Identifier
"olive", Color -> Val
VColor (Color -> Val) -> Color -> Val
forall a b. (a -> b) -> a -> b
$ Ratio Integer
-> Ratio Integer -> Ratio Integer -> Ratio Integer -> Color
RGB (Integer
0x3d Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x99 Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x70 Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) Ratio Integer
1),
    (Identifier
"green", Color -> Val
VColor (Color -> Val) -> Color -> Val
forall a b. (a -> b) -> a -> b
$ Ratio Integer
-> Ratio Integer -> Ratio Integer -> Ratio Integer -> Color
RGB (Integer
0x2e Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0xcc Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x40 Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) Ratio Integer
1),
    (Identifier
"lime", Color -> Val
VColor (Color -> Val) -> Color -> Val
forall a b. (a -> b) -> a -> b
$ Ratio Integer
-> Ratio Integer -> Ratio Integer -> Ratio Integer -> Color
RGB (Integer
0x01 Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0xff Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) (Integer
0x70 Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
0xff) Ratio Integer
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
            (cond :: Bool) <- Int -> ReaderT Arguments (MP m') Bool
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
            unless cond $ do
              (msg :: String) <- namedArg "message" "Assertion failed"
              fail msg
            pure 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
              (v1 :: Val) <- Int -> ReaderT Arguments (MP m') Val
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
              (v2 :: Val) <- nthArg 2
              unless (comp v1 v2 == Just EQ) $ fail "Assertion failed"
              pure 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
              (v1 :: Val) <- Int -> ReaderT Arguments (MP m') Val
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
              (v2 :: Val) <- nthArg 2
              unless (comp v1 v2 /= Just EQ) $ fail "Assertion failed"
              pure 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. HasCallStack => String -> ReaderT Arguments (MP m') a
forall (m :: * -> *) a.
(MonadFail m, HasCallStack) =>
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
        (x :: Val) <- Int -> ReaderT Arguments (MP m') Val
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
        pure $ VType $ valType 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
<$> (Ratio Integer
-> Ratio Integer -> Ratio Integer -> Ratio Integer -> Color
CMYK (Ratio Integer
 -> Ratio Integer -> Ratio Integer -> Ratio Integer -> Color)
-> ReaderT Arguments (MP m') (Ratio Integer)
-> ReaderT
     Arguments
     (MP m')
     (Ratio Integer -> Ratio Integer -> Ratio Integer -> Color)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ReaderT Arguments (MP m') (Ratio Integer)
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1 ReaderT
  Arguments
  (MP m')
  (Ratio Integer -> Ratio Integer -> Ratio Integer -> Color)
-> ReaderT Arguments (MP m') (Ratio Integer)
-> ReaderT
     Arguments (MP m') (Ratio Integer -> Ratio Integer -> 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') (Ratio Integer)
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
2 ReaderT Arguments (MP m') (Ratio Integer -> Ratio Integer -> Color)
-> ReaderT Arguments (MP m') (Ratio Integer)
-> ReaderT Arguments (MP m') (Ratio Integer -> 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') (Ratio Integer)
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
3 ReaderT Arguments (MP m') (Ratio Integer -> Color)
-> ReaderT Arguments (MP m') (Ratio Integer)
-> 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') (Ratio Integer)
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
4)
    ),
    ( 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) <- 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
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
        lift $ updateState $ \EvalState m'
st ->
          EvalState m'
st {evalCounters = M.alter initializeIfMissing counter $ evalCounters st}
        pure $ VCounter 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
<$> (Ratio Integer -> Color
Luma (Ratio Integer -> Color)
-> ReaderT Arguments (MP m') (Ratio Integer)
-> ReaderT Arguments (MP m') Color
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ReaderT Arguments (MP m') (Ratio Integer)
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
        first <- Int -> ReaderT Arguments (MP m') Integer
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
        mbsecond <- nthArg 2
        step <- namedArg "step" 1
        pure $
          VArray $
            V.fromList $
              map VInteger $
                case (first, 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
"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
<$> ( ( Ratio Integer
-> Ratio Integer -> Ratio Integer -> Ratio Integer -> Color
RGB
                    (Ratio Integer
 -> Ratio Integer -> Ratio Integer -> Ratio Integer -> Color)
-> ReaderT Arguments (MP m') (Ratio Integer)
-> ReaderT
     Arguments
     (MP m')
     (Ratio Integer -> Ratio Integer -> Ratio Integer -> 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') (Ratio Integer))
-> ReaderT Arguments (MP m') (Ratio 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') (Ratio Integer)
forall (m :: * -> *). MonadFail m => Val -> m (Ratio Integer)
toRatio)
                    ReaderT
  Arguments
  (MP m')
  (Ratio Integer -> Ratio Integer -> Ratio Integer -> Color)
-> ReaderT Arguments (MP m') (Ratio Integer)
-> ReaderT
     Arguments (MP m') (Ratio Integer -> Ratio Integer -> 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') (Ratio Integer))
-> ReaderT Arguments (MP m') (Ratio 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') (Ratio Integer)
forall (m :: * -> *). MonadFail m => Val -> m (Ratio Integer)
toRatio)
                    ReaderT Arguments (MP m') (Ratio Integer -> Ratio Integer -> Color)
-> ReaderT Arguments (MP m') (Ratio Integer)
-> ReaderT Arguments (MP m') (Ratio Integer -> 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') (Ratio Integer))
-> ReaderT Arguments (MP m') (Ratio 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') (Ratio Integer)
forall (m :: * -> *). MonadFail m => Val -> m (Ratio Integer)
toRatio)
                    ReaderT Arguments (MP m') (Ratio Integer -> Color)
-> ReaderT Arguments (MP m') (Ratio Integer)
-> 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') (Ratio Integer))
-> ReaderT Arguments (MP m') (Ratio 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') (Ratio Integer)
forall (m :: * -> *). MonadFail m => Val -> m (Ratio Integer)
toRatio) ReaderT Arguments (MP m') (Ratio Integer)
-> ReaderT Arguments (MP m') (Ratio Integer)
-> ReaderT Arguments (MP m') (Ratio Integer)
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` Ratio Integer -> ReaderT Arguments (MP m') (Ratio Integer)
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ratio Integer
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
"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
        (num :: Int) <- Int -> ReaderT Arguments (MP m') Int
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
        pure $ VString $ T.unwords $ take num 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 (Ratio Integer)
toRatio (VRatio Ratio Integer
r) = Ratio Integer -> m (Ratio Integer)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ratio Integer
r
toRatio (VInteger Integer
i) = Ratio Integer -> m (Ratio Integer)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ratio Integer -> m (Ratio Integer))
-> Ratio Integer -> m (Ratio Integer)
forall a b. (a -> b) -> a -> b
$ Integer
i Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
255
toRatio Val
_ = String -> m (Ratio Integer)
forall a. HasCallStack => String -> m a
forall (m :: * -> *) a.
(MonadFail m, HasCallStack) =>
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
  parts <-
    (Text -> Maybe (Ratio Integer))
-> [Text] -> [Maybe (Ratio Integer)]
forall a b. (a -> b) -> [a] -> [b]
map ((Integer -> Ratio Integer)
-> Maybe Integer -> Maybe (Ratio Integer)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
255) (Maybe Integer -> Maybe (Ratio Integer))
-> (Text -> Maybe Integer) -> Text -> Maybe (Ratio Integer)
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 (Ratio Integer)])
-> m [Text] -> m [Maybe (Ratio Integer)]
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. HasCallStack => String -> m a
forall (m :: * -> *) a.
(MonadFail m, HasCallStack) =>
String -> m a
fail String
"hex string must be 3, 4, 6, or 8 digits"
  case parts of
    [Just Ratio Integer
r, Just Ratio Integer
g, Just Ratio Integer
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
$ Ratio Integer
-> Ratio Integer -> Ratio Integer -> Ratio Integer -> Color
RGB Ratio Integer
r Ratio Integer
g Ratio Integer
b Ratio Integer
1.0
    [Just Ratio Integer
r, Just Ratio Integer
g, Just Ratio Integer
b, Just Ratio Integer
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
$ Ratio Integer
-> Ratio Integer -> Ratio Integer -> Ratio Integer -> Color
RGB Ratio Integer
r Ratio Integer
g Ratio Integer
b Ratio Integer
o
    [Maybe (Ratio Integer)]
_ -> String -> m Color
forall a. HasCallStack => String -> m a
forall (m :: * -> *) a.
(MonadFail m, HasCallStack) =>
String -> m a
fail String
"could not read string as hex color"
hexToRGB Val
_ = String -> m Color
forall a. HasCallStack => String -> m a
forall (m :: * -> *) a.
(MonadFail m, HasCallStack) =>
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 <- 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
  path <- getPath fp
  lift $ BL.fromStrict <$> loadBytes operations path

loadFileText :: Monad m => FilePath -> MP m T.Text
loadFileText :: forall (m :: * -> *). Monad m => String -> MP m Text
loadFileText String
fp = do
  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
  path <- getPath fp
  lift $ TE.decodeUtf8 <$> loadBytes operations path

-- a leading / = relative to package root
getPath :: Monad m => FilePath -> MP m FilePath
getPath :: forall (m :: * -> *). Monad m => String -> MP m String
getPath (Char
'/':String
fp') = do
  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
  pure $ root </> fp'
getPath String
fp = do
  pkgroot <- 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
  localdir <- evalLocalDir <$> getState
  pure $ normalise $ pkgroot </> localdir </> fp

getUTCTime :: Monad m => MP m UTCTime
getUTCTime :: forall (m :: * -> *). Monad m => MP m UTCTime
getUTCTime = ParsecT [Markup] (EvalState m) m (EvalState m)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState ParsecT [Markup] (EvalState m) m (EvalState m)
-> (EvalState m -> 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 (m UTCTime -> ParsecT [Markup] (EvalState m) m UTCTime)
-> (EvalState m -> m UTCTime)
-> EvalState m
-> ParsecT [Markup] (EvalState m) m UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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

time :: [(Identifier, Val)]
time :: [(Identifier, Val)]
time =
  [ ( Identifier
"datetime", (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Map Identifier Val -> Val
makeFunctionWithScope
      (do
         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
         mbmonth <- namedArg "month" Nothing
         mbday <- namedArg "day" Nothing
         let 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
         mbhour <- namedArg "hour" Nothing
         mbminute <- namedArg "minute" Nothing
         mbsecond <- namedArg "second" Nothing
         let 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
         pure $ VDateTime mbdate 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 <- 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
            pure $ VDateTime (Just (utctDay utcTime)) (Just (utctDayTime 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
        fp <- Int -> ReaderT Arguments (MP m') String
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
        bs <- lift $ loadFileLazyBytes fp
        case Csv.decode Csv.NoHeader bs of
          Left String
e -> String -> ReaderT Arguments (MP m') Val
forall a. HasCallStack => String -> ReaderT Arguments (MP m') a
forall (m :: * -> *) a.
(MonadFail m, HasCallStack) =>
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
        bs <- ReaderT Arguments (MP m') ByteString
forall (m :: * -> *).
Monad m =>
ReaderT Arguments (MP m) ByteString
getFileOrBytes
        case Aeson.eitherDecode bs of
          Left String
e -> String -> ReaderT Arguments (MP m') Val
forall a. HasCallStack => String -> ReaderT Arguments (MP m') a
forall (m :: * -> *) a.
(MonadFail m, HasCallStack) =>
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
        bs <- ReaderT Arguments (MP m') ByteString
forall (m :: * -> *).
Monad m =>
ReaderT Arguments (MP m) ByteString
getFileOrBytes
        case Yaml.decodeEither' (BL.toStrict bs) of
          Left ParseException
e -> String -> ReaderT Arguments (MP m') Val
forall a. HasCallStack => String -> ReaderT Arguments (MP m') a
forall (m :: * -> *) a.
(MonadFail m, HasCallStack) =>
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
        fp <- Int -> ReaderT Arguments (MP m') String
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
        enc <- namedArg "encoding" (VString "utf-8")
        case enc of
          Val
VNone -> do 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
                      pure $ VBytes $ BL.toStrict bs
          Val
_ -> do 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
                  pure $ VString 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
        bs <- ReaderT Arguments (MP m') ByteString
forall (m :: * -> *).
Monad m =>
ReaderT Arguments (MP m) ByteString
getFileOrBytes
        case Toml.decode (TE.decodeUtf8 $ BL.toStrict bs) of
          Toml.Failure [String]
e -> String -> ReaderT Arguments (MP m') Val
forall a. HasCallStack => String -> ReaderT Arguments (MP m') a
forall (m :: * -> *) a.
(MonadFail m, HasCallStack) =>
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
        bs <- ReaderT Arguments (MP m') ByteString
forall (m :: * -> *).
Monad m =>
ReaderT Arguments (MP m) ByteString
getFileOrBytes
        case XML.parseLBS XML.def bs of
          Left SomeException
e -> String -> ReaderT Arguments (MP m') Val
forall a. HasCallStack => String -> ReaderT Arguments (MP m') a
forall (m :: * -> *) a.
(MonadFail m, HasCallStack) =>
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, mempty)]
                 , evalMathIdentifiers = [(BlockScope, mathModule <> symModule)]
                 , evalStandardIdentifiers = [(BlockScope, standardModule)]
                 }

getFileOrBytes :: Monad m => ReaderT Arguments (MP m) BL.ByteString
getFileOrBytes :: forall (m :: * -> *).
Monad m =>
ReaderT Arguments (MP m) ByteString
getFileOrBytes = do
  v <- Int -> ReaderT Arguments (MP m) Val
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
  case v of
    VString Text
fp -> 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 (Text -> String
T.unpack Text
fp)
    VBytes StrictByteString
bs -> ByteString -> ReaderT Arguments (MP m) ByteString
forall a. a -> ReaderT Arguments (MP m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> ReaderT Arguments (MP m) ByteString)
-> ByteString -> ReaderT Arguments (MP m) ByteString
forall a b. (a -> b) -> a -> b
$ StrictByteString -> ByteString
BL.fromStrict StrictByteString
bs
    Val
_ -> String -> ReaderT Arguments (MP m) ByteString
forall a. HasCallStack => String -> ReaderT Arguments (MP m) a
forall (m :: * -> *) a.
(MonadFail m, HasCallStack) =>
String -> m a
fail String
"expecting file path or bytes"