{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Typst.Evaluate
( evaluateTypst,
valToContent,
)
where
import Control.Monad (MonadPlus (mplus), foldM, foldM_)
import Control.Monad.State (MonadTrans (lift))
import Data.List (intersperse, sortOn)
import qualified Data.Map as M
import qualified Data.Map.Ordered as OM
import Data.Maybe (isJust, fromMaybe)
import Data.Sequence (Seq)
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 GHC.Generics (Generic)
import System.FilePath (replaceFileName, takeBaseName,
takeFileName, takeDirectory, (</>))
import Text.Parsec
import Typst.Bind (destructuringBind)
import Typst.Constructors (getConstructor)
import Typst.Methods (getMethod)
import Typst.Module.Standard (loadFileText, standardModule, symModule)
import Typst.Module.Math (mathModule)
import Typst.MathClass (mathClassOf, MathClass(Relation))
import Typst.Parse (parseTypst)
import Typst.Regex (match)
import Typst.Show (applyShowRules)
import Typst.Syntax
import Typst.Types
import Typst.Util (makeFunction, nthArg)
import qualified Toml as Toml
import qualified Toml.Schema as Toml
evaluateTypst ::
Monad m =>
Operations m ->
FilePath ->
[Markup] ->
m (Either ParseError Content)
evaluateTypst :: forall (m :: * -> *).
Monad m =>
Operations m
-> FilePath -> [Markup] -> m (Either ParseError Content)
evaluateTypst Operations m
operations FilePath
fp =
ParsecT [Markup] (EvalState m) m Content
-> EvalState m
-> FilePath
-> [Markup]
-> m (Either ParseError Content)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> u -> FilePath -> s -> m (Either ParseError a)
runParserT
(do contents <- [Seq Content] -> Seq Content
forall a. Monoid a => [a] -> a
mconcat ([Seq Content] -> Seq Content)
-> ParsecT [Markup] (EvalState m) m [Seq Content]
-> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Markup] (EvalState m) m (Seq Content)
-> ParsecT [Markup] (EvalState m) m [Seq Content]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *). Monad m => MP m (Seq Content)
pContent ParsecT [Markup] (EvalState m) m (Seq Content)
-> ParsecT [Markup] (EvalState m) m ()
-> ParsecT [Markup] (EvalState m) m (Seq Content)
forall a b.
ParsecT [Markup] (EvalState m) m a
-> ParsecT [Markup] (EvalState m) m b
-> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT [Markup] (EvalState m) m ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
pure $ Elt "document" Nothing [("body", VContent contents)])
EvalState (ZonkAny 1)
forall (m :: * -> *). EvalState m
initialEvalState { evalOperations = operations,
evalLocalDir = takeDirectory fp }
FilePath
fp
initialEvalState :: EvalState m
initialEvalState :: forall (m :: * -> *). EvalState m
initialEvalState =
EvalState m
forall (m :: * -> *). EvalState m
emptyEvalState { evalIdentifiers = [(BlockScope, mempty)]
, evalMathIdentifiers = [(BlockScope, mathModule <> symModule)]
, evalStandardIdentifiers = [(BlockScope, standardModule'')]
, evalPackageRoot = "."
}
where
standardModule' :: Map Identifier Val
standardModule' = Identifier -> Val -> Map Identifier Val -> Map Identifier Val
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Identifier
"eval" Val
evalFunction Map Identifier Val
standardModule
standardModule'' :: Map Identifier Val
standardModule'' = Identifier -> Val -> Map Identifier Val -> Map Identifier Val
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Identifier
"std" (Identifier -> Map Identifier Val -> Val
VModule Identifier
"std" Map Identifier Val
standardModule') Map Identifier Val
standardModule'
evalFunction :: Val
evalFunction = (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
code :: Text <- Int -> ReaderT Arguments (MP m') Text
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
case parseTypst "eval" ("#{\n" <> code <> "\n}") of
Left ParseError
e -> FilePath -> ReaderT Arguments (MP m') Val
forall a. FilePath -> ReaderT Arguments (MP m') a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> ReaderT Arguments (MP m') Val)
-> FilePath -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ FilePath
"eval: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> ParseError -> FilePath
forall a. Show a => a -> FilePath
show ParseError
e
Right [Code SourcePos
_ Expr
expr] ->
case ParsecT [Markup] (EvalState Attempt) Attempt Val
-> EvalState Attempt
-> FilePath
-> [Markup]
-> Attempt (Either ParseError Val)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> u -> FilePath -> s -> m (Either ParseError a)
runParserT (Expr -> ParsecT [Markup] (EvalState Attempt) Attempt Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
expr) EvalState Attempt
forall (m :: * -> *). EvalState m
initialEvalState FilePath
"eval" [] of
Failure FilePath
e -> FilePath -> ReaderT Arguments (MP m') Val
forall a. FilePath -> ReaderT Arguments (MP m') a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> ReaderT Arguments (MP m') Val)
-> FilePath -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ FilePath
"eval: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
e
Success (Left ParseError
e) -> FilePath -> ReaderT Arguments (MP m') Val
forall a. FilePath -> ReaderT Arguments (MP m') a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> ReaderT Arguments (MP m') Val)
-> FilePath -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ FilePath
"eval: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> ParseError -> FilePath
forall a. Show a => a -> FilePath
show ParseError
e
Success (Right Val
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
val
Right [Markup]
_ -> FilePath -> ReaderT Arguments (MP m') Val
forall a. FilePath -> ReaderT Arguments (MP m') a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"eval: got something other than Code (should not happen)"
satisfyTok :: Monad m => (Markup -> Bool) -> MP m Markup
satisfyTok :: forall (m :: * -> *). Monad m => (Markup -> Bool) -> MP m Markup
satisfyTok Markup -> Bool
f = (Markup -> FilePath)
-> (SourcePos -> Markup -> [Markup] -> SourcePos)
-> (Markup -> Maybe Markup)
-> ParsecT [Markup] (EvalState m) m Markup
forall s (m :: * -> *) t a u.
Stream s m t =>
(t -> FilePath)
-> (SourcePos -> t -> s -> SourcePos)
-> (t -> Maybe a)
-> ParsecT s u m a
tokenPrim Markup -> FilePath
forall a. Show a => a -> FilePath
show SourcePos -> Markup -> [Markup] -> SourcePos
forall {p}. SourcePos -> Markup -> p -> SourcePos
showPos Markup -> Maybe Markup
match'
where
showPos :: SourcePos -> Markup -> p -> SourcePos
showPos SourcePos
_oldpos (Code SourcePos
pos Expr
_) p
_ = SourcePos
pos
showPos SourcePos
oldpos Markup
_ p
_ = SourcePos
oldpos
match' :: Markup -> Maybe Markup
match' Markup
x | Markup -> Bool
f Markup
x = Markup -> Maybe Markup
forall a. a -> Maybe a
Just Markup
x
match' Markup
_ = Maybe Markup
forall a. Maybe a
Nothing
pContent :: Monad m => MP m (Seq Content)
pContent :: forall (m :: * -> *). Monad m => MP m (Seq Content)
pContent = (MP m (Seq Content)
forall (m :: * -> *). Monad m => MP m (Seq Content)
pTxt MP m (Seq Content) -> MP m (Seq Content) -> MP m (Seq Content)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MP m (Seq Content)
forall (m :: * -> *). Monad m => MP m (Seq Content)
pElt) MP m (Seq Content)
-> (Seq Content -> MP m (Seq Content)) -> MP m (Seq Content)
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
>>= Seq Content -> MP m (Seq Content)
forall (m :: * -> *). Monad m => Seq Content -> MP m (Seq Content)
applyShowRules MP m (Seq Content)
-> (Seq Content -> MP m (Seq Content)) -> MP m (Seq Content)
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
>>= Seq Content -> MP m (Seq Content)
forall (m :: * -> *). Monad m => Seq Content -> MP m (Seq Content)
addTextElement
applyShowRulesToVal :: Monad m => Val -> MP m Val
applyShowRulesToVal :: forall (m :: * -> *). Monad m => Val -> MP m Val
applyShowRulesToVal (VContent Seq Content
cs) = Seq Content -> Val
VContent (Seq Content -> Val)
-> ParsecT [Markup] (EvalState m) m (Seq Content)
-> ParsecT [Markup] (EvalState m) m Val
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq Content -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *). Monad m => Seq Content -> MP m (Seq Content)
applyShowRules Seq Content
cs
applyShowRulesToVal Val
x = Val -> ParsecT [Markup] (EvalState m) m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
x
addTextElement :: Monad m => Seq Content -> MP m (Seq Content)
addTextElement :: forall (m :: * -> *). Monad m => Seq Content -> MP m (Seq Content)
addTextElement = (Seq Content
-> Content -> ParsecT [Markup] (EvalState m) m (Seq Content))
-> Seq Content
-> Seq Content
-> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Seq Content
-> Content -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall {m :: * -> *}.
Monad m =>
Seq Content
-> Content -> ParsecT [Markup] (EvalState m) m (Seq Content)
go Seq Content
forall a. Monoid a => a
mempty
where
go :: Seq Content
-> Content -> ParsecT [Markup] (EvalState m) m (Seq Content)
go Seq Content
acc (Txt Text
"") = Seq Content -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Seq Content
acc
go Seq Content
acc (Txt Text
t) = (Seq Content
acc Seq Content -> Seq Content -> Seq Content
forall a. Semigroup a => a -> a -> a
<>) (Seq Content -> Seq Content)
-> ParsecT [Markup] (EvalState m) m (Seq Content)
-> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Identifier
-> Arguments -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *).
Monad m =>
Identifier -> Arguments -> MP m (Seq Content)
element Identifier
"text" ([Val] -> OMap Identifier Val -> Arguments
Arguments [Seq Content -> Val
VContent [Text -> Content
Txt Text
t]] OMap Identifier Val
forall k v. OMap k v
OM.empty)
go Seq Content
acc Content
x = Seq Content -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Seq Content
acc Seq Content -> Content -> Seq Content
forall a. Seq a -> a -> Seq a
Seq.|> Content
x)
isText :: Markup -> Bool
isText :: Markup -> Bool
isText Text {} = Bool
True
isText Markup
Space = Bool
True
isText Markup
SoftBreak = Bool
True
isText Markup
Nbsp = Bool
True
isText Markup
Shy = Bool
True
isText Markup
EmDash = Bool
True
isText Markup
EnDash = Bool
True
isText Markup
Ellipsis = Bool
True
isText (Quote Char
_) = Bool
True
isText Markup
_ = Bool
False
getText :: Markup -> Text
getText :: Markup -> Text
getText (Text Text
t) = Text
t
getText Markup
Space = Text
" "
getText Markup
SoftBreak = Text
"\n"
getText Markup
Nbsp = Text
"\xa0"
getText Markup
Shy = Text
"\xad"
getText Markup
EmDash = Text
"\x2014"
getText Markup
EnDash = Text
"\x2013"
getText Markup
Ellipsis = Text
"\x2026"
getText (Quote Char
c) = Char -> Text
T.singleton Char
c
getText Markup
_ = Text
""
pTxt :: Monad m => MP m (Seq Content)
pTxt :: forall (m :: * -> *). Monad m => MP m (Seq Content)
pTxt = do
mathMode <- EvalState m -> Bool
forall (m :: * -> *). EvalState m -> Bool
evalMath (EvalState m -> Bool)
-> ParsecT [Markup] (EvalState m) m (EvalState m)
-> ParsecT [Markup] (EvalState m) m Bool
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
txt <-
if mathMode
then getText <$> satisfyTok isText
else mconcat . map getText . setQuotes <$> many1 (satisfyTok isText)
pure $ Seq.singleton $ Txt txt
setQuotes :: [Markup] -> [Markup]
setQuotes :: [Markup] -> [Markup]
setQuotes [] = []
setQuotes (Quote Char
'"' : Markup
x : [Markup]
rest)
| Markup
x Markup -> Markup -> Bool
forall a. Eq a => a -> a -> Bool
== Markup
Space Bool -> Bool -> Bool
|| Markup
x Markup -> Markup -> Bool
forall a. Eq a => a -> a -> Bool
== Markup
SoftBreak = Char -> Markup
Quote Char
'\x201D' Markup -> [Markup] -> [Markup]
forall a. a -> [a] -> [a]
: [Markup] -> [Markup]
setQuotes (Markup
x Markup -> [Markup] -> [Markup]
forall a. a -> [a] -> [a]
: [Markup]
rest)
setQuotes (Quote Char
'\'' : Markup
x : [Markup]
rest)
| Markup
x Markup -> Markup -> Bool
forall a. Eq a => a -> a -> Bool
== Markup
Space Bool -> Bool -> Bool
|| Markup
x Markup -> Markup -> Bool
forall a. Eq a => a -> a -> Bool
== Markup
SoftBreak = Char -> Markup
Quote Char
'\x201D' Markup -> [Markup] -> [Markup]
forall a. a -> [a] -> [a]
: [Markup] -> [Markup]
setQuotes (Markup
x Markup -> [Markup] -> [Markup]
forall a. a -> [a] -> [a]
: [Markup]
rest)
setQuotes (Markup
x : Quote Char
'"' : [Markup]
rest)
| Markup
x Markup -> Markup -> Bool
forall a. Eq a => a -> a -> Bool
== Markup
Space Bool -> Bool -> Bool
|| Markup
x Markup -> Markup -> Bool
forall a. Eq a => a -> a -> Bool
== Markup
SoftBreak = Markup
x Markup -> [Markup] -> [Markup]
forall a. a -> [a] -> [a]
: Char -> Markup
Quote Char
'\x201C' Markup -> [Markup] -> [Markup]
forall a. a -> [a] -> [a]
: [Markup] -> [Markup]
setQuotes [Markup]
rest
setQuotes (Markup
x : Quote Char
'\'' : [Markup]
rest)
| Markup
x Markup -> Markup -> Bool
forall a. Eq a => a -> a -> Bool
== Markup
Space Bool -> Bool -> Bool
|| Markup
x Markup -> Markup -> Bool
forall a. Eq a => a -> a -> Bool
== Markup
SoftBreak = Markup
x Markup -> [Markup] -> [Markup]
forall a. a -> [a] -> [a]
: Char -> Markup
Quote Char
'\x2018' Markup -> [Markup] -> [Markup]
forall a. a -> [a] -> [a]
: [Markup] -> [Markup]
setQuotes [Markup]
rest
setQuotes (Text Text
t1 : Quote Char
'\'' : Text Text
t2 : [Markup]
rest) =
Text -> Markup
Text Text
t1 Markup -> [Markup] -> [Markup]
forall a. a -> [a] -> [a]
: Char -> Markup
Quote Char
'\x2019' Markup -> [Markup] -> [Markup]
forall a. a -> [a] -> [a]
: [Markup] -> [Markup]
setQuotes (Text -> Markup
Text Text
t2 Markup -> [Markup] -> [Markup]
forall a. a -> [a] -> [a]
: [Markup]
rest)
setQuotes (Quote Char
'"' : Text Text
t : [Markup]
rest)
| Text
t Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` ([Item [Text]
Text
")", Item [Text]
Text
".", Item [Text]
Text
",", Item [Text]
Text
";", Item [Text]
Text
":", Item [Text]
Text
"?", Item [Text]
Text
"!", Item [Text]
Text
"]"] :: [Text]) =
Char -> Markup
Quote Char
'\x201C' Markup -> [Markup] -> [Markup]
forall a. a -> [a] -> [a]
: [Markup] -> [Markup]
setQuotes (Text -> Markup
Text Text
t Markup -> [Markup] -> [Markup]
forall a. a -> [a] -> [a]
: [Markup]
rest)
setQuotes (Quote Char
'\'' : Text Text
t : [Markup]
rest)
| Text
t Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` ([Item [Text]
Text
")", Item [Text]
Text
".", Item [Text]
Text
",", Item [Text]
Text
";", Item [Text]
Text
":", Item [Text]
Text
"?", Item [Text]
Text
"!", Item [Text]
Text
"]"] :: [Text]) =
Char -> Markup
Quote Char
'\x2018' Markup -> [Markup] -> [Markup]
forall a. a -> [a] -> [a]
: [Markup] -> [Markup]
setQuotes (Text -> Markup
Text Text
t Markup -> [Markup] -> [Markup]
forall a. a -> [a] -> [a]
: [Markup]
rest)
setQuotes (Quote Char
'"' : [Markup]
rest) = Char -> Markup
Quote Char
'\x201D' Markup -> [Markup] -> [Markup]
forall a. a -> [a] -> [a]
: [Markup] -> [Markup]
setQuotes [Markup]
rest
setQuotes (Quote Char
'\'' : [Markup]
rest) = Char -> Markup
Quote Char
'\x2019' Markup -> [Markup] -> [Markup]
forall a. a -> [a] -> [a]
: [Markup] -> [Markup]
setQuotes [Markup]
rest
setQuotes (Markup
x : [Markup]
xs) = Markup
x Markup -> [Markup] -> [Markup]
forall a. a -> [a] -> [a]
: [Markup] -> [Markup]
setQuotes [Markup]
xs
pInnerContents :: Monad m => [Markup] -> MP m (Seq Content)
pInnerContents :: forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Markup]
ms = do
oldInput <- ParsecT [Markup] (EvalState m) m [Markup]
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
oldPos <- getPosition
oldShowRules <- evalShowRules <$> getState
setInput ms
result <- mconcat <$> (many pContent <* eof)
setInput oldInput
setPosition oldPos
updateState $ \EvalState m
st -> EvalState m
st {evalShowRules = oldShowRules}
pure result
single :: Content -> Seq Content
single :: Content -> Seq Content
single = Content -> Seq Content
forall a. a -> Seq a
Seq.singleton
applyElementFunction :: Monad m => Identifier -> Function -> Arguments -> MP m Val
applyElementFunction :: forall (m :: * -> *).
Monad m =>
Identifier -> Function -> Arguments -> MP m Val
applyElementFunction Identifier
name (Function forall (m :: * -> *). Monad m => Arguments -> MP m Val
f) Arguments
args = do
mbSty <- Identifier -> Map Identifier Arguments -> Maybe Arguments
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Identifier
name (Map Identifier Arguments -> Maybe Arguments)
-> (EvalState m -> Map Identifier Arguments)
-> EvalState m
-> Maybe Arguments
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalState m -> Map Identifier Arguments
forall (m :: * -> *). EvalState m -> Map Identifier Arguments
evalStyles (EvalState m -> Maybe Arguments)
-> ParsecT [Markup] (EvalState m) m (EvalState m)
-> ParsecT [Markup] (EvalState m) m (Maybe Arguments)
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
f $ maybe args (<> args) mbSty
element :: Monad m => Identifier -> Arguments -> MP m (Seq Content)
element :: forall (m :: * -> *).
Monad m =>
Identifier -> Arguments -> MP m (Seq Content)
element name :: Identifier
name@(Identifier Text
n) Arguments
args = do
eltfn <- Identifier -> MP m Val
forall (m :: * -> *). Monad m => Identifier -> MP m Val
lookupIdentifier Identifier
name
case eltfn of
VFunction Maybe Identifier
Nothing Map Identifier Val
_ (Function forall (m :: * -> *). Monad m => Arguments -> MP m Val
f) -> Val -> Seq Content
valToContent (Val -> Seq Content)
-> MP m Val -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Arguments -> MP m Val
forall (m :: * -> *). Monad m => Arguments -> MP m Val
f Arguments
args
VFunction (Just Identifier
i) Map Identifier Val
_ (Function forall (m :: * -> *). Monad m => Arguments -> MP m Val
f) ->
Val -> Seq Content
valToContent (Val -> Seq Content)
-> MP m Val -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Identifier -> Function -> Arguments -> MP m Val
forall (m :: * -> *).
Monad m =>
Identifier -> Function -> Arguments -> MP m Val
applyElementFunction Identifier
i ((forall (m :: * -> *). Monad m => Arguments -> MP m Val)
-> Function
Function Arguments -> MP m Val
forall (m :: * -> *). Monad m => Arguments -> MP m Val
f) Arguments
args
Val
_ -> FilePath -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> ParsecT [Markup] (EvalState m) m (Seq Content))
-> FilePath -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
n FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" is not an element function"
pElt :: Monad m => MP m (Seq Content)
pElt :: forall (m :: * -> *). Monad m => MP m (Seq Content)
pElt = do
tok <- (Markup -> Bool) -> MP m Markup
forall (m :: * -> *). Monad m => (Markup -> Bool) -> MP m Markup
satisfyTok (Bool -> Bool
not (Bool -> Bool) -> (Markup -> Bool) -> Markup -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Markup -> Bool
isText)
case tok of
Markup
ParBreak -> Identifier
-> Arguments -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *).
Monad m =>
Identifier -> Arguments -> MP m (Seq Content)
element Identifier
"parbreak" Arguments
forall a. Monoid a => a
mempty
Markup
HardBreak -> Identifier
-> Arguments -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *).
Monad m =>
Identifier -> Arguments -> MP m (Seq Content)
element Identifier
"linebreak" Arguments
forall a. Monoid a => a
mempty
Markup
Comment -> Seq Content -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Seq Content
forall a. Monoid a => a
mempty
Code SourcePos
pos Expr
expr -> SourcePos -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition SourcePos
pos ParsecT [Markup] (EvalState m) m ()
-> ParsecT [Markup] (EvalState m) m (Seq Content)
-> ParsecT [Markup] (EvalState m) m (Seq Content)
forall a b.
ParsecT [Markup] (EvalState m) m a
-> ParsecT [Markup] (EvalState m) m b
-> ParsecT [Markup] (EvalState m) m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Expr -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *). Monad m => Expr -> MP m (Seq Content)
pExpr Expr
expr
Emph [Markup]
ms -> do
body <- [Markup] -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Markup]
ms
element "emph" Arguments {positional = [VContent body], named = OM.empty}
Strong [Markup]
ms -> do
body <- [Markup] -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Markup]
ms
element "strong" Arguments {positional = [VContent body], named = OM.empty}
Bracketed [Markup]
ms -> do
body <- [Markup] -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Markup]
ms
pure $ (Txt "[" Seq.<| body) Seq.|> Txt "]"
RawBlock Text
lang Text
txt ->
Identifier
-> Arguments -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *).
Monad m =>
Identifier -> Arguments -> MP m (Seq Content)
element
Identifier
"raw"
Arguments
{ positional :: [Val]
positional = [Text -> Val
VString Text
txt],
named :: OMap Identifier Val
named =
[(Identifier, Val)] -> OMap Identifier Val
forall k v. Ord k => [(k, v)] -> OMap k v
OM.fromList
[ (Identifier
"block", Bool -> Val
VBoolean Bool
True),
( Identifier
"lang",
if Text -> Bool
T.null Text
lang
then Val
VNone
else Text -> Val
VString Text
lang
)
]
}
RawInline Text
txt -> do
Identifier
-> Arguments -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *).
Monad m =>
Identifier -> Arguments -> MP m (Seq Content)
element
Identifier
"raw"
Arguments
{ positional :: [Val]
positional = [Text -> Val
VString Text
txt],
named :: OMap Identifier Val
named =
[(Identifier, Val)] -> OMap Identifier Val
forall k v. Ord k => [(k, v)] -> OMap k v
OM.fromList
[ (Identifier
"lang", Val
VNone),
(Identifier
"block", Bool -> Val
VBoolean Bool
False)
]
}
Heading Int
level [Markup]
ms -> do
content <- [Markup] -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Markup]
ms
element
"heading"
Arguments
{ positional = [VContent content],
named =
OM.fromList
[("level", VInteger (fromIntegral level))]
}
Equation Bool
display [Markup]
ms -> Scope
-> ParsecT [Markup] (EvalState m) m (Seq Content)
-> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *) a. Monad m => Scope -> MP m a -> MP m a
inBlock Scope
BlockScope (ParsecT [Markup] (EvalState m) m (Seq Content)
-> ParsecT [Markup] (EvalState m) m (Seq Content))
-> ParsecT [Markup] (EvalState m) m (Seq Content)
-> ParsecT [Markup] (EvalState m) m (Seq Content)
forall a b. (a -> b) -> a -> b
$ do
oldMath <- EvalState m -> Bool
forall (m :: * -> *). EvalState m -> Bool
evalMath (EvalState m -> Bool)
-> ParsecT [Markup] (EvalState m) m (EvalState m)
-> ParsecT [Markup] (EvalState m) m Bool
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
updateState $ \EvalState m
st -> EvalState m
st {evalMath = True}
content <- pInnerContents ms
element
"equation"
Arguments
{ positional = [VContent content],
named =
OM.fromList
[ ("block", VBoolean display),
("numbering", VNone)
]
} <* updateState (\EvalState m
st -> EvalState m
st {evalMath = oldMath})
MFrac Markup
numexp Markup
denexp -> do
let handleParens :: Markup -> Markup
handleParens (MGroup (Just Text
"(") (Just Text
")") [Markup]
xs) = Maybe Text -> Maybe Text -> [Markup] -> Markup
MGroup Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing [Markup]
xs
handleParens Markup
x = Markup
x
num <- [Markup] -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Markup -> Markup
handleParens Markup
numexp]
den <- pInnerContents [handleParens denexp]
element
"frac"
Arguments
{ positional = [VContent num, VContent den],
named = OM.empty
}
MAttach Maybe Markup
mbBottomExp Maybe Markup
mbTopExp Markup
baseExp -> do
base' <- [Markup] -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Item [Markup]
Markup
baseExp]
pos <- getPosition
let base =
case Seq Content
base' of
[Elt Identifier
"text" Maybe SourcePos
mbpos [(Identifier
"body", VContent [Txt Text
t])]]
| (Char -> Bool) -> Text -> Bool
T.all ((MathClass -> MathClass -> Bool
forall a. Eq a => a -> a -> Bool
== MathClass
Relation) (MathClass -> Bool) -> (Char -> MathClass) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> MathClass
mathClassOf ) Text
t
-> [Identifier -> Maybe SourcePos -> Map Identifier Val -> Content
Elt Identifier
"math.limits" Maybe SourcePos
mbpos
[(Identifier
"body", Seq Content -> Val
VContent Seq Content
base')]]
[Txt Text
t] | (Char -> Bool) -> Text -> Bool
T.all ((MathClass -> MathClass -> Bool
forall a. Eq a => a -> a -> Bool
== MathClass
Relation) (MathClass -> Bool) -> (Char -> MathClass) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> MathClass
mathClassOf ) Text
t
-> [Identifier -> Maybe SourcePos -> Map Identifier Val -> Content
Elt Identifier
"math.limits" (SourcePos -> Maybe SourcePos
forall a. a -> Maybe a
Just SourcePos
pos)
[(Identifier
"body", Seq Content -> Val
VContent Seq Content
base')]]
Seq Content
_ -> Seq Content
base'
mbBottom <-
maybe
(pure Nothing)
(fmap Just . pInnerContents . (: []))
mbBottomExp
mbTop <-
maybe
(pure Nothing)
(fmap Just . pInnerContents . (: []))
mbTopExp
element
"attach"
Arguments
{ positional = [VContent base],
named =
OM.fromList
[ ("b", maybe VNone VContent mbBottom),
("t", maybe VNone VContent mbTop)
]
}
MGroup Maybe Text
mbOp Maybe Text
mbCl [Markup]
ms -> Maybe Text -> Maybe Text -> Seq Content -> Seq Content
wrapIn Maybe Text
mbOp Maybe Text
mbCl (Seq Content -> Seq Content)
-> ParsecT [Markup] (EvalState m) m (Seq Content)
-> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Markup] -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Markup]
ms
Markup
MAlignPoint -> Identifier
-> Arguments -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *).
Monad m =>
Identifier -> Arguments -> MP m (Seq Content)
element Identifier
"alignpoint" Arguments
forall a. Monoid a => a
mempty
Ref Text
ident Expr
supp -> do
supp' <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
supp
element
"ref"
Arguments
{ positional = [VLabel ident],
named =
OM.fromList
[ ( "supplement", supp' ) ]
}
BulletListItem [Markup]
ms -> do
MP m Markup -> ParsecT [Markup] (EvalState m) m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (MP m Markup -> ParsecT [Markup] (EvalState m) m ())
-> MP m Markup -> ParsecT [Markup] (EvalState m) m ()
forall a b. (a -> b) -> a -> b
$ (Markup -> Bool) -> MP m Markup
forall (m :: * -> *). Monad m => (Markup -> Bool) -> MP m Markup
satisfyTok Markup -> Bool
isBreak
firstItem <- [Markup] -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Markup]
ms
items <- (firstItem :) <$> many pListItem
element
"list"
Arguments
{ positional = map VContent items,
named = OM.empty
}
EnumListItem Maybe Int
mbStart [Markup]
ms -> do
MP m Markup -> ParsecT [Markup] (EvalState m) m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (MP m Markup -> ParsecT [Markup] (EvalState m) m ())
-> MP m Markup -> ParsecT [Markup] (EvalState m) m ()
forall a b. (a -> b) -> a -> b
$ (Markup -> Bool) -> MP m Markup
forall (m :: * -> *). Monad m => (Markup -> Bool) -> MP m Markup
satisfyTok Markup -> Bool
isBreak
firstItem <- [Markup] -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Markup]
ms
items <- (firstItem :) <$> many pEnumItem
element
"enum"
Arguments
{ positional = map VContent items,
named =
maybe
OM.empty
( \Int
x ->
[(Identifier, Val)] -> OMap Identifier Val
forall k v. Ord k => [(k, v)] -> OMap k v
OM.fromList
[(Identifier
"start", Integer -> Val
VInteger (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x))]
)
mbStart
}
DescListItem [Markup]
ts [Markup]
ds -> do
ts' <- [Markup] -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Markup]
ts
ds' <- pInnerContents ds
skipMany (satisfyTok isBreak)
let firstItem = Vector Val -> Val
VArray [Seq Content -> Val
VContent Seq Content
ts', Seq Content -> Val
VContent Seq Content
ds']
items <- (firstItem :) <$> many pDescItem
element
"terms"
Arguments
{ positional = items,
named = OM.empty
}
Url Text
t ->
Identifier
-> Arguments -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *).
Monad m =>
Identifier -> Arguments -> MP m (Seq Content)
element
Identifier
"link"
Arguments
{ positional :: [Val]
positional =
[ Text -> Val
VString Text
t,
Seq Content -> Val
VContent (Content -> Seq Content
forall a. a -> Seq a
Seq.singleton (Text -> Content
Txt Text
t))
],
named :: OMap Identifier Val
named = OMap Identifier Val
forall k v. OMap k v
OM.empty
}
Markup
_ -> FilePath -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> ParsecT [Markup] (EvalState m) m (Seq Content))
-> FilePath -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall a b. (a -> b) -> a -> b
$ FilePath
"Encountered " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Markup -> FilePath
forall a. Show a => a -> FilePath
show Markup
tok FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" in pElt"
pDescItem :: Monad m => MP m Val
pDescItem :: forall (m :: * -> *). Monad m => MP m Val
pDescItem = do
tok <- (Markup -> Bool) -> MP m Markup
forall (m :: * -> *). Monad m => (Markup -> Bool) -> MP m Markup
satisfyTok Markup -> Bool
isDescListItem
case tok of
DescListItem [Markup]
ts [Markup]
ds -> do
ts' <- [Markup] -> MP m (Seq Content)
forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Markup]
ts
ds' <- pInnerContents ds
skipMany (satisfyTok isBreak)
pure $ VArray [VContent ts', VContent ds']
Markup
_ -> FilePath -> ParsecT [Markup] (EvalState m) m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"pDescItem encountered non DescListItem"
where
isDescListItem :: Markup -> Bool
isDescListItem DescListItem {} = Bool
True
isDescListItem Markup
_ = Bool
False
pEnumItem :: Monad m => MP m (Seq Content)
pEnumItem :: forall (m :: * -> *). Monad m => MP m (Seq Content)
pEnumItem = do
tok <- (Markup -> Bool) -> MP m Markup
forall (m :: * -> *). Monad m => (Markup -> Bool) -> MP m Markup
satisfyTok Markup -> Bool
isEnumListItem
case tok of
EnumListItem Maybe Int
_ [Markup]
ms -> [Markup] -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Markup]
ms ParsecT [Markup] (EvalState m) m (Seq Content)
-> ParsecT [Markup] (EvalState m) m ()
-> ParsecT [Markup] (EvalState m) m (Seq Content)
forall a b.
ParsecT [Markup] (EvalState m) m a
-> ParsecT [Markup] (EvalState m) m b
-> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* MP m Markup -> ParsecT [Markup] (EvalState m) m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ((Markup -> Bool) -> MP m Markup
forall (m :: * -> *). Monad m => (Markup -> Bool) -> MP m Markup
satisfyTok Markup -> Bool
isBreak)
Markup
_ -> FilePath -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"pEnumItem encountered non EnumListItem"
where
isEnumListItem :: Markup -> Bool
isEnumListItem EnumListItem {} = Bool
True
isEnumListItem Markup
_ = Bool
False
pListItem :: Monad m => MP m (Seq Content)
pListItem :: forall (m :: * -> *). Monad m => MP m (Seq Content)
pListItem = do
tok <- (Markup -> Bool) -> MP m Markup
forall (m :: * -> *). Monad m => (Markup -> Bool) -> MP m Markup
satisfyTok Markup -> Bool
isBulletListItem
case tok of
BulletListItem [Markup]
ms -> [Markup] -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Markup]
ms ParsecT [Markup] (EvalState m) m (Seq Content)
-> ParsecT [Markup] (EvalState m) m ()
-> ParsecT [Markup] (EvalState m) m (Seq Content)
forall a b.
ParsecT [Markup] (EvalState m) m a
-> ParsecT [Markup] (EvalState m) m b
-> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* MP m Markup -> ParsecT [Markup] (EvalState m) m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ((Markup -> Bool) -> MP m Markup
forall (m :: * -> *). Monad m => (Markup -> Bool) -> MP m Markup
satisfyTok Markup -> Bool
isBreak)
Markup
_ -> FilePath -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"pListItem encountered non BulletListItem"
where
isBulletListItem :: Markup -> Bool
isBulletListItem BulletListItem {} = Bool
True
isBulletListItem Markup
_ = Bool
False
isBreak :: Markup -> Bool
isBreak :: Markup -> Bool
isBreak Markup
SoftBreak = Bool
True
isBreak Markup
ParBreak = Bool
True
isBreak Markup
_ = Bool
False
wrapIn :: Maybe Text -> Maybe Text -> Seq Content -> Seq Content
wrapIn :: Maybe Text -> Maybe Text -> Seq Content -> Seq Content
wrapIn Maybe Text
Nothing Maybe Text
Nothing Seq Content
cs = Seq Content
cs
wrapIn (Just Text
op) (Just Text
cl) Seq Content
cs =
Content -> Seq Content
forall a. a -> Seq a
Seq.singleton (Content -> Seq Content) -> Content -> Seq Content
forall a b. (a -> b) -> a -> b
$
Identifier -> Maybe SourcePos -> Map Identifier Val -> Content
Elt
Identifier
"math.lr"
Maybe SourcePos
forall a. Maybe a
Nothing
[ ( Identifier
"body",
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
[Seq Content -> Val
VContent (Seq Content -> Val) -> Seq Content -> Val
forall a b. (a -> b) -> a -> b
$ Text -> Content
Txt Text
op Content -> Seq Content -> Seq Content
forall a. a -> Seq a -> Seq a
Seq.<| (Seq Content
cs Seq Content -> Content -> Seq Content
forall a. Seq a -> a -> Seq a
Seq.|> Text -> Content
Txt Text
cl)]
)
]
wrapIn Maybe Text
Nothing (Just Text
cl) Seq Content
cs = Seq Content
cs Seq Content -> Content -> Seq Content
forall a. Seq a -> a -> Seq a
Seq.|> Text -> Content
Txt Text
cl
wrapIn (Just Text
op) Maybe Text
Nothing Seq Content
cs = Text -> Content
Txt Text
op Content -> Seq Content -> Seq Content
forall a. a -> Seq a -> Seq a
Seq.<| Seq Content
cs
pExpr :: Monad m => Expr -> MP m (Seq Content)
pExpr :: forall (m :: * -> *). Monad m => Expr -> MP m (Seq Content)
pExpr Expr
expr = Val -> Seq Content
valToContent (Val -> Seq Content)
-> ParsecT [Markup] (EvalState m) m Val
-> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> ParsecT [Markup] (EvalState m) m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
expr
evalExpr :: Monad m => Expr -> MP m Val
evalExpr :: forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
expr = Val -> MP m Val
forall (m :: * -> *). Monad m => Val -> MP m Val
applyShowRulesToVal (Val -> MP m Val) -> MP m Val -> MP m Val
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
case Expr
expr of
Literal Literal
lit -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Literal -> Val
evalLiteral Literal
lit
Group Expr
e -> Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
Block (Content [Markup]
ms) -> Seq Content -> Val
VContent (Seq Content -> Val)
-> ParsecT [Markup] (EvalState m) m (Seq Content) -> MP m Val
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Markup] -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Markup]
ms
Block (CodeBlock [Expr]
exprs) ->
Scope -> MP m Val -> MP m Val
forall (m :: * -> *) a. Monad m => Scope -> MP m a -> MP m a
inBlock Scope
BlockScope (MP m Val -> MP m Val) -> MP m Val -> MP m Val
forall a b. (a -> b) -> a -> b
$
(Val, Bool) -> Val
forall a b. (a, b) -> a
fst
((Val, Bool) -> Val)
-> ParsecT [Markup] (EvalState m) m (Val, Bool) -> MP m Val
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Val, Bool)
-> Expr -> ParsecT [Markup] (EvalState m) m (Val, Bool))
-> (Val, Bool)
-> [Expr]
-> ParsecT [Markup] (EvalState m) m (Val, Bool)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM
( \(Val
result, Bool
finished) Expr
e ->
if Bool
finished
then (Val, Bool) -> ParsecT [Markup] (EvalState m) m (Val, Bool)
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val
result, Bool
finished)
else do
(EvalState m -> EvalState m) -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((EvalState m -> EvalState m)
-> ParsecT [Markup] (EvalState m) m ())
-> (EvalState m -> EvalState m)
-> ParsecT [Markup] (EvalState m) m ()
forall a b. (a -> b) -> a -> b
$ \EvalState m
st -> EvalState m
st {evalFlowDirective = FlowNormal}
val <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
flow <- evalFlowDirective <$> getState
case flow of
FlowDirective
FlowNormal -> do
combined <- Val -> Val -> MP m Val
forall (m :: * -> *). MonadFail m => Val -> Val -> m Val
joinVals Val
result Val
val
pure (combined, False)
FlowDirective
FlowContinue -> do
combined <- Val -> Val -> MP m Val
forall (m :: * -> *). MonadFail m => Val -> Val -> m Val
joinVals Val
result Val
val
pure (combined, True)
FlowDirective
FlowBreak -> do
combined <- Val -> Val -> MP m Val
forall (m :: * -> *). MonadFail m => Val -> Val -> m Val
joinVals Val
result Val
val
pure (combined, True)
FlowReturn Bool
True -> (Val, Bool) -> ParsecT [Markup] (EvalState m) m (Val, Bool)
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val
val, Bool
True)
FlowReturn Bool
False -> do
combined <- Val -> Val -> MP m Val
forall (m :: * -> *). MonadFail m => Val -> Val -> m Val
joinVals Val
result Val
val
pure (combined, True)
)
(Val
VNone, Bool
False)
[Expr]
exprs
Array [Spreadable Expr]
es -> Vector Val -> Val
VArray (Vector Val -> Val)
-> ParsecT [Markup] (EvalState m) m (Vector Val) -> MP m Val
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Vector Val
-> Spreadable Expr
-> ParsecT [Markup] (EvalState m) m (Vector Val))
-> Vector Val
-> [Spreadable Expr]
-> ParsecT [Markup] (EvalState m) m (Vector Val)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM
( \Vector Val
xs Spreadable Expr
x ->
case Spreadable Expr
x of
Spr Expr
y -> do
val <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
y
case val of
VArray Vector Val
ys -> Vector Val -> ParsecT [Markup] (EvalState m) m (Vector Val)
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Vector Val
xs Vector Val -> Vector Val -> Vector Val
forall a. Semigroup a => a -> a -> a
<> Vector Val
ys)
Val
_ -> FilePath -> ParsecT [Markup] (EvalState m) m (Vector Val)
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> ParsecT [Markup] (EvalState m) m (Vector Val))
-> FilePath -> ParsecT [Markup] (EvalState m) m (Vector Val)
forall a b. (a -> b) -> a -> b
$ FilePath
"Could not spread " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> ValType -> FilePath
forall a. Show a => a -> FilePath
show (Val -> ValType
valType Val
val) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>
FilePath
" into array"
Reg Expr
e -> do
val <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
pure (V.snoc xs val ) )
[]
[Spreadable Expr]
es
Dict [Spreadable (Expr, Expr)]
items ->
OMap Identifier Val -> Val
VDict
(OMap Identifier Val -> Val)
-> ParsecT [Markup] (EvalState m) m (OMap Identifier Val)
-> MP m Val
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (OMap Identifier Val
-> Spreadable (Expr, Expr)
-> ParsecT [Markup] (EvalState m) m (OMap Identifier Val))
-> OMap Identifier Val
-> [Spreadable (Expr, Expr)]
-> ParsecT [Markup] (EvalState m) m (OMap Identifier Val)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM
( \OMap Identifier Val
m Spreadable (Expr, Expr)
v -> do
case Spreadable (Expr, Expr)
v of
Reg (Expr
k, Expr
e) -> do
k' <- case Expr
k of
Ident Identifier
i -> Identifier -> ParsecT [Markup] (EvalState m) m Identifier
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Identifier
i
Expr
_ -> do VString s <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
k
pure $ Identifier s
val <- evalExpr e
pure $ m OM.|> (k', val)
Spr Expr
y -> do
val <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
y
case val of
VDict OMap Identifier Val
m' -> OMap Identifier Val
-> ParsecT [Markup] (EvalState m) m (OMap Identifier Val)
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OMap Identifier Val
m' OMap Identifier Val -> OMap Identifier Val -> OMap Identifier Val
forall k v. Ord k => OMap k v -> OMap k v -> OMap k v
OM.|<> OMap Identifier Val
m)
Val
_ -> FilePath -> ParsecT [Markup] (EvalState m) m (OMap Identifier Val)
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath
-> ParsecT [Markup] (EvalState m) m (OMap Identifier Val))
-> FilePath
-> ParsecT [Markup] (EvalState m) m (OMap Identifier Val)
forall a b. (a -> b) -> a -> b
$ FilePath
"Could not spread " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> ValType -> FilePath
forall a. Show a => a -> FilePath
show (Val -> ValType
valType Val
val) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>
FilePath
" into dictionary"
)
OMap Identifier Val
forall k v. OMap k v
OM.empty
[Spreadable (Expr, Expr)]
items
Not Expr
e -> do
val <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
case val of
VBoolean Bool
b -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean (Bool -> Bool
not Bool
b)
Val
_ -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> MP m Val) -> FilePath -> MP m Val
forall a b. (a -> b) -> a -> b
$ FilePath
"Cannot apply 'not' to " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
val
And Expr
e1 Expr
e2 -> do
val1 <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
case val1 of
VBoolean Bool
False -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
False
VBoolean Bool
True -> do
val2 <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e2
case val2 of
VBoolean Bool
True -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
True
VBoolean Bool
False -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
False
Val
_ -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> MP m Val) -> FilePath -> MP m Val
forall a b. (a -> b) -> a -> b
$ FilePath
"Cannot apply 'and' to " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
val1
Val
_ -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> MP m Val) -> FilePath -> MP m Val
forall a b. (a -> b) -> a -> b
$ FilePath
"Cannot apply 'and' to " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
val1
Or Expr
e1 Expr
e2 -> do
val1 <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
case val1 of
VBoolean Bool
True -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
True
VBoolean Bool
False -> do
val2 <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e2
case val2 of
VBoolean Bool
True -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
True
VBoolean Bool
False -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
False
Val
_ -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> MP m Val) -> FilePath -> MP m Val
forall a b. (a -> b) -> a -> b
$ FilePath
"Cannot apply 'or' to " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
val1
Val
_ -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> MP m Val) -> FilePath -> MP m Val
forall a b. (a -> b) -> a -> b
$ FilePath
"Cannot apply 'or' to " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
val1
Ident Identifier
ident -> Identifier -> MP m Val
forall (m :: * -> *). Monad m => Identifier -> MP m Val
lookupIdentifier Identifier
ident
Let Bind
bind Expr
e -> do
val <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
case bind of
BasicBind (Just Identifier
ident) -> Identifier -> Val -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ()
addIdentifier Identifier
ident Val
val
BasicBind Maybe Identifier
Nothing -> () -> ParsecT [Markup] (EvalState m) m ()
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
DestructuringBind [BindPart]
parts -> (forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ())
-> [BindPart] -> Val -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *).
Monad m =>
(forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ())
-> [BindPart] -> Val -> MP m ()
destructuringBind Identifier -> Val -> MP m' ()
forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ()
addIdentifier [BindPart]
parts Val
val
pure VNone
LetFunc Identifier
name [Param]
params Expr
e -> do
val <- Maybe Identifier -> [Param] -> Expr -> MP m Val
forall (m :: * -> *).
Monad m =>
Maybe Identifier -> [Param] -> Expr -> MP m Val
toFunction (Identifier -> Maybe Identifier
forall a. a -> Maybe a
Just Identifier
name) [Param]
params Expr
e
addIdentifier name val
pure VNone
FieldAccess (Ident (Identifier Text
fld)) Expr
e -> do
val <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
getMethod (updateExpression e) val fld
<|> case val of
VSymbol (Symbol Text
_ Bool
accent [(Set Text, Text)]
variants) -> do
let variants' :: [(Set Text, Text)]
variants' =
((Set Text, Text) -> Int)
-> [(Set Text, Text)] -> [(Set Text, Text)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Set Text -> Int
forall a. Set a -> Int
Set.size (Set Text -> Int)
-> ((Set Text, Text) -> Set Text) -> (Set Text, Text) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set Text, Text) -> Set Text
forall a b. (a, b) -> a
fst) ([(Set Text, Text)] -> [(Set Text, Text)])
-> [(Set Text, Text)] -> [(Set Text, Text)]
forall a b. (a -> b) -> a -> b
$
((Set Text, Text) -> Bool)
-> [(Set Text, Text)] -> [(Set Text, Text)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Set Text
var, Text
_) -> Text
fld Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
var) [(Set Text, Text)]
variants
case [(Set Text, Text)]
variants' of
[] -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> MP m Val) -> FilePath -> MP m Val
forall a b. (a -> b) -> a -> b
$ FilePath
"Symbol does not have variant " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
forall a. Show a => a -> FilePath
show Text
fld
((Set Text
_, Text
s) : [(Set Text, Text)]
_) -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> 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
s Bool
accent [(Set Text, Text)]
variants'
VModule Identifier
_ Map Identifier Val
m ->
case Identifier -> Map Identifier Val -> Maybe Val
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Text -> Identifier
Identifier Text
fld) Map Identifier Val
m of
Just Val
x -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
x
Maybe Val
Nothing -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> MP m Val) -> FilePath -> MP m Val
forall a b. (a -> b) -> a -> b
$ FilePath
"Module does not contain " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
forall a. Show a => a -> FilePath
show Text
fld
VFunction Maybe Identifier
_ Map Identifier Val
m Function
_ ->
case Identifier -> Map Identifier Val -> Maybe Val
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Text -> Identifier
Identifier Text
fld) Map Identifier Val
m of
Just Val
x -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
x
Maybe Val
Nothing -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> MP m Val) -> FilePath -> MP m Val
forall a b. (a -> b) -> a -> b
$ FilePath
"Function scope does not contain " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
forall a. Show a => a -> FilePath
show Text
fld
VDict OMap Identifier Val
m ->
case Identifier -> OMap Identifier Val -> Maybe Val
forall k v. Ord k => k -> OMap k v -> Maybe v
OM.lookup (Text -> Identifier
Identifier Text
fld) OMap Identifier Val
m of
Just Val
x -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
x
Maybe Val
Nothing -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> MP m Val) -> FilePath -> MP m Val
forall a b. (a -> b) -> a -> b
$ Identifier -> FilePath
forall a. Show a => a -> FilePath
show (Text -> Identifier
Identifier Text
fld) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" not found"
Val
_ -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"FieldAccess requires a dictionary"
FieldAccess Expr
_ Expr
_ -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"FieldAccess requires an identifier"
FuncCall Expr
e [Arg]
args -> do
(EvalState m -> EvalState m) -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((EvalState m -> EvalState m)
-> ParsecT [Markup] (EvalState m) m ())
-> (EvalState m -> EvalState m)
-> ParsecT [Markup] (EvalState m) m ()
forall a b. (a -> b) -> a -> b
$ \EvalState m
st -> EvalState m
st {evalFlowDirective = FlowNormal}
val <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
mathMode <- evalMath <$> getState
case val of
VFunction (Just Identifier
i) Map Identifier Val
_ (Function forall (m :: * -> *). Monad m => Arguments -> MP m Val
f) -> do
arguments <- [Arg] -> MP m Arguments
forall (m :: * -> *). Monad m => [Arg] -> MP m Arguments
toArguments [Arg]
args
applyElementFunction i (Function f) arguments
VFunction Maybe Identifier
Nothing Map Identifier Val
_ (Function forall (m :: * -> *). Monad m => Arguments -> MP m Val
f) -> [Arg] -> MP m Arguments
forall (m :: * -> *). Monad m => [Arg] -> MP m Arguments
toArguments [Arg]
args MP m Arguments -> (Arguments -> MP m Val) -> MP m Val
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
>>= Arguments -> MP m Val
forall (m :: * -> *). Monad m => Arguments -> MP m Val
f
VType ValType
ty ->
case ValType -> Maybe Val
getConstructor ValType
ty of
Just (VFunction Maybe Identifier
_ Map Identifier Val
_ (Function forall (m :: * -> *). Monad m => Arguments -> MP m Val
f)) -> [Arg] -> MP m Arguments
forall (m :: * -> *). Monad m => [Arg] -> MP m Arguments
toArguments [Arg]
args MP m Arguments -> (Arguments -> MP m Val) -> MP m Val
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
>>= Arguments -> MP m Val
forall (m :: * -> *). Monad m => Arguments -> MP m Val
f
Maybe Val
_ -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> MP m Val) -> FilePath -> MP m Val
forall a b. (a -> b) -> a -> b
$ FilePath
"No constructor defined for type " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> ValType -> FilePath
forall a. Show a => a -> FilePath
show ValType
ty
VSymbol (Symbol Text
_ Bool
True [(Set Text, Text)]
_) | Bool
mathMode ->
do
val' <- Identifier -> MP m Val
forall (m :: * -> *). Monad m => Identifier -> MP m Val
lookupIdentifier Identifier
"accent"
case val' of
VFunction Maybe Identifier
_ Map Identifier Val
_ (Function forall (m :: * -> *). Monad m => Arguments -> MP m Val
f) ->
[Arg] -> MP m Arguments
forall (m :: * -> *). Monad m => [Arg] -> MP m Arguments
toArguments [Arg]
args
MP m Arguments -> (Arguments -> MP m Val) -> MP m Val
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
>>= Arguments -> MP m Val
forall (m :: * -> *). Monad m => Arguments -> MP m Val
f (Arguments -> MP m Val)
-> (Arguments -> Arguments) -> Arguments -> MP m Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Arguments
a -> Arguments
a {positional = positional a ++ [val]})
Val
_ -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"accent not defined"
Val
_
| Bool
mathMode -> do
args' <- [Arg] -> MP m Arguments
forall (m :: * -> *). Monad m => [Arg] -> MP m Arguments
toArguments [Arg]
args
pure $
VContent $
valToContent val
<> single "("
<> mconcat
( intersperse
(single ",")
(map valToContent (positional args'))
)
<> single ")"
| Bool
otherwise -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Attempt to call a non-function"
FuncExpr [Param]
params Expr
e -> Maybe Identifier -> [Param] -> Expr -> MP m Val
forall (m :: * -> *).
Monad m =>
Maybe Identifier -> [Param] -> Expr -> MP m Val
toFunction Maybe Identifier
forall a. Maybe a
Nothing [Param]
params Expr
e
Equals Expr
e1 Expr
e2 -> do
v1 <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
v2 <- evalExpr e2
case comp v1 v2 of
Just Ordering
EQ -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
True
Maybe Ordering
_ -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
False
LessThan Expr
e1 Expr
e2 -> do
v1 <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
v2 <- evalExpr e2
case comp v1 v2 of
Maybe Ordering
Nothing -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> MP m Val) -> FilePath -> MP m Val
forall a b. (a -> b) -> a -> b
$ FilePath
"Can't compare " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
v1 FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" and " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
v2
Just Ordering
LT -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
True
Maybe Ordering
_ -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
False
GreaterThan Expr
e1 Expr
e2 -> do
v1 <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
v2 <- evalExpr e2
case comp v1 v2 of
Maybe Ordering
Nothing -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> MP m Val) -> FilePath -> MP m Val
forall a b. (a -> b) -> a -> b
$ FilePath
"Can't compare " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
v1 FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" and " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
v2
Just Ordering
GT -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
True
Maybe Ordering
_ -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
False
LessThanOrEqual Expr
e1 Expr
e2 -> do
v1 <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
v2 <- evalExpr e2
case comp v1 v2 of
Maybe Ordering
Nothing -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> MP m Val) -> FilePath -> MP m Val
forall a b. (a -> b) -> a -> b
$ FilePath
"Can't compare " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Expr -> FilePath
forall a. Show a => a -> FilePath
show Expr
e1 FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" and " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Expr -> FilePath
forall a. Show a => a -> FilePath
show Expr
e2
Just Ordering
LT -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
True
Just Ordering
EQ -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
True
Maybe Ordering
_ -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
False
GreaterThanOrEqual Expr
e1 Expr
e2 -> do
v1 <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
v2 <- evalExpr e2
case comp v1 v2 of
Maybe Ordering
Nothing -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> MP m Val) -> FilePath -> MP m Val
forall a b. (a -> b) -> a -> b
$ FilePath
"Can't compare " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
v1 FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" and " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
v2
Just Ordering
GT -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
True
Just Ordering
EQ -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
True
Maybe Ordering
_ -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
False
InCollection Expr
e1 Expr
e2 -> do
v1 <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
v2 <- evalExpr e2
case v2 of
VString Text
t ->
case Val
v1 of
VString Text
t' -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean (Bool -> Val) -> Bool -> Val
forall a b. (a -> b) -> a -> b
$ Text
t' Text -> Text -> Bool
`T.isInfixOf` Text
t
VRegex RE
re -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean (Bool -> Val) -> Bool -> Val
forall a b. (a -> b) -> a -> b
$ RE -> Text -> Bool
forall source target.
RegexContext Regex source target =>
RE -> source -> target
match RE
re Text
t
Val
_ -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> MP m Val) -> FilePath -> MP m Val
forall a b. (a -> b) -> a -> b
$ FilePath
"Can't apply 'in' to " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
v1 FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" and string"
VType ValType
ty ->
case Val
v1 of
VString Text
t' -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean (Bool -> Val) -> Bool -> Val
forall a b. (a -> b) -> a -> b
$ Text
t' Text -> Text -> Bool
`T.isInfixOf` (ValType -> Text
prettyType ValType
ty)
VRegex RE
re -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean (Bool -> Val) -> Bool -> Val
forall a b. (a -> b) -> a -> b
$ RE -> Text -> Bool
forall source target.
RegexContext Regex source target =>
RE -> source -> target
match RE
re (ValType -> Text
prettyType ValType
ty)
Val
_ -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> MP m Val) -> FilePath -> MP m Val
forall a b. (a -> b) -> a -> b
$ FilePath
"Can't apply 'in' to " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
v1
VArray Vector Val
vec -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean (Bool -> Val) -> Bool -> Val
forall a b. (a -> b) -> a -> b
$ Val -> Vector Val -> Bool
forall a. Eq a => a -> Vector a -> Bool
V.elem Val
v1 Vector Val
vec
VDict OMap Identifier Val
m ->
case Val
v1 of
VString Text
t -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean (Bool -> Val) -> Bool -> Val
forall a b. (a -> b) -> a -> b
$ Maybe Val -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Val -> Bool) -> Maybe Val -> Bool
forall a b. (a -> b) -> a -> b
$ Identifier -> OMap Identifier Val -> Maybe Val
forall k v. Ord k => k -> OMap k v -> Maybe v
OM.lookup (Text -> Identifier
Identifier Text
t) OMap Identifier Val
m
Val
_ -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
False
Val
_ -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> MP m Val) -> FilePath -> MP m Val
forall a b. (a -> b) -> a -> b
$ FilePath
"Can't apply 'in' to " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
v2 FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> (Expr, Expr) -> FilePath
forall a. Show a => a -> FilePath
show (Expr
e1,Expr
e2)
Negated Expr
e -> do
v <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
case maybeNegate v of
Maybe Val
Nothing -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> MP m Val) -> FilePath -> MP m Val
forall a b. (a -> b) -> a -> b
$ FilePath
"Can't negate " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
v
Just Val
v' -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
v'
ToPower Expr
e1 Expr
e2 -> do
e <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
b <- evalExpr e2
case (b, e) of
(VInteger Integer
i, VInteger Integer
j) ->
Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$
Integer -> Val
VInteger (Integer -> Val) -> Integer -> Val
forall a b. (a -> b) -> a -> b
$
Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor ((Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i :: Double) Double -> Double -> Double
forall a. Floating a => a -> a -> a
** (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
j :: Double))
(VInteger Integer
i, VRatio Rational
j) ->
Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$
Double -> Val
VFloat ((Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i :: Double) Double -> Double -> Double
forall a. Floating a => a -> a -> a
** (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
j :: Double))
(VRatio Rational
i, VInteger Integer
j) ->
Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$
Double -> Val
VFloat (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
i Double -> Double -> Double
forall a. Floating a => a -> a -> a
** (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
j :: Double))
(VRatio Rational
i, VRatio Rational
j) -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Double -> Val
VFloat (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
i Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
j)
(VFloat Double
i, VInteger Integer
j) -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Double -> Val
VFloat (Double
i Double -> Double -> Double
forall a. Floating a => a -> a -> a
** (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
j :: Double))
(VFloat Double
i, VFloat Double
j) -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Double -> Val
VFloat (Double
i Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Double
j)
(VInteger Integer
i, VFloat Double
j) -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Double -> Val
VFloat ((Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i :: Double) Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Double
j)
(VFloat Double
i, VRatio Rational
j) -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Double -> Val
VFloat (Double
i Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
j)
(Val, Val)
_ -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> MP m Val) -> FilePath -> MP m Val
forall a b. (a -> b) -> a -> b
$ FilePath
"Can't exponentiate " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
b FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" to " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
e
Plus Expr
e1 Expr
e2 -> do
v1 <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
v2 <- evalExpr e2
case (v1, v2) of
(VAlignment Maybe Horiz
x1 Maybe Vert
y1, VAlignment Maybe Horiz
x2 Maybe Vert
y2) ->
Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Maybe Horiz -> Maybe Vert -> Val
VAlignment (Maybe Horiz
x1 Maybe Horiz -> Maybe Horiz -> Maybe Horiz
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe Horiz
x2) (Maybe Vert
y1 Maybe Vert -> Maybe Vert -> Maybe Vert
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe Vert
y2)
(VArguments Arguments
xs, VArguments Arguments
ys) ->
Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Arguments -> Val
VArguments (Arguments
xs Arguments -> Arguments -> Arguments
forall a. Semigroup a => a -> a -> a
<> Arguments
ys)
(Val, Val)
_ -> case Val -> Val -> Maybe Val
forall a. Summable a => a -> a -> Maybe a
maybePlus Val
v1 Val
v2 of
Maybe Val
Nothing -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> MP m Val) -> FilePath -> MP m Val
forall a b. (a -> b) -> a -> b
$ FilePath
"Can't + " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
v1 FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" and " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
v2
Just Val
v -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
v
Minus Expr
e1 Expr
e2 -> do
v1 <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
v2 <- evalExpr e2
case maybeMinus v1 v2 of
Maybe Val
Nothing -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> MP m Val) -> FilePath -> MP m Val
forall a b. (a -> b) -> a -> b
$ FilePath
"Can't - " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
v1 FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" and " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
v2
Just Val
v -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
v
Times Expr
e1 Expr
e2 -> do
v1 <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
v2 <- evalExpr e2
case maybeTimes v1 v2 of
Maybe Val
Nothing -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> MP m Val) -> FilePath -> MP m Val
forall a b. (a -> b) -> a -> b
$ FilePath
"Can't * " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
v1 FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" and " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
v2
Just Val
v -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
v
Divided Expr
e1 Expr
e2 -> do
v1 <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
v2 <- evalExpr e2
case maybeDividedBy v1 v2 of
Maybe Val
Nothing -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> MP m Val) -> FilePath -> MP m Val
forall a b. (a -> b) -> a -> b
$ FilePath
"Can't / " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
v1 FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" and " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
v2
Just Val
v -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
v
Set Expr
e [Arg]
args -> do
v <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
as' <- toArguments args
case v of
VFunction (Just Identifier
name) Map Identifier Val
_ Function
_ ->
(EvalState m -> EvalState m) -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((EvalState m -> EvalState m)
-> ParsecT [Markup] (EvalState m) m ())
-> (EvalState m -> EvalState m)
-> ParsecT [Markup] (EvalState m) m ()
forall a b. (a -> b) -> a -> b
$ \EvalState m
st ->
EvalState m
st
{ evalStyles =
M.alter
( \case
Maybe Arguments
Nothing -> Arguments -> Maybe Arguments
forall a. a -> Maybe a
Just Arguments
as'
Just Arguments
as'' -> Arguments -> Maybe Arguments
forall a. a -> Maybe a
Just (Arguments
as'' Arguments -> Arguments -> Arguments
forall a. Semigroup a => a -> a -> a
<> Arguments
as')
)
name
$ evalStyles st
}
Val
_ -> FilePath -> ParsecT [Markup] (EvalState m) m ()
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> ParsecT [Markup] (EvalState m) m ())
-> FilePath -> ParsecT [Markup] (EvalState m) m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Set expects an element name"
pure VNone
Show Maybe Expr
mbSelExpr Expr
e -> do
renderVal <- Scope -> MP m Val -> MP m Val
forall (m :: * -> *) a. Monad m => Scope -> MP m a -> MP m a
inBlock Scope
FunctionScope (MP m Val -> MP m Val) -> MP m Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
case mbSelExpr of
Maybe Expr
Nothing -> do
rest <- [Seq Content] -> Seq Content
forall a. Monoid a => [a] -> a
mconcat ([Seq Content] -> Seq Content)
-> ParsecT [Markup] (EvalState m) m [Seq Content]
-> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT [Markup] (EvalState m) m (Seq Content)
-> ParsecT [Markup] (EvalState m) m [Seq Content]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *). Monad m => MP m (Seq Content)
pContent ParsecT [Markup] (EvalState m) m [Seq Content]
-> ParsecT [Markup] (EvalState m) m ()
-> ParsecT [Markup] (EvalState m) m [Seq Content]
forall a b.
ParsecT [Markup] (EvalState m) m a
-> ParsecT [Markup] (EvalState m) m b
-> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT [Markup] (EvalState m) m ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)
case renderVal of
VFunction Maybe Identifier
_ Map Identifier Val
_ (Function forall (m :: * -> *). Monad m => Arguments -> MP m Val
f) ->
Seq Content -> Val
VContent (Seq Content -> Val) -> (Val -> Seq Content) -> Val -> Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Val -> Seq Content
valToContent
(Val -> Val) -> MP m Val -> MP m Val
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Arguments -> MP m Val
forall (m :: * -> *). Monad m => Arguments -> MP m Val
f Arguments {positional :: [Val]
positional = [Seq Content -> Val
VContent Seq Content
rest], named :: OMap Identifier Val
named = OMap Identifier Val
forall k v. OMap k v
OM.empty}
Val
_ -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Seq Content -> Val
VContent (Seq Content -> Val) -> Seq Content -> Val
forall a b. (a -> b) -> a -> b
$ Val -> Seq Content
valToContent Val
renderVal
Just Expr
selExpr -> do
selector <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
selExpr MP m Val
-> (Val -> ParsecT [Markup] (EvalState m) m Selector)
-> ParsecT [Markup] (EvalState m) m Selector
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
>>= Val -> ParsecT [Markup] (EvalState m) m Selector
forall (m :: * -> *). Monad m => Val -> MP m Selector
toSelector
case renderVal of
VFunction Maybe Identifier
_ Map Identifier Val
_ (Function forall (m :: * -> *). Monad m => Arguments -> MP m Val
f) ->
(EvalState m -> EvalState m) -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((EvalState m -> EvalState m)
-> ParsecT [Markup] (EvalState m) m ())
-> (EvalState m -> EvalState m)
-> ParsecT [Markup] (EvalState m) m ()
forall a b. (a -> b) -> a -> b
$ \EvalState m
st ->
EvalState m
st
{ evalShowRules =
ShowRule
(evalNextShowRuleIdentifier st)
selector
( \Content
c ->
Val -> Seq Content
valToContent
(Val -> Seq Content)
-> ParsecT [Markup] (EvalState m) m Val -> MP m (Seq Content)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Arguments -> ParsecT [Markup] (EvalState m) m Val
forall (m :: * -> *). Monad m => Arguments -> MP m Val
f
Arguments
{ positional :: [Val]
positional = [Seq Content -> Val
VContent (Content -> Seq Content
forall a. a -> Seq a
Seq.singleton Content
c)],
named :: OMap Identifier Val
named = OMap Identifier Val
forall k v. OMap k v
OM.empty
}
)
: evalShowRules st,
evalNextShowRuleIdentifier = evalNextShowRuleIdentifier st + 1
}
Val
_ -> (EvalState m -> EvalState m) -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((EvalState m -> EvalState m)
-> ParsecT [Markup] (EvalState m) m ())
-> (EvalState m -> EvalState m)
-> ParsecT [Markup] (EvalState m) m ()
forall a b. (a -> b) -> a -> b
$ \EvalState m
st ->
EvalState m
st
{ evalShowRules =
ShowRule
(evalNextShowRuleIdentifier st)
selector
( \Content
c ->
case Expr
e of
Set Expr
_ [Arg]
_ -> Seq Content -> MP m (Seq Content)
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Seq Content -> MP m (Seq Content))
-> Seq Content -> MP m (Seq Content)
forall a b. (a -> b) -> a -> b
$ Content -> Seq Content
forall a. a -> Seq a
Seq.singleton Content
c
Expr
_ -> Seq Content -> MP m (Seq Content)
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Seq Content
valToContent Val
renderVal)
)
: evalShowRules st,
evalNextShowRuleIdentifier = evalNextShowRuleIdentifier st + 1
}
pure VNone
Binding Bind
_ -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> MP m Val) -> FilePath -> MP m Val
forall a b. (a -> b) -> a -> b
$ FilePath
"Encountered binding out of proper context"
Assign Expr
e1 Expr
e2 -> do
val <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e2
case e1 of
Binding (BasicBind (Just Identifier
ident)) -> Identifier -> Val -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ()
updateIdentifier Identifier
ident Val
val
Binding (BasicBind Maybe Identifier
Nothing) -> () -> ParsecT [Markup] (EvalState m) m ()
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Binding (DestructuringBind [BindPart]
parts) ->
(forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ())
-> [BindPart] -> Val -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *).
Monad m =>
(forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ())
-> [BindPart] -> Val -> MP m ()
destructuringBind Identifier -> Val -> MP m' ()
forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ()
updateIdentifier [BindPart]
parts Val
val
Expr
x -> Expr -> Val -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *). Monad m => Expr -> Val -> MP m ()
updateExpression Expr
x Val
val
pure VNone
If [(Expr, Expr)]
clauses -> do
let go :: [(Expr, Expr)] -> ParsecT [Markup] (EvalState m) m Val
go [] = Val -> ParsecT [Markup] (EvalState m) m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
VNone
go ((Expr
cond, Expr
e) : [(Expr, Expr)]
rest) = do
val <- Expr -> ParsecT [Markup] (EvalState m) m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
cond
case val of
VBoolean Bool
True -> Expr -> ParsecT [Markup] (EvalState m) m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
VBoolean Bool
False -> [(Expr, Expr)] -> ParsecT [Markup] (EvalState m) m Val
go [(Expr, Expr)]
rest
Val
_ -> FilePath -> ParsecT [Markup] (EvalState m) m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"If requires a boolean condition"
[(Expr, Expr)] -> MP m Val
forall {m :: * -> *}.
Monad m =>
[(Expr, Expr)] -> ParsecT [Markup] (EvalState m) m Val
go [(Expr, Expr)]
clauses
While Expr
e1 Expr
e2 -> do
let go :: Val -> ParsecT [Markup] (EvalState m) m Val
go Val
result = do
condval <- Expr -> ParsecT [Markup] (EvalState m) m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
case condval of
VBoolean Bool
True -> do
val <- Expr -> ParsecT [Markup] (EvalState m) m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e2
hadBreak <- (== FlowBreak) . evalFlowDirective <$> getState
joinVals result val >>= if hadBreak then pure else go
VBoolean Bool
False -> Val -> ParsecT [Markup] (EvalState m) m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
result
Val
_ -> FilePath -> ParsecT [Markup] (EvalState m) m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"While loop requires a boolean condition"
(EvalState m -> EvalState m) -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((EvalState m -> EvalState m)
-> ParsecT [Markup] (EvalState m) m ())
-> (EvalState m -> EvalState m)
-> ParsecT [Markup] (EvalState m) m ()
forall a b. (a -> b) -> a -> b
$ \EvalState m
st -> EvalState m
st {evalFlowDirective = FlowNormal}
Val -> MP m Val
forall (m :: * -> *). Monad m => Val -> MP m Val
go Val
VNone
For Bind
bind Expr
e1 Expr
e2 -> do
let go :: [Val] -> Val -> ParsecT [Markup] (EvalState m) m Val
go [] Val
result = Val -> ParsecT [Markup] (EvalState m) m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
result
go (Val
x : [Val]
xs) Val
result = do
case Bind
bind of
BasicBind (Just Identifier
ident) -> Identifier -> Val -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ()
addIdentifier Identifier
ident Val
x
BasicBind Maybe Identifier
Nothing -> () -> ParsecT [Markup] (EvalState m) m ()
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
DestructuringBind [BindPart]
parts ->
(forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ())
-> [BindPart] -> Val -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *).
Monad m =>
(forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ())
-> [BindPart] -> Val -> MP m ()
destructuringBind Identifier -> Val -> MP m' ()
forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ()
addIdentifier [BindPart]
parts Val
x
val <- Expr -> ParsecT [Markup] (EvalState m) m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e2
hadBreak <- (== FlowBreak) . evalFlowDirective <$> getState
joinVals result val >>= if hadBreak then pure else go xs
source <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
items <- case source of
VString Text
t -> [Val] -> ParsecT [Markup] (EvalState m) m [Val]
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Val] -> ParsecT [Markup] (EvalState m) m [Val])
-> [Val] -> ParsecT [Markup] (EvalState m) m [Val]
forall a b. (a -> b) -> a -> b
$ (Char -> Val) -> FilePath -> [Val]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Val
VString (Text -> Val) -> (Char -> Text) -> Char -> Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton) (Text -> FilePath
T.unpack Text
t)
VArray Vector Val
v -> [Val] -> ParsecT [Markup] (EvalState m) m [Val]
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Val] -> ParsecT [Markup] (EvalState m) m [Val])
-> [Val] -> ParsecT [Markup] (EvalState m) m [Val]
forall a b. (a -> b) -> a -> b
$ Vector Val -> [Val]
forall a. Vector a -> [a]
V.toList Vector Val
v
VDict OMap Identifier Val
m ->
[Val] -> ParsecT [Markup] (EvalState m) m [Val]
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Val] -> ParsecT [Markup] (EvalState m) m [Val])
-> [Val] -> ParsecT [Markup] (EvalState m) m [Val]
forall a b. (a -> b) -> a -> b
$
((Identifier, Val) -> Val) -> [(Identifier, Val)] -> [Val]
forall a b. (a -> b) -> [a] -> [b]
map
( \(Identifier Text
k, Val
v) ->
Vector Val -> Val
VArray ([Val] -> Vector Val
forall a. [a] -> Vector a
V.fromList [Text -> Val
VString Text
k, Item [Val]
Val
v])
)
(OMap Identifier Val -> [(Identifier, Val)]
forall k v. OMap k v -> [(k, v)]
OM.assocs OMap Identifier Val
m)
Val
_ -> FilePath -> ParsecT [Markup] (EvalState m) m [Val]
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> ParsecT [Markup] (EvalState m) m [Val])
-> FilePath -> ParsecT [Markup] (EvalState m) m [Val]
forall a b. (a -> b) -> a -> b
$ FilePath
"For expression requires an Array or Dictionary"
updateState $ \EvalState m
st -> EvalState m
st {evalFlowDirective = FlowNormal}
go items VNone
Context Expr
e -> do
Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
Return Maybe Expr
mbe -> do
(EvalState m -> EvalState m) -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState (\EvalState m
st -> EvalState m
st {evalFlowDirective = FlowReturn (isJust mbe)})
MP m Val -> (Expr -> MP m Val) -> Maybe Expr -> MP m Val
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
VNone) Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Maybe Expr
mbe
Expr
Continue -> do
(EvalState m -> EvalState m) -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState (\EvalState m
st -> EvalState m
st {evalFlowDirective = FlowContinue})
Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
VNone
Expr
Break -> do
(EvalState m -> EvalState m) -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState (\EvalState m
st -> EvalState m
st {evalFlowDirective = FlowBreak})
Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
VNone
Label Text
t -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Text -> Val
VLabel Text
t
Import Expr
e Imports
imports -> do
argval <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
(modid, modmap) <-
case argval of
VString Text
t -> (Seq Content, (Identifier, Map Identifier Val))
-> (Identifier, Map Identifier Val)
forall a b. (a, b) -> b
snd ((Seq Content, (Identifier, Map Identifier Val))
-> (Identifier, Map Identifier Val))
-> ParsecT
[Markup]
(EvalState m)
m
(Seq Content, (Identifier, Map Identifier Val))
-> ParsecT
[Markup] (EvalState m) m (Identifier, Map Identifier Val)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> ParsecT
[Markup]
(EvalState m)
m
(Seq Content, (Identifier, Map Identifier Val))
forall (m :: * -> *).
Monad m =>
Text -> MP m (Seq Content, (Identifier, Map Identifier Val))
loadModule Text
t
VModule Identifier
i Map Identifier Val
m -> (Identifier, Map Identifier Val)
-> ParsecT
[Markup] (EvalState m) m (Identifier, Map Identifier Val)
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Identifier
i, Map Identifier Val
m)
VFunction (Just Identifier
i) Map Identifier Val
m Function
_ -> (Identifier, Map Identifier Val)
-> ParsecT
[Markup] (EvalState m) m (Identifier, Map Identifier Val)
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Identifier
i, Map Identifier Val
m)
VFunction Maybe Identifier
Nothing Map Identifier Val
m Function
_ -> (Identifier, Map Identifier Val)
-> ParsecT
[Markup] (EvalState m) m (Identifier, Map Identifier Val)
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Identifier
"anonymous", Map Identifier Val
m)
Val
_ -> FilePath
-> ParsecT
[Markup] (EvalState m) m (Identifier, Map Identifier Val)
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Import requires a path or module or function"
case imports of
Imports
AllIdentifiers -> Map Identifier Val -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *). Monad m => Map Identifier Val -> MP m ()
importModule Map Identifier Val
modmap
SomeIdentifiers [(Identifier, Maybe Identifier)]
pairs -> do
let addFromModule :: Map Identifier Val
-> (Identifier, Maybe Identifier) -> m (Map Identifier Val)
addFromModule Map Identifier Val
m (Identifier
ident, Maybe Identifier
mbAs) =
case Identifier -> Map Identifier Val -> Maybe Val
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Identifier
ident Map Identifier Val
modmap of
Maybe Val
Nothing -> FilePath -> m (Map Identifier Val)
forall a. FilePath -> m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> m (Map Identifier Val))
-> FilePath -> m (Map Identifier Val)
forall a b. (a -> b) -> a -> b
$ Identifier -> FilePath
forall a. Show a => a -> FilePath
show Identifier
ident FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" not defined in module"
Just Val
v -> Map Identifier Val -> m (Map Identifier Val)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map Identifier Val -> m (Map Identifier Val))
-> Map Identifier Val -> m (Map Identifier Val)
forall a b. (a -> b) -> a -> b
$ Identifier -> Val -> Map Identifier Val -> Map Identifier Val
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Identifier -> Maybe Identifier -> Identifier
forall a. a -> Maybe a -> a
fromMaybe Identifier
ident Maybe Identifier
mbAs) Val
v Map Identifier Val
m
(Map Identifier Val
-> (Identifier, Maybe Identifier)
-> ParsecT [Markup] (EvalState m) m (Map Identifier Val))
-> Map Identifier Val
-> [(Identifier, Maybe Identifier)]
-> ParsecT [Markup] (EvalState m) m (Map Identifier Val)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Map Identifier Val
-> (Identifier, Maybe Identifier)
-> ParsecT [Markup] (EvalState m) m (Map Identifier Val)
forall {m :: * -> *}.
MonadFail m =>
Map Identifier Val
-> (Identifier, Maybe Identifier) -> m (Map Identifier Val)
addFromModule Map Identifier Val
forall a. Monoid a => a
mempty [(Identifier, Maybe Identifier)]
pairs ParsecT [Markup] (EvalState m) m (Map Identifier Val)
-> (Map Identifier Val -> ParsecT [Markup] (EvalState m) m ())
-> ParsecT [Markup] (EvalState m) m ()
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
>>= Map Identifier Val -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *). Monad m => Map Identifier Val -> MP m ()
importModule
NoIdentifiers Maybe Identifier
mbAs -> do
let ident :: Identifier
ident = Identifier -> Maybe Identifier -> Identifier
forall a. a -> Maybe a -> a
fromMaybe Identifier
modid Maybe Identifier
mbAs
Identifier -> Val -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ()
addIdentifier Identifier
ident (Identifier -> Map Identifier Val -> Val
VModule Identifier
ident Map Identifier Val
modmap)
pure VNone
Include Expr
e -> do
argval <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
case argval of
VString Text
t -> do
(cs, _) <- Text
-> ParsecT
[Markup]
(EvalState m)
m
(Seq Content, (Identifier, Map Identifier Val))
forall (m :: * -> *).
Monad m =>
Text -> MP m (Seq Content, (Identifier, Map Identifier Val))
loadModule Text
t
pure $ VContent cs
Val
_ -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Include requires a path"
toFunction ::
Monad m =>
Maybe Identifier ->
[Param] ->
Expr ->
MP m Val
toFunction :: forall (m :: * -> *).
Monad m =>
Maybe Identifier -> [Param] -> Expr -> MP m Val
toFunction Maybe Identifier
mbname [Param]
params Expr
e = do
idents <- EvalState m -> [(Scope, Map Identifier Val)]
forall (m :: * -> *). EvalState m -> [(Scope, Map Identifier Val)]
evalIdentifiers (EvalState m -> [(Scope, Map Identifier Val)])
-> ParsecT [Markup] (EvalState m) m (EvalState m)
-> ParsecT [Markup] (EvalState m) m [(Scope, Map Identifier Val)]
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
let fn = Maybe Identifier -> Map Identifier Val -> Function -> Val
VFunction Maybe Identifier
forall a. Maybe a
Nothing Map Identifier Val
forall a. Monoid a => a
mempty (Function -> Val) -> Function -> Val
forall a b. (a -> b) -> a -> b
$ (forall (m :: * -> *). Monad m => Arguments -> MP m Val)
-> Function
Function ((forall (m :: * -> *). Monad m => Arguments -> MP m Val)
-> Function)
-> (forall (m :: * -> *). Monad m => Arguments -> MP m Val)
-> Function
forall a b. (a -> b) -> a -> b
$ \Arguments
arguments -> do
let showIdentifier :: Identifier -> FilePath
showIdentifier (Identifier Text
i) = Text -> FilePath
T.unpack Text
i
let isSinkParam :: Param -> Bool
isSinkParam (SinkParam {}) = Bool
True
isSinkParam Param
_ = Bool
False
let setParam :: Arguments -> Param -> ParsecT [Markup] (EvalState m) m Arguments
setParam Arguments
as (DefaultParam Identifier
ident Expr
e') = do
val <- case Identifier -> OMap Identifier Val -> Maybe Val
forall k v. Ord k => k -> OMap k v -> Maybe v
OM.lookup Identifier
ident (Arguments -> OMap Identifier Val
named Arguments
as) of
Maybe Val
Nothing -> Expr -> ParsecT [Markup] (EvalState m) m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e'
Just Val
v -> Val -> ParsecT [Markup] (EvalState m) m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
v
addIdentifier ident val
pure $ as {named = OM.delete ident (named as)}
setParam Arguments
as (NormalParam Identifier
ident) = do
case Arguments -> [Val]
positional Arguments
as of
[] -> FilePath -> ParsecT [Markup] (EvalState m) m Arguments
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath
"Expected parameter " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Identifier -> FilePath
showIdentifier Identifier
ident)
(Val
x : [Val]
xs) -> do
Identifier -> Val -> MP m ()
forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ()
addIdentifier Identifier
ident Val
x
Arguments -> ParsecT [Markup] (EvalState m) m Arguments
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Arguments -> ParsecT [Markup] (EvalState m) m Arguments)
-> Arguments -> ParsecT [Markup] (EvalState m) m Arguments
forall a b. (a -> b) -> a -> b
$ Arguments
as {positional = xs}
setParam Arguments
_ (SinkParam {}) =
FilePath -> ParsecT [Markup] (EvalState m) m Arguments
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"setParam encountered SinkParam"
setParam Arguments
as (DestructuringParam [BindPart]
parts) =
case Arguments -> [Val]
positional Arguments
as of
[] -> FilePath -> ParsecT [Markup] (EvalState m) m Arguments
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath
"Expected parameter " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> [BindPart] -> FilePath
forall a. Show a => a -> FilePath
show [BindPart]
parts)
(Val
x : [Val]
xs) -> do
(forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ())
-> [BindPart] -> Val -> MP m ()
forall (m :: * -> *).
Monad m =>
(forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ())
-> [BindPart] -> Val -> MP m ()
destructuringBind Identifier -> Val -> MP m' ()
forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ()
addIdentifier [BindPart]
parts Val
x
Arguments -> ParsecT [Markup] (EvalState m) m Arguments
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Arguments -> ParsecT [Markup] (EvalState m) m Arguments)
-> Arguments -> ParsecT [Markup] (EvalState m) m Arguments
forall a b. (a -> b) -> a -> b
$ Arguments
as {positional = xs}
setParam Arguments
as Param
SkipParam = Arguments -> ParsecT [Markup] (EvalState m) m Arguments
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Arguments
as
Scope -> MP m Val -> MP m Val
forall (m :: * -> *) a. Monad m => Scope -> MP m a -> MP m a
inBlock Scope
FunctionScope (MP m Val -> MP m Val) -> MP m Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ do
oldState <- ParsecT [Markup] (EvalState m) m (EvalState m)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
updateState $ \EvalState m
st -> EvalState m
st {evalIdentifiers = idents}
case mbname of
Maybe Identifier
Nothing -> () -> ParsecT [Markup] (EvalState m) m ()
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just Identifier
name -> Identifier -> Val -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ()
addIdentifier Identifier
name Val
fn
case break isSinkParam params of
([Param]
befores, SinkParam Maybe Identifier
mbident : [Param]
afters) -> do
as' <- (Arguments -> Param -> ParsecT [Markup] (EvalState m) m Arguments)
-> Arguments
-> [Param]
-> ParsecT [Markup] (EvalState m) m Arguments
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Arguments -> Param -> ParsecT [Markup] (EvalState m) m Arguments
forall {m :: * -> *}.
Monad m =>
Arguments -> Param -> ParsecT [Markup] (EvalState m) m Arguments
setParam Arguments
arguments [Param]
befores
as'' <-
foldM
setParam
as' {positional = reverse $ positional as'}
(reverse afters)
let as = Arguments
as'' {positional = reverse $ positional as''}
case mbident of
Just Identifier
ident -> Identifier -> Val -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ()
addIdentifier Identifier
ident (Arguments -> Val
VArguments Arguments
as)
Maybe Identifier
Nothing -> () -> ParsecT [Markup] (EvalState m) m ()
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
([Param], [Param])
_ -> (Arguments -> Param -> ParsecT [Markup] (EvalState m) m Arguments)
-> Arguments -> [Param] -> ParsecT [Markup] (EvalState m) m ()
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m ()
foldM_ Arguments -> Param -> ParsecT [Markup] (EvalState m) m Arguments
forall {m :: * -> *}.
Monad m =>
Arguments -> Param -> ParsecT [Markup] (EvalState m) m Arguments
setParam Arguments
arguments [Param]
params
res <- evalExpr e
setState oldState
pure res
pure fn
data Config = Config {
Config -> PackageConfig
package :: PackageConfig
} deriving (Int -> Config -> FilePath -> FilePath
[Config] -> FilePath -> FilePath
Config -> FilePath
(Int -> Config -> FilePath -> FilePath)
-> (Config -> FilePath)
-> ([Config] -> FilePath -> FilePath)
-> Show Config
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> Config -> FilePath -> FilePath
showsPrec :: Int -> Config -> FilePath -> FilePath
$cshow :: Config -> FilePath
show :: Config -> FilePath
$cshowList :: [Config] -> FilePath -> FilePath
showList :: [Config] -> FilePath -> FilePath
Show, (forall x. Config -> Rep Config x)
-> (forall x. Rep Config x -> Config) -> Generic Config
forall x. Rep Config x -> Config
forall x. Config -> Rep Config x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Config -> Rep Config x
from :: forall x. Config -> Rep Config x
$cto :: forall x. Rep Config x -> Config
to :: forall x. Rep Config x -> Config
Generic)
data PackageConfig = PackageConfig {
PackageConfig -> FilePath
entrypoint :: String
} deriving (Int -> PackageConfig -> FilePath -> FilePath
[PackageConfig] -> FilePath -> FilePath
PackageConfig -> FilePath
(Int -> PackageConfig -> FilePath -> FilePath)
-> (PackageConfig -> FilePath)
-> ([PackageConfig] -> FilePath -> FilePath)
-> Show PackageConfig
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> PackageConfig -> FilePath -> FilePath
showsPrec :: Int -> PackageConfig -> FilePath -> FilePath
$cshow :: PackageConfig -> FilePath
show :: PackageConfig -> FilePath
$cshowList :: [PackageConfig] -> FilePath -> FilePath
showList :: [PackageConfig] -> FilePath -> FilePath
Show, (forall x. PackageConfig -> Rep PackageConfig x)
-> (forall x. Rep PackageConfig x -> PackageConfig)
-> Generic PackageConfig
forall x. Rep PackageConfig x -> PackageConfig
forall x. PackageConfig -> Rep PackageConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PackageConfig -> Rep PackageConfig x
from :: forall x. PackageConfig -> Rep PackageConfig x
$cto :: forall x. Rep PackageConfig x -> PackageConfig
to :: forall x. Rep PackageConfig x -> PackageConfig
Generic)
instance Toml.FromValue Config where
fromValue :: forall l. Value' l -> Matcher l Config
fromValue = Value' l -> Matcher l Config
forall a l.
(Generic a, GParseTable (Rep a)) =>
Value' l -> Matcher l a
Toml.genericFromTable
instance Toml.FromValue PackageConfig where
fromValue :: forall l. Value' l -> Matcher l PackageConfig
fromValue = Value' l -> Matcher l PackageConfig
forall a l.
(Generic a, GParseTable (Rep a)) =>
Value' l -> Matcher l a
Toml.genericFromTable
findPackageEntryPoint :: Monad m => Text -> MP m FilePath
findPackageEntryPoint :: forall (m :: * -> *). Monad m => Text -> MP m FilePath
findPackageEntryPoint Text
modname = do
let (FilePath
namespace, FilePath
rest) = (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'/') (Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop Int
1 (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
modname)
let (FilePath
name, FilePath
rest') = (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
':') (FilePath -> (FilePath, FilePath))
-> FilePath -> (FilePath, FilePath)
forall a b. (a -> b) -> a -> b
$ Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop Int
1 FilePath
rest
let version :: FilePath
version = Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop Int
1 FilePath
rest'
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
let getEnv FilePath
var = do
mbv <- m (Maybe FilePath) -> t m (Maybe FilePath)
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe FilePath) -> t m (Maybe FilePath))
-> m (Maybe FilePath) -> t m (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ Operations m -> FilePath -> m (Maybe FilePath)
forall (m :: * -> *).
Operations m -> FilePath -> m (Maybe FilePath)
lookupEnvVar Operations m
operations FilePath
var
case mbv of
Just FilePath
v -> FilePath -> t m FilePath
forall a. a -> t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
v
Maybe FilePath
Nothing -> FilePath -> t m FilePath
forall a. FilePath -> t m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath
var FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" not defined")
#ifdef __MACOS__
homeDir <- getEnv "HOME"
let localDir = homeDir </> "Library" </> "Application Support" </> "typst"
let cacheDir = homeDir </> "Library" </> "Caches" </> "typst"
#elif __WINDOWS__
appDataDir <- getEnv "APPDATA"
let localDir = appDataDir </> "typst"
localAppDataDir <- getEnv "LOCALAPPDATA"
let cacheDir = localAppDataDir </> "typst"
#else
homeDir <- getEnv "HOME"
dataDir <- lift (lookupEnvVar operations "XDG_DATA_HOME") >>=
maybe (pure (homeDir </> ".local" </> "share")) pure
cacheDir' <- lift (lookupEnvVar operations "XDG_CACHE_HOME") >>=
maybe (pure (homeDir </> ".cache")) pure
let localDir = FilePath
dataDir FilePath -> FilePath -> FilePath
</> FilePath
"typst"
let cacheDir = FilePath
cacheDir' FilePath -> FilePath -> FilePath
</> FilePath
"typst"
#endif
let subpath = FilePath
"packages" FilePath -> FilePath -> FilePath
</> FilePath
namespace FilePath -> FilePath -> FilePath
</> FilePath
name FilePath -> FilePath -> FilePath
</> FilePath
version
inLocal <- lift $ checkExistence operations (localDir </> subpath </> "typst.toml")
tomlPath <-
if inLocal
then pure (localDir </> subpath </> "typst.toml")
else do
inCache <- lift $ checkExistence operations (cacheDir </> subpath </> "typst.toml")
if inCache
then pure (cacheDir </> subpath </> "typst.toml")
else fail $ "Could not find package in local packages or cache. Looked in\n" ++
(localDir </> subpath) ++ "\n" ++ (cacheDir </> subpath) ++
"\nCompile with typst compile to bring the package into your local cache."
tomlString <- TE.decodeUtf8 <$> lift (loadBytes operations tomlPath)
case Toml.decode tomlString of
Toml.Failure [FilePath]
e -> FilePath -> ParsecT [Markup] (EvalState m) m FilePath
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail ([FilePath] -> FilePath
unlines (FilePath
"Failure loading typst.toml" FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
e))
Toml.Success [FilePath]
_warnings Config
cfg ->
FilePath -> ParsecT [Markup] (EvalState m) m FilePath
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> FilePath -> FilePath
replaceFileName FilePath
tomlPath (PackageConfig -> FilePath
entrypoint (Config -> PackageConfig
package Config
cfg)))
loadModule :: Monad m => Text
-> MP m (Seq Content, (Identifier, M.Map Identifier Val))
loadModule :: forall (m :: * -> *).
Monad m =>
Text -> MP m (Seq Content, (Identifier, Map Identifier Val))
loadModule Text
modname = do
(fp, modid, mbPackageRoot, txt) <-
if Int -> Text -> Text
T.take Int
1 Text
modname Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"@"
then do
fp' <- Text -> MP m FilePath
forall (m :: * -> *). Monad m => Text -> MP m FilePath
findPackageEntryPoint Text
modname
operations <- evalOperations <$> getState
txt <- lift $ TE.decodeUtf8 <$> loadBytes operations fp'
pure ( takeFileName fp',
Identifier
(T.pack $ takeWhile (/= ':') . takeBaseName $
T.unpack modname),
Just (takeDirectory fp'),
txt )
else do
let fp :: FilePath
fp = Text -> FilePath
T.unpack Text
modname
txt <- FilePath -> ParsecT [Markup] (EvalState m) m Text
forall (m :: * -> *). Monad m => FilePath -> MP m Text
loadFileText FilePath
fp
pure ( fp,
Identifier (T.pack $ takeBaseName fp),
Nothing,
txt )
case parseTypst fp txt of
Left ParseError
err -> FilePath
-> ParsecT
[Markup]
(EvalState m)
m
(Seq Content, (Identifier, Map Identifier Val))
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath
-> ParsecT
[Markup]
(EvalState m)
m
(Seq Content, (Identifier, Map Identifier Val)))
-> FilePath
-> ParsecT
[Markup]
(EvalState m)
m
(Seq Content, (Identifier, Map Identifier Val))
forall a b. (a -> b) -> a -> b
$ ParseError -> FilePath
forall a. Show a => a -> FilePath
show ParseError
err
Right [Markup]
ms -> 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
currentLocalDir <- evalLocalDir <$> getState
currentPackageRoot <- evalPackageRoot <$> getState
let (pkgroot , localdir) =
case mbPackageRoot of
Just FilePath
r -> (FilePath
r , FilePath -> FilePath
takeDirectory FilePath
fp)
Maybe FilePath
Nothing -> (FilePath
currentPackageRoot,
FilePath
currentLocalDir FilePath -> FilePath -> FilePath
</> FilePath -> FilePath
takeDirectory FilePath
fp)
res <-
lift $
runParserT
( inBlock BlockScope $ do
cs <- mconcat <$> many pContent
eof
s <- getState
pure (cs, s)
)
initialEvalState{evalOperations = operations,
evalLocalDir = localdir,
evalPackageRoot = pkgroot }
fp
ms
case res of
Left ParseError
err' -> FilePath
-> ParsecT
[Markup]
(EvalState m)
m
(Seq Content, (Identifier, Map Identifier Val))
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath
-> ParsecT
[Markup]
(EvalState m)
m
(Seq Content, (Identifier, Map Identifier Val)))
-> FilePath
-> ParsecT
[Markup]
(EvalState m)
m
(Seq Content, (Identifier, Map Identifier Val))
forall a b. (a -> b) -> a -> b
$ ParseError -> FilePath
forall a. Show a => a -> FilePath
show ParseError
err'
Right (Seq Content
contents, EvalState m
st) ->
case EvalState m -> [(Scope, Map Identifier Val)]
forall (m :: * -> *). EvalState m -> [(Scope, Map Identifier Val)]
evalIdentifiers EvalState m
st of
[] -> FilePath
-> ParsecT
[Markup]
(EvalState m)
m
(Seq Content, (Identifier, Map Identifier Val))
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Empty evalIdentifiers in module!"
((Scope
_, Map Identifier Val
m) : [(Scope, Map Identifier Val)]
_) -> (Seq Content, (Identifier, Map Identifier Val))
-> ParsecT
[Markup]
(EvalState m)
m
(Seq Content, (Identifier, Map Identifier Val))
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Seq Content
contents, (Identifier
modid, Map Identifier Val
m))
importModule :: Monad m => M.Map Identifier Val -> MP m ()
importModule :: forall (m :: * -> *). Monad m => Map Identifier Val -> MP m ()
importModule Map Identifier Val
m = (EvalState m -> EvalState m) -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((EvalState m -> EvalState m)
-> ParsecT [Markup] (EvalState m) m ())
-> (EvalState m -> EvalState m)
-> ParsecT [Markup] (EvalState m) m ()
forall a b. (a -> b) -> a -> b
$ \EvalState m
st ->
EvalState m
st
{ evalIdentifiers =
case evalIdentifiers st of
[] -> [(Scope
BlockScope, Map Identifier Val
m)]
((Scope
s, Map Identifier Val
i) : [(Scope, Map Identifier Val)]
is) -> (Scope
s, Map Identifier Val
m Map Identifier Val -> Map Identifier Val -> Map Identifier Val
forall a. Semigroup a => a -> a -> a
<> Map Identifier Val
i) (Scope, Map Identifier Val)
-> [(Scope, Map Identifier Val)] -> [(Scope, Map Identifier Val)]
forall a. a -> [a] -> [a]
: [(Scope, Map Identifier Val)]
is
}
evalLiteral :: Literal -> Val
evalLiteral :: Literal -> Val
evalLiteral Literal
lit =
case Literal
lit of
String Text
t -> Text -> Val
VString Text
t
Boolean Bool
b -> Bool -> Val
VBoolean Bool
b
Float Double
x -> Double -> Val
VFloat Double
x
Int Integer
i -> Integer -> Val
VInteger Integer
i
Numeric Double
x Unit
unit ->
case Unit
unit of
Unit
Fr -> Double -> Val
VFraction Double
x
Unit
Percent -> Rational -> Val
VRatio (Double -> Rational
forall a. Real a => a -> Rational
toRational Double
x Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
100)
Unit
Deg -> Double -> Val
VAngle Double
x
Unit
Rad -> Double -> Val
VAngle (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
180 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
forall a. Floating a => a
pi))
Unit
Pt -> Length -> Val
VLength (Double -> LUnit -> Length
LExact Double
x LUnit
LPt)
Unit
Em -> Length -> Val
VLength (Double -> LUnit -> Length
LExact Double
x LUnit
LEm)
Unit
Mm -> Length -> Val
VLength (Double -> LUnit -> Length
LExact Double
x LUnit
LMm)
Unit
Cm -> Length -> Val
VLength (Double -> LUnit -> Length
LExact Double
x LUnit
LCm)
Unit
In -> Length -> Val
VLength (Double -> LUnit -> Length
LExact Double
x LUnit
LIn)
Literal
None -> Val
VNone
Literal
Auto -> Val
VAuto
toArguments :: Monad m => [Arg] -> MP m Arguments
toArguments :: forall (m :: * -> *). Monad m => [Arg] -> MP m Arguments
toArguments = (Arguments -> Arg -> ParsecT [Markup] (EvalState m) m Arguments)
-> Arguments -> [Arg] -> ParsecT [Markup] (EvalState m) m Arguments
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Arguments -> Arg -> ParsecT [Markup] (EvalState m) m Arguments
forall {m :: * -> *}.
Monad m =>
Arguments -> Arg -> ParsecT [Markup] (EvalState m) m Arguments
addArg ([Val] -> OMap Identifier Val -> Arguments
Arguments [Val]
forall a. Monoid a => a
mempty OMap Identifier Val
forall k v. OMap k v
OM.empty)
where
addArg :: Arguments -> Arg -> ParsecT [Markup] (EvalState m) m Arguments
addArg Arguments
args (KeyValArg Identifier
ident Expr
e) = do
val <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
pure $ args {named = named args OM.|> (ident, val)}
addArg Arguments
args (NormalArg Expr
e) = do
val <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
pure $ args {positional = positional args ++ [val]}
addArg Arguments
args (ArrayArg [[Markup]]
rows) = do
let pRow :: [Markup] -> MP m Val
pRow =
([Val] -> Val)
-> ParsecT [Markup] (EvalState m) m [Val] -> MP m Val
forall a b.
(a -> b)
-> ParsecT [Markup] (EvalState m) m a
-> ParsecT [Markup] (EvalState m) m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Vector Val -> Val
VArray (Vector Val -> Val) -> ([Val] -> Vector Val) -> [Val] -> Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Val] -> Vector Val
forall a. [a] -> Vector a
V.fromList)
(ParsecT [Markup] (EvalState m) m [Val] -> MP m Val)
-> ([Markup] -> ParsecT [Markup] (EvalState m) m [Val])
-> [Markup]
-> MP m Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Markup -> MP m Val)
-> [Markup] -> ParsecT [Markup] (EvalState m) m [Val]
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 ((Seq Content -> Val)
-> ParsecT [Markup] (EvalState m) m (Seq Content) -> MP m Val
forall a b.
(a -> b)
-> ParsecT [Markup] (EvalState m) m a
-> ParsecT [Markup] (EvalState m) m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Seq Content -> Val
VContent (ParsecT [Markup] (EvalState m) m (Seq Content) -> MP m Val)
-> (Markup -> ParsecT [Markup] (EvalState m) m (Seq Content))
-> Markup
-> MP m Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Markup] -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents ([Markup] -> ParsecT [Markup] (EvalState m) m (Seq Content))
-> (Markup -> [Markup])
-> Markup
-> ParsecT [Markup] (EvalState m) m (Seq Content)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Markup -> [Markup] -> [Markup]
forall a. a -> [a] -> [a]
: []))
vals <- ([Markup] -> MP m Val)
-> [[Markup]] -> ParsecT [Markup] (EvalState m) m [Val]
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 [Markup] -> MP m Val
pRow [[Markup]]
rows
pure $ args {positional = positional args ++ vals}
addArg Arguments
args (SpreadArg Expr
e) = do
val <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
case val of
Val
VNone -> Arguments -> ParsecT [Markup] (EvalState m) m Arguments
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Arguments
forall a. Monoid a => a
mempty
VArguments Arguments
args' -> Arguments -> ParsecT [Markup] (EvalState m) m Arguments
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Arguments -> ParsecT [Markup] (EvalState m) m Arguments)
-> Arguments -> ParsecT [Markup] (EvalState m) m Arguments
forall a b. (a -> b) -> a -> b
$ Arguments
args Arguments -> Arguments -> Arguments
forall a. Semigroup a => a -> a -> a
<> Arguments
args'
VDict OMap Identifier Val
m ->
Arguments -> ParsecT [Markup] (EvalState m) m Arguments
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Arguments -> ParsecT [Markup] (EvalState m) m Arguments)
-> Arguments -> ParsecT [Markup] (EvalState m) m Arguments
forall a b. (a -> b) -> a -> b
$
Arguments
args
Arguments -> Arguments -> Arguments
forall a. Semigroup a => a -> a -> a
<> Arguments {positional :: [Val]
positional = [Val]
forall a. Monoid a => a
mempty, named :: OMap Identifier Val
named = OMap Identifier Val
m}
VArray Vector Val
v ->
Arguments -> ParsecT [Markup] (EvalState m) m Arguments
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Arguments -> ParsecT [Markup] (EvalState m) m Arguments)
-> Arguments -> ParsecT [Markup] (EvalState m) m Arguments
forall a b. (a -> b) -> a -> b
$
Arguments
args
Arguments -> Arguments -> Arguments
forall a. Semigroup a => a -> a -> a
<> Arguments {positional :: [Val]
positional = Vector Val -> [Val]
forall a. Vector a -> [a]
V.toList Vector Val
v, named :: OMap Identifier Val
named = OMap Identifier Val
forall k v. OMap k v
OM.empty}
Val
_ -> FilePath -> ParsecT [Markup] (EvalState m) m Arguments
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> ParsecT [Markup] (EvalState m) m Arguments)
-> FilePath -> ParsecT [Markup] (EvalState m) m Arguments
forall a b. (a -> b) -> a -> b
$ FilePath
"spread requires an argument value, got " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
val
addArg Arguments
args (BlockArg [Markup]
ms) = do
val <- [Markup] -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Markup]
ms
pure $ args {positional = positional args ++ [VContent val]}
addIdentifier :: Monad m => Identifier -> Val -> MP m ()
addIdentifier :: forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ()
addIdentifier Identifier
ident Val
val = do
identifiers <- EvalState m -> [(Scope, Map Identifier Val)]
forall (m :: * -> *). EvalState m -> [(Scope, Map Identifier Val)]
evalIdentifiers (EvalState m -> [(Scope, Map Identifier Val)])
-> ParsecT [Markup] (EvalState m) m (EvalState m)
-> ParsecT [Markup] (EvalState m) m [(Scope, Map Identifier Val)]
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
case identifiers of
[] -> FilePath -> ParsecT [Markup] (EvalState m) m ()
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Empty evalIdentifiers"
((Scope
s, Map Identifier Val
i) : [(Scope, Map Identifier Val)]
is) -> (EvalState m -> EvalState m) -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((EvalState m -> EvalState m)
-> ParsecT [Markup] (EvalState m) m ())
-> (EvalState m -> EvalState m)
-> ParsecT [Markup] (EvalState m) m ()
forall a b. (a -> b) -> a -> b
$ \EvalState m
st ->
EvalState m
st { evalIdentifiers = (s, M.insert ident val i) : is }
updateIdentifier :: Monad m => Identifier -> Val -> MP m ()
updateIdentifier :: forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ()
updateIdentifier Identifier
ident Val
val = do
let go :: (Bool, [(Scope, Map Identifier Val)])
-> (Scope, Map Identifier Val)
-> f (Bool, [(Scope, Map Identifier Val)])
go (Bool
True, [(Scope, Map Identifier Val)]
is) (Scope
s, Map Identifier Val
m) = (Bool, [(Scope, Map Identifier Val)])
-> f (Bool, [(Scope, Map Identifier Val)])
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
True, (Scope
s, Map Identifier Val
m) (Scope, Map Identifier Val)
-> [(Scope, Map Identifier Val)] -> [(Scope, Map Identifier Val)]
forall a. a -> [a] -> [a]
: [(Scope, Map Identifier Val)]
is)
go (Bool
False, [(Scope, Map Identifier Val)]
is) (Scope
s, Map Identifier Val
m) =
case Identifier -> Map Identifier Val -> Maybe Val
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Identifier
ident Map Identifier Val
m of
Maybe Val
Nothing
| Scope
s Scope -> Scope -> Bool
forall a. Eq a => a -> a -> Bool
== Scope
FunctionScope -> FilePath -> f (Bool, [(Scope, Map Identifier Val)])
forall a. FilePath -> f a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> f (Bool, [(Scope, Map Identifier Val)]))
-> FilePath -> f (Bool, [(Scope, Map Identifier Val)])
forall a b. (a -> b) -> a -> b
$ Identifier -> FilePath
forall a. Show a => a -> FilePath
show Identifier
ident FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" not defined in scope"
| Bool
otherwise -> (Bool, [(Scope, Map Identifier Val)])
-> f (Bool, [(Scope, Map Identifier Val)])
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
False, (Scope
s, Map Identifier Val
m) (Scope, Map Identifier Val)
-> [(Scope, Map Identifier Val)] -> [(Scope, Map Identifier Val)]
forall a. a -> [a] -> [a]
: [(Scope, Map Identifier Val)]
is)
Just Val
_ -> (Bool, [(Scope, Map Identifier Val)])
-> f (Bool, [(Scope, Map Identifier Val)])
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
True, (Scope
s, (Val -> Val)
-> Identifier -> Map Identifier Val -> Map Identifier Val
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust (Val -> Val -> Val
forall a b. a -> b -> a
const Val
val) Identifier
ident Map Identifier Val
m) (Scope, Map Identifier Val)
-> [(Scope, Map Identifier Val)] -> [(Scope, Map Identifier Val)]
forall a. a -> [a] -> [a]
: [(Scope, Map Identifier Val)]
is)
(finished, newmaps) <- 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 (Bool, [(Scope, Map Identifier Val)]))
-> ParsecT
[Markup] (EvalState m) m (Bool, [(Scope, Map Identifier Val)])
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
>>= ((Bool, [(Scope, Map Identifier Val)])
-> (Scope, Map Identifier Val)
-> ParsecT
[Markup] (EvalState m) m (Bool, [(Scope, Map Identifier Val)]))
-> (Bool, [(Scope, Map Identifier Val)])
-> [(Scope, Map Identifier Val)]
-> ParsecT
[Markup] (EvalState m) m (Bool, [(Scope, Map Identifier Val)])
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Bool, [(Scope, Map Identifier Val)])
-> (Scope, Map Identifier Val)
-> ParsecT
[Markup] (EvalState m) m (Bool, [(Scope, Map Identifier Val)])
forall {f :: * -> *}.
MonadFail f =>
(Bool, [(Scope, Map Identifier Val)])
-> (Scope, Map Identifier Val)
-> f (Bool, [(Scope, Map Identifier Val)])
go (Bool
False, []) ([(Scope, Map Identifier Val)]
-> ParsecT
[Markup] (EvalState m) m (Bool, [(Scope, Map Identifier Val)]))
-> (EvalState m -> [(Scope, Map Identifier Val)])
-> EvalState m
-> ParsecT
[Markup] (EvalState m) m (Bool, [(Scope, Map Identifier Val)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalState m -> [(Scope, Map Identifier Val)]
forall (m :: * -> *). EvalState m -> [(Scope, Map Identifier Val)]
evalIdentifiers
if finished
then updateState $ \EvalState m
st -> EvalState m
st {evalIdentifiers = reverse newmaps}
else fail $ show ident <> " not defined"
inBlock :: Monad m => Scope -> MP m a -> MP m a
inBlock :: forall (m :: * -> *) a. Monad m => Scope -> MP m a -> MP m a
inBlock Scope
scope MP m a
pa = do
oldStyles <- EvalState m -> Map Identifier Arguments
forall (m :: * -> *). EvalState m -> Map Identifier Arguments
evalStyles (EvalState m -> Map Identifier Arguments)
-> ParsecT [Markup] (EvalState m) m (EvalState m)
-> ParsecT [Markup] (EvalState m) m (Map Identifier Arguments)
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
updateState $ \EvalState m
st ->
EvalState m
st
{ evalIdentifiers = (scope, mempty) : evalIdentifiers st
}
result <- pa
updateState $ \EvalState m
st ->
EvalState m
st
{ evalIdentifiers = drop 1 (evalIdentifiers st),
evalStyles = oldStyles
}
pure result
updateExpression :: Monad m => Expr -> Val -> MP m ()
updateExpression :: forall (m :: * -> *). Monad m => Expr -> Val -> MP m ()
updateExpression
(FuncCall (FieldAccess (Ident (Identifier Text
"first")) Expr
e') []) Val
val
= Expr -> Val -> MP m ()
forall (m :: * -> *). Monad m => Expr -> Val -> MP m ()
updateExpression ( Expr -> [Arg] -> Expr
FuncCall
(Expr -> Expr -> Expr
FieldAccess (Identifier -> Expr
Ident (Text -> Identifier
Identifier Text
"at")) Expr
e')
[Expr -> Arg
NormalArg (Literal -> Expr
Literal (Integer -> Literal
Int Integer
0))]
) Val
val
updateExpression
(FuncCall (FieldAccess (Ident (Identifier Text
"last")) Expr
e') []) Val
val
= Expr -> Val -> MP m ()
forall (m :: * -> *). Monad m => Expr -> Val -> MP m ()
updateExpression ( Expr -> [Arg] -> Expr
FuncCall
(Expr -> Expr -> Expr
FieldAccess (Identifier -> Expr
Ident (Text -> Identifier
Identifier Text
"at")) Expr
e')
[Expr -> Arg
NormalArg (Literal -> Expr
Literal (Integer -> Literal
Int (-Integer
1)))]
) Val
val
updateExpression
(FieldAccess (Ident (Identifier Text
fld)) Expr
e') Val
val
= Bool -> Expr -> Expr -> Val -> MP m ()
forall (m :: * -> *).
Monad m =>
Bool -> Expr -> Expr -> Val -> MP m ()
updateExpression' Bool
True Expr
e' (Literal -> Expr
Literal (Text -> Literal
String Text
fld)) Val
val
updateExpression (Ident Identifier
i) Val
val = Identifier -> Val -> MP m ()
forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ()
updateIdentifier Identifier
i Val
val
updateExpression
(FuncCall
(FieldAccess (Ident (Identifier Text
"at")) Expr
e') [NormalArg Expr
arg]) Val
val
= Bool -> Expr -> Expr -> Val -> MP m ()
forall (m :: * -> *).
Monad m =>
Bool -> Expr -> Expr -> Val -> MP m ()
updateExpression' Bool
False Expr
e' Expr
arg Val
val
updateExpression Expr
e Val
_ = FilePath -> MP m ()
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> MP m ()) -> FilePath -> MP m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Cannot update expression " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Expr -> FilePath
forall a. Show a => a -> FilePath
show Expr
e
updateExpression' :: Monad m => Bool -> Expr -> Expr -> Val -> MP m ()
updateExpression' :: forall (m :: * -> *).
Monad m =>
Bool -> Expr -> Expr -> Val -> MP m ()
updateExpression' Bool
allowNewIndices Expr
e Expr
arg Val
val = do
container <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
idx <- evalExpr arg
case container of
VArray Vector Val
v ->
case Val
idx of
VInteger Integer
i ->
let i' :: Int
i' = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i
in case Vector Val
v Vector Val -> Int -> Maybe Val
forall a. Vector a -> Int -> Maybe a
V.!? Int
i' of
Maybe Val
Nothing | Bool -> Bool
not Bool
allowNewIndices
-> FilePath -> ParsecT [Markup] (EvalState m) m ()
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> ParsecT [Markup] (EvalState m) m ())
-> FilePath -> ParsecT [Markup] (EvalState m) m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Vector does not contain index " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a. Show a => a -> FilePath
show Int
i'
Maybe Val
_ -> Expr -> Val -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *). Monad m => Expr -> Val -> MP m ()
updateExpression Expr
e (Val -> ParsecT [Markup] (EvalState m) m ())
-> Val -> ParsecT [Markup] (EvalState m) m ()
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 Val
v Vector Val -> [(Int, Val)] -> Vector Val
forall a. Vector a -> [(Int, a)] -> Vector a
V.// [(Int
i', Val
val)]
Val
_ -> FilePath -> ParsecT [Markup] (EvalState m) m ()
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> ParsecT [Markup] (EvalState m) m ())
-> FilePath -> ParsecT [Markup] (EvalState m) m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Cannot index array with " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
idx
VDict OMap Identifier Val
d ->
case Val
idx of
VString Text
fld ->
case Identifier -> OMap Identifier Val -> Maybe Val
forall k v. Ord k => k -> OMap k v -> Maybe v
OM.lookup (Text -> Identifier
Identifier Text
fld) OMap Identifier Val
d of
Maybe Val
Nothing | Bool -> Bool
not Bool
allowNewIndices
-> FilePath -> ParsecT [Markup] (EvalState m) m ()
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> ParsecT [Markup] (EvalState m) m ())
-> FilePath -> ParsecT [Markup] (EvalState m) m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Dictionary does not contain key " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
forall a. Show a => a -> FilePath
show Text
fld
Maybe Val
_ -> Expr -> Val -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *). Monad m => Expr -> Val -> MP m ()
updateExpression Expr
e (Val -> ParsecT [Markup] (EvalState m) m ())
-> Val -> ParsecT [Markup] (EvalState m) m ()
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
$
(Maybe Val -> Maybe Val)
-> Identifier -> OMap Identifier Val -> OMap Identifier Val
forall k v.
Ord k =>
(Maybe v -> Maybe v) -> k -> OMap k v -> OMap k v
OM.alter
( \case
Just Val
_ -> Val -> Maybe Val
forall a. a -> Maybe a
Just Val
val
Maybe Val
Nothing -> Val -> Maybe Val
forall a. a -> Maybe a
Just Val
val
)
(Text -> Identifier
Identifier Text
fld)
OMap Identifier Val
d
Val
_ -> FilePath -> ParsecT [Markup] (EvalState m) m ()
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> ParsecT [Markup] (EvalState m) m ())
-> FilePath -> ParsecT [Markup] (EvalState m) m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Cannot index dictionary with " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
idx
Val
_ -> FilePath -> ParsecT [Markup] (EvalState m) m ()
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> ParsecT [Markup] (EvalState m) m ())
-> FilePath -> ParsecT [Markup] (EvalState m) m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Cannot update expression " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Expr -> FilePath
forall a. Show a => a -> FilePath
show Expr
e
toSelector :: Monad m => Val -> MP m Selector
toSelector :: forall (m :: * -> *). Monad m => Val -> MP m Selector
toSelector (VSelector Selector
s) = Selector -> ParsecT [Markup] (EvalState m) m Selector
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Selector
s
toSelector (VFunction (Just Identifier
name) Map Identifier Val
_ Function
_) = Selector -> ParsecT [Markup] (EvalState m) m Selector
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Selector -> ParsecT [Markup] (EvalState m) m Selector)
-> Selector -> ParsecT [Markup] (EvalState m) m Selector
forall a b. (a -> b) -> a -> b
$ Identifier -> [(Identifier, Val)] -> Selector
SelectElement Identifier
name []
toSelector (VString Text
t) = Selector -> ParsecT [Markup] (EvalState m) m Selector
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Selector -> ParsecT [Markup] (EvalState m) m Selector)
-> Selector -> ParsecT [Markup] (EvalState m) m Selector
forall a b. (a -> b) -> a -> b
$ Text -> Selector
SelectString Text
t
toSelector (VRegex RE
re) = Selector -> ParsecT [Markup] (EvalState m) m Selector
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Selector -> ParsecT [Markup] (EvalState m) m Selector)
-> Selector -> ParsecT [Markup] (EvalState m) m Selector
forall a b. (a -> b) -> a -> b
$ RE -> Selector
SelectRegex RE
re
toSelector (VLabel Text
t) = Selector -> ParsecT [Markup] (EvalState m) m Selector
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Selector -> ParsecT [Markup] (EvalState m) m Selector)
-> Selector -> ParsecT [Markup] (EvalState m) m Selector
forall a b. (a -> b) -> a -> b
$ Text -> Selector
SelectLabel Text
t
toSelector (VSymbol (Symbol Text
t Bool
_ [(Set Text, Text)]
_)) = Selector -> ParsecT [Markup] (EvalState m) m Selector
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Selector -> ParsecT [Markup] (EvalState m) m Selector)
-> Selector -> ParsecT [Markup] (EvalState m) m Selector
forall a b. (a -> b) -> a -> b
$ Text -> Selector
SelectString Text
t
toSelector Val
v = FilePath -> ParsecT [Markup] (EvalState m) m Selector
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> ParsecT [Markup] (EvalState m) m Selector)
-> FilePath -> ParsecT [Markup] (EvalState m) m Selector
forall a b. (a -> b) -> a -> b
$ FilePath
"could not convert " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
v FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" to selector"