{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Typst.Module.Standard
( standardModule,
symModule,
sysModule,
loadFileText,
applyPureFunction
)
where
import Paths_typst (version)
import Data.Version (showVersion)
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.Emoji (typstEmojis)
import Typst.Module.Calc (calcModule)
import Typst.Module.Math (mathModule)
import Typst.Symbols (typstSymbols)
import Typst.Types
import Typst.Util
import System.FilePath ((</>))
import Data.Time (UTCTime(..))
import Data.Time.Calendar (fromGregorianValid)
import Data.Time.Clock (secondsToDiffTime)
standardModule :: M.Map Identifier Val
standardModule :: Map Identifier Val
standardModule =
[(Identifier, Val)] -> Map Identifier Val
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Identifier, Val)] -> Map Identifier Val)
-> [(Identifier, Val)] -> Map Identifier Val
forall a b. (a -> b) -> a -> b
$
[ (Identifier
"math", Identifier -> Map Identifier Val -> Val
VModule Identifier
"math" Map Identifier Val
mathModule),
(Identifier
"sym", Identifier -> Map Identifier Val -> Val
VModule Identifier
"sym" Map Identifier Val
symModule),
(Identifier
"sys", Identifier -> Map Identifier Val -> Val
VModule Identifier
"sys" Map Identifier Val
sysModule),
(Identifier
"emoji", Identifier -> Map Identifier Val -> Val
VModule Identifier
"emoji" Map Identifier Val
emojiModule),
(Identifier
"calc", Identifier -> Map Identifier Val -> Val
VModule Identifier
"calc" Map Identifier Val
calcModule)
]
[(Identifier, Val)] -> [(Identifier, Val)] -> [(Identifier, Val)]
forall a. [a] -> [a] -> [a]
++ [(Identifier, Val)]
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
sysModule :: M.Map Identifier Val
sysModule :: Map Identifier Val
sysModule =
[(Identifier, Val)] -> Map Identifier Val
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [ (Identifier
"version", [Integer] -> Val
VVersion [Integer
Item [Integer]
0,Integer
Item [Integer]
12,Integer
Item [Integer]
0])
, (Identifier
"inputs", OMap Identifier Val -> Val
VDict ([(Identifier, Val)] -> OMap Identifier Val
forall k v. Ord k => [(k, v)] -> OMap k v
OM.fromList
[(Identifier
"typst-hs-version",
Text -> Val
VString (String -> Text
T.pack (Version -> String
showVersion Version
version)))]))
]
symModule :: M.Map Identifier Val
symModule :: Map Identifier Val
symModule = (Symbol -> Val) -> Map Identifier Symbol -> Map Identifier Val
forall a b k. (a -> b) -> Map k a -> Map k b
M.map Symbol -> Val
VSymbol (Map Identifier Symbol -> Map Identifier Val)
-> Map Identifier Symbol -> Map Identifier Val
forall a b. (a -> b) -> a -> b
$ [(Text, Bool, Text)] -> Map Identifier Symbol
makeSymbolMap [(Text, Bool, Text)]
typstSymbols
emojiModule :: M.Map Identifier Val
emojiModule :: Map Identifier Val
emojiModule = (Symbol -> Val) -> Map Identifier Symbol -> Map Identifier Val
forall a b k. (a -> b) -> Map k a -> Map k b
M.map Symbol -> Val
VSymbol (Map Identifier Symbol -> Map Identifier Val)
-> Map Identifier Symbol -> Map Identifier Val
forall a b. (a -> b) -> a -> b
$ [(Text, Bool, Text)] -> Map Identifier Symbol
makeSymbolMap [(Text, Bool, Text)]
typstEmojis
textual :: [(Identifier, Val)]
textual :: [(Identifier, Val)]
textual =
[ Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement
Maybe Identifier
forall a. Maybe a
Nothing
Identifier
"text"
[ (Identifier
"color", ValType -> TypeSpec
One ValType
TColor),
(Identifier
"size", ValType -> TypeSpec
One ValType
TLength),
(Identifier
"body", ValType -> TypeSpec
One (ValType
TContent ValType -> ValType -> ValType
:|: ValType
TString ValType -> ValType -> ValType
:|: ValType
TSymbol))
],
Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement Maybe Identifier
forall a. Maybe a
Nothing Identifier
"emph" [(Identifier
"body", ValType -> TypeSpec
One ValType
TContent)],
Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement Maybe Identifier
forall a. Maybe a
Nothing Identifier
"linebreak" [],
Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement Maybe Identifier
forall a. Maybe a
Nothing Identifier
"strong" [(Identifier
"body", ValType -> TypeSpec
One ValType
TContent)],
Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement Maybe Identifier
forall a. Maybe a
Nothing Identifier
"sub" [(Identifier
"body", ValType -> TypeSpec
One ValType
TContent)],
Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement Maybe Identifier
forall a. Maybe a
Nothing Identifier
"super" [(Identifier
"body", ValType -> TypeSpec
One ValType
TContent)],
Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement Maybe Identifier
forall a. Maybe a
Nothing Identifier
"strike" [(Identifier
"body", ValType -> TypeSpec
One ValType
TContent)],
Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement Maybe Identifier
forall a. Maybe a
Nothing Identifier
"smallcaps" [(Identifier
"body", ValType -> TypeSpec
One ValType
TContent)],
Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement Maybe Identifier
forall a. Maybe a
Nothing Identifier
"underline" [(Identifier
"body", ValType -> TypeSpec
One ValType
TContent)],
Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement Maybe Identifier
forall a. Maybe a
Nothing Identifier
"overline" [(Identifier
"body", ValType -> TypeSpec
One ValType
TContent)],
Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement Maybe Identifier
forall a. Maybe a
Nothing Identifier
"highlight" [(Identifier
"body", ValType -> TypeSpec
One ValType
TContent)],
Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement Maybe Identifier
forall a. Maybe a
Nothing Identifier
"raw" [(Identifier
"text", ValType -> TypeSpec
One ValType
TString)],
Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement Maybe Identifier
forall a. Maybe a
Nothing Identifier
"smartquote" [],
Maybe Identifier
-> Identifier -> [(Identifier, TypeSpec)] -> (Identifier, Val)
makeElement Maybe Identifier
forall a. Maybe a
Nothing Identifier
"lower" [(Identifier
"text", ValType -> TypeSpec
One (ValType
TString ValType -> ValType -> ValType
:|: ValType
TContent))],
( Identifier
"lower",
(forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val)
-> (forall (m' :: * -> *).
Monad m' =>
ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
val <- 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. 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 <- 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. 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
"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)]],
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)]
-> 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
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
"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
"source", 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" [],
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. String -> ReaderT Arguments (MP m') a
forall (m :: * -> *) a. MonadFail m => 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
$ 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
(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. String -> ReaderT Arguments (MP m') a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ReaderT Arguments (MP m') Val)
-> ([Val] -> String) -> [Val] -> ReaderT Arguments (MP m') Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> ([Val] -> Text) -> [Val] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
((Text
"panicked with: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> ([Val] -> Text) -> [Val] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines ([Text] -> Text) -> ([Val] -> [Text]) -> [Val] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Val -> Text) -> [Val] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Val -> Text
repr)),
(Identifier
"repr", (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val)
-> (forall (m' :: * -> *).
Monad m' =>
ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ Int -> ReaderT Arguments (MP m') Val
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1 ReaderT Arguments (MP m') Val
-> (Val -> ReaderT Arguments (MP m') Val)
-> ReaderT Arguments (MP m') Val
forall a b.
ReaderT Arguments (MP m') a
-> (a -> ReaderT Arguments (MP m') b)
-> ReaderT Arguments (MP m') b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> (Val -> Val) -> Val -> ReaderT Arguments (MP m') Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Val
VString (Text -> Val) -> (Val -> Text) -> Val -> Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Val -> Text
repr),
( Identifier
"type",
(forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val)
-> (forall (m' :: * -> *).
Monad m' =>
ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
(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
<$> (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
"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
<$> (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
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
<$> ( ( 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
"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 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
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 parts of
[Just Rational
r, Just Rational
g, Just Rational
b] -> Color -> m Color
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Color -> m Color) -> Color -> m Color
forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational -> Rational -> Color
RGB Rational
r Rational
g Rational
b Rational
1.0
[Just Rational
r, Just Rational
g, Just Rational
b, Just Rational
o] -> Color -> m Color
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Color -> m Color) -> Color -> m Color
forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational -> Rational -> Color
RGB Rational
r Rational
g Rational
b Rational
o
[Maybe Rational]
_ -> String -> m Color
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"could not read string as hex color"
hexToRGB Val
_ = String -> m Color
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected string"
loadFileLazyBytes :: Monad m => FilePath -> MP m BL.ByteString
loadFileLazyBytes :: forall (m :: * -> *). Monad m => String -> MP m ByteString
loadFileLazyBytes String
fp = do
operations <- 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
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 $ 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. 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
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. 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
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. 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
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. String -> ReaderT Arguments (MP m') a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ([String] -> String
unlines (String
"toml errors:" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
e))
Toml.Success [String]
_ Val
v -> Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
v
),
( Identifier
"xml",
(forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val)
-> (forall (m' :: * -> *).
Monad m' =>
ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
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. String -> ReaderT Arguments (MP m') a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ReaderT Arguments (MP m') Val)
-> String -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ SomeException -> String
forall a. Show a => a -> String
show SomeException
e
Right Document
doc ->
Val -> ReaderT Arguments (MP m') Val
forall a. a -> ReaderT Arguments (MP m') a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> ReaderT Arguments (MP m') Val)
-> Val -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$
Vector Val -> Val
VArray (Vector Val -> Val) -> Vector Val -> Val
forall a b. (a -> b) -> a -> b
$
[Val] -> Vector Val
forall a. [a] -> Vector a
V.fromList ([Val] -> Vector Val) -> [Val] -> Vector Val
forall a b. (a -> b) -> a -> b
$
(Node -> Maybe Val) -> [Node] -> [Val]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
Node -> Maybe Val
nodeToVal
[Element -> Node
XML.NodeElement (Document -> Element
XML.documentRoot Document
doc)]
where
showname :: Name -> Text
showname Name
n = Name -> Text
XML.nameLocalName Name
n
nodeToVal :: Node -> Maybe Val
nodeToVal (XML.NodeElement Element
elt) = Val -> Maybe Val
forall a. a -> Maybe a
Just (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Element -> Val
eltToDict Element
elt
nodeToVal (XML.NodeContent Text
t) = Val -> Maybe Val
forall a. a -> Maybe a
Just (Val -> Maybe Val) -> Val -> Maybe Val
forall a b. (a -> b) -> a -> b
$ Text -> Val
VString Text
t
nodeToVal Node
_ = Maybe Val
forall a. Maybe a
Nothing
eltToDict :: Element -> Val
eltToDict Element
elt =
OMap Identifier Val -> Val
VDict (OMap Identifier Val -> Val) -> OMap Identifier Val -> Val
forall a b. (a -> b) -> a -> b
$
[(Identifier, Val)] -> OMap Identifier Val
forall k v. Ord k => [(k, v)] -> OMap k v
OM.fromList
[ (Identifier
"tag", Text -> Val
VString (Text -> Val) -> Text -> Val
forall a b. (a -> b) -> a -> b
$ Name -> Text
showname (Element -> Name
XML.elementName Element
elt)),
( Identifier
"attrs",
OMap Identifier Val -> Val
VDict (OMap Identifier Val -> Val) -> OMap Identifier Val -> Val
forall a b. (a -> b) -> a -> b
$
[(Identifier, Val)] -> OMap Identifier Val
forall k v. Ord k => [(k, v)] -> OMap k v
OM.fromList ([(Identifier, Val)] -> OMap Identifier Val)
-> [(Identifier, Val)] -> OMap Identifier Val
forall a b. (a -> b) -> a -> b
$
((Name, Text) -> (Identifier, Val))
-> [(Name, Text)] -> [(Identifier, Val)]
forall a b. (a -> b) -> [a] -> [b]
map
(\(Name
k, Text
v) -> (Text -> Identifier
Identifier (Name -> Text
showname Name
k), Text -> Val
VString Text
v))
(Map Name Text -> [(Name, Text)]
forall k a. Map k a -> [(k, a)]
M.toList (Map Name Text -> [(Name, Text)])
-> Map Name Text -> [(Name, Text)]
forall a b. (a -> b) -> a -> b
$ Element -> Map Name Text
XML.elementAttributes Element
elt)
),
( Identifier
"children",
Vector Val -> Val
VArray (Vector Val -> Val) -> Vector Val -> Val
forall a b. (a -> b) -> a -> b
$
[Val] -> Vector Val
forall a. [a] -> Vector a
V.fromList ([Val] -> Vector Val) -> [Val] -> Vector Val
forall a b. (a -> b) -> a -> b
$
(Node -> Maybe Val) -> [Node] -> [Val]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Node -> Maybe Val
nodeToVal (Element -> [Node]
XML.elementNodes Element
elt)
)
]
)
]
applyPureFunction :: Function -> [Val] -> Attempt Val
applyPureFunction :: Function -> [Val] -> Attempt Val
applyPureFunction (Function forall (m :: * -> *). Monad m => Arguments -> MP m Val
f) [Val]
vals =
let args :: Arguments
args = [Val] -> OMap Identifier Val -> Arguments
Arguments [Val]
vals OMap Identifier Val
forall k v. OMap k v
OM.empty
in case ParsecT [Markup] (EvalState Attempt) Attempt Val
-> EvalState Attempt
-> String
-> [Markup]
-> Attempt (Either ParseError Val)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> u -> String -> s -> m (Either ParseError a)
runParserT (Arguments -> ParsecT [Markup] (EvalState Attempt) Attempt Val
forall (m :: * -> *). Monad m => Arguments -> MP m Val
f Arguments
args) EvalState Attempt
forall (m :: * -> *). MonadFail m => EvalState m
initialEvalState String
"" [] of
Failure String
s -> String -> Attempt Val
forall a. String -> Attempt a
Failure String
s
Success (Left ParseError
s) -> String -> Attempt Val
forall a. String -> Attempt a
Failure (String -> Attempt Val) -> String -> Attempt Val
forall a b. (a -> b) -> a -> b
$ ParseError -> String
forall a. Show a => a -> String
show ParseError
s
Success (Right Val
v) -> Val -> Attempt Val
forall a. a -> Attempt a
Success Val
v
initialEvalState :: MonadFail m => EvalState m
initialEvalState :: forall (m :: * -> *). MonadFail m => EvalState m
initialEvalState =
EvalState m
forall (m :: * -> *). EvalState m
emptyEvalState { evalIdentifiers = [(BlockScope, 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. String -> ReaderT Arguments (MP m) a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expecting file path or bytes"