{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Typst.Module.Standard
( standardModule,
loadFileText,
)
where
import Control.Applicative ((<|>))
import Control.Monad (mplus, unless)
import Control.Monad.Reader (lift)
import qualified Data.Aeson as Aeson
import qualified Data.ByteString.Lazy as BL
import qualified Data.Csv as Csv
import qualified Data.Map as M
import qualified Data.Map.Ordered as OM
import Data.Maybe (mapMaybe)
import Data.Ratio ((%))
import qualified Data.Sequence as Seq
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified Data.Vector as V
import qualified Data.Yaml as Yaml
import Text.Parsec (getPosition, getState, updateState)
import Text.Read (readMaybe)
import qualified Text.XML as XML
import Typst.Emoji (typstEmojis)
import Typst.Module.Calc (calcModule)
import Typst.Module.Math (mathModule)
import Typst.Regex (makeRE)
import Typst.Symbols (typstSymbols)
import Typst.Types
import Typst.Util
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)
]
[(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)]
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
$ [(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
"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)]],
Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement Maybe Identifier
forall a. Maybe a
Nothing Identifier
"move" [(Identifier
"body", ValType -> TypeSpec
One ValType
TContent)],
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)],
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
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))
]
)
]
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
"keys", ValType -> TypeSpec
Many ValType
TString),
(Identifier
"supplement", ValType -> TypeSpec
One (ValType
TContent ValType -> ValType -> ValType
:|: ValType
TNone))
],
Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement 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
"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)] -> (Identifier, Val)
makeElement Maybe Identifier
forall a. Maybe a
Nothing Identifier
"outline" [],
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
"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)] -> (Identifier, Val)
makeElement Maybe Identifier
forall a. Maybe a
Nothing Identifier
"style" [(Identifier
"func", ValType -> TypeSpec
One ValType
TFunction)],
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)]]
]
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 -> ReaderT Arguments (MP m') String
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Identifier -> ReaderT Arguments (MP m) a
namedArg Identifier
"message" ReaderT Arguments (MP m') String
-> ReaderT Arguments (MP m') String
-> ReaderT Arguments (MP m') String
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
<|> String -> ReaderT Arguments (MP m') String
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure 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
. [String] -> String
unlines ([String] -> String) -> ([Val] -> [String]) -> [Val] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Val -> String) -> [Val] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Val -> String
forall a. Show a => a -> String
show),
(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
$
Text -> Val
VString (Text -> Val) -> Text -> Val
forall a b. (a -> b) -> a -> b
$
case Val -> ValType
valType Val
x of
ValType
TAlignment ->
case Val
x of
VAlignment (Just Horiz
_) (Just Vert
_) -> Text
"2d alignment"
Val
_ -> Text
"alignment"
ValType
TDict -> Text
"dictionary"
ValType
ty -> Text -> Text
T.toLower (Text -> Text) -> (ValType -> Text) -> ValType -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
T.drop Int
1 (Text -> Text) -> (ValType -> Text) -> ValType -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (ValType -> String) -> ValType -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValType -> String
forall a. Show a => a -> String
show (ValType -> Text) -> ValType -> Text
forall a b. (a -> b) -> a -> b
$ ValType
ty
)
]
construct :: [(Identifier, Val)]
construct :: [(Identifier, Val)]
construct =
[ ( Identifier
"cmyk",
(forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (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 :: Map Counter Integer
evalCounters = (Maybe Integer -> Maybe Integer)
-> Counter -> Map Counter Integer -> Map Counter Integer
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter Maybe Integer -> Maybe Integer
forall {a}. Num a => Maybe a -> Maybe a
initializeIfMissing Counter
counter (Map Counter Integer -> Map Counter Integer)
-> Map Counter Integer -> Map Counter Integer
forall a b. (a -> b) -> a -> b
$ EvalState m' -> Map Counter Integer
forall (m :: * -> *). EvalState m -> Map Counter Integer
evalCounters EvalState m'
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 ReaderT Arguments (MP m') (Maybe Integer)
-> ReaderT Arguments (MP m') (Maybe Integer)
-> ReaderT Arguments (MP m') (Maybe 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` ((Integer -> Integer) -> Maybe Integer -> Maybe 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 -> Integer
forall a. Num a => a -> a -> a
+ Integer
first) (Maybe Integer -> Maybe Integer)
-> ReaderT Arguments (MP m') (Maybe Integer)
-> ReaderT Arguments (MP m') (Maybe Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Identifier -> ReaderT Arguments (MP m') (Maybe Integer)
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Identifier -> ReaderT Arguments (MP m) a
namedArg Identifier
"count")
Integer
step <- Identifier -> ReaderT Arguments (MP m') Integer
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Identifier -> ReaderT Arguments (MP m) a
namedArg Identifier
"step" ReaderT Arguments (MP m') Integer
-> ReaderT Arguments (MP m') Integer
-> ReaderT Arguments (MP m') 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` Integer -> ReaderT Arguments (MP m') Integer
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure 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)
-> 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
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
<$> (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
"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
String -> m ByteString
loadBytes <- EvalState m -> String -> m ByteString
forall (m :: * -> *). EvalState m -> String -> m ByteString
evalLoadBytes (EvalState m -> String -> m ByteString)
-> ParsecT [Markup] (EvalState m) m (EvalState m)
-> ParsecT [Markup] (EvalState m) m (String -> m ByteString)
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
<$> String -> m ByteString
loadBytes String
fp
loadFileText :: Monad m => FilePath -> MP m T.Text
loadFileText :: forall (m :: * -> *). Monad m => String -> MP m Text
loadFileText String
fp = do
String -> m ByteString
loadBytes <- EvalState m -> String -> m ByteString
forall (m :: * -> *). EvalState m -> String -> m ByteString
evalLoadBytes (EvalState m -> String -> m ByteString)
-> ParsecT [Markup] (EvalState m) m (EvalState m)
-> ParsecT [Markup] (EvalState m) m (String -> m ByteString)
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
<$> String -> m ByteString
loadBytes String
fp
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
$ String -> ReaderT Arguments (MP m') Val
forall a. String -> ReaderT Arguments (MP m') a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unimplemented toml"),
( Identifier
"xml",
(forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (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)
)
]
)
]