{-# 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, takeDirectory, (</>))
import Text.Parsec
import Typst.Bind (destructuringBind)
import Typst.Methods (getMethod)
import Typst.Module.Standard (loadFileText, standardModule, symModule,
                              sysModule)
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.FromValue as Toml
import qualified Toml.FromValue.Generic as Toml

-- import Debug.Trace

-- | Evaluate a parsed typst expression, evaluating the code and
-- replacing it with content.
evaluateTypst ::
  Monad m =>
  -- | Dictionary of functions for IO operations
  Operations m ->
  -- | Path of parsed content
  FilePath ->
  -- | Markup produced by 'parseTypst'
  [Markup] ->
  m (Either ParseError Content)
evaluateTypst :: forall (m :: * -> *).
Monad m =>
Operations m
-> FilePath -> [Markup] -> m (Either ParseError Content)
evaluateTypst Operations m
operations =
  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 Seq Content
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
        -- "All documents are automatically wrapped in a document element."
        Content -> ParsecT [Markup] (EvalState m) m Content
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Content -> ParsecT [Markup] (EvalState m) m Content)
-> Content -> ParsecT [Markup] (EvalState m) m Content
forall a b. (a -> b) -> a -> b
$ Identifier -> Maybe SourcePos -> Map Identifier Val -> Content
Elt Identifier
"document" Maybe SourcePos
forall a. Maybe a
Nothing [(Identifier
"body", Seq Content -> Val
VContent Seq Content
contents)])
    EvalState Any
forall (m :: * -> *). EvalState m
initialEvalState { evalOperations = operations,
                       evalPackageRoot = "." }

initialEvalState :: EvalState m
initialEvalState :: forall (m :: * -> *). EvalState m
initialEvalState =
  EvalState m
forall (m :: * -> *). EvalState m
emptyEvalState { evalIdentifiers = [(BlockScope, standardModule')] }
  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
    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
      Text
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 FilePath -> Text -> Either ParseError [Markup]
parseTypst FilePath
"eval" (Text
"#{\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
code Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\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] ->
          -- run in Either monad so we can't access file system
          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

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 -- TODO localize
getText Markup
_ = Text
""

pTxt :: Monad m => MP m (Seq Content)
pTxt :: forall (m :: * -> *). Monad m => MP m (Seq Content)
pTxt = do
  Bool
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
  Text
txt <-
    if Bool
mathMode
      then Markup -> Text
getText (Markup -> Text)
-> ParsecT [Markup] (EvalState m) m Markup
-> ParsecT [Markup] (EvalState m) m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Markup -> Bool) -> ParsecT [Markup] (EvalState m) m Markup
forall (m :: * -> *). Monad m => (Markup -> Bool) -> MP m Markup
satisfyTok Markup -> Bool
isText
      else [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> ([Markup] -> [Text]) -> [Markup] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Markup -> Text) -> [Markup] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Markup -> Text
getText ([Markup] -> [Text])
-> ([Markup] -> [Markup]) -> [Markup] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Markup] -> [Markup]
setQuotes ([Markup] -> Text)
-> ParsecT [Markup] (EvalState m) m [Markup]
-> ParsecT [Markup] (EvalState m) m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Markup] (EvalState m) m Markup
-> ParsecT [Markup] (EvalState m) m [Markup]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ((Markup -> Bool) -> ParsecT [Markup] (EvalState m) m Markup
forall (m :: * -> *). Monad m => (Markup -> Bool) -> MP m Markup
satisfyTok Markup -> Bool
isText)
  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 -> Seq Content) -> Content -> Seq Content
forall a b. (a -> b) -> a -> b
$ Text -> Content
Txt Text
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` ([Text
Item [Text]
")", Text
Item [Text]
".", Text
Item [Text]
",", Text
Item [Text]
";", Text
Item [Text]
":", Text
Item [Text]
"?", Text
Item [Text]
"!", Text
Item [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` ([Text
Item [Text]
")", Text
Item [Text]
".", Text
Item [Text]
",", Text
Item [Text]
";", Text
Item [Text]
":", Text
Item [Text]
"?", Text
Item [Text]
"!", Text
Item [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
  [Markup]
oldInput <- ParsecT [Markup] (EvalState m) m [Markup]
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
  SourcePos
oldPos <- ParsecT [Markup] (EvalState m) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  [ShowRule]
oldShowRules <- EvalState m -> [ShowRule]
forall (m :: * -> *). EvalState m -> [ShowRule]
evalShowRules (EvalState m -> [ShowRule])
-> ParsecT [Markup] (EvalState m) m (EvalState m)
-> ParsecT [Markup] (EvalState m) m [ShowRule]
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
  [Markup] -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
setInput [Markup]
ms
  Seq Content
result <- [Seq Content] -> Seq Content
forall a. Monoid a => [a] -> a
mconcat ([Seq Content] -> Seq Content)
-> ParsecT [Markup] (EvalState m) m [Seq Content]
-> MP m (Seq Content)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MP 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 MP 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)
  [Markup] -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
setInput [Markup]
oldInput
  SourcePos -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition SourcePos
oldPos
  (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 = oldShowRules}
  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
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
  -- lookup styles set by "set" and apply them as defaults:
  Maybe Arguments
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
  Arguments -> MP m Val
forall (m :: * -> *). Monad m => Arguments -> MP m Val
f (Arguments -> MP m Val) -> Arguments -> MP m Val
forall a b. (a -> b) -> a -> b
$ Arguments
-> (Arguments -> Arguments) -> Maybe Arguments -> Arguments
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Arguments
args (Arguments -> Arguments -> Arguments
forall a. Semigroup a => a -> a -> a
<> Arguments
args) Maybe Arguments
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
  Val
eltfn <- Identifier -> MP m Val
forall (m :: * -> *). Monad m => Identifier -> MP m Val
lookupIdentifier Identifier
name
  case Val
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 -> MP 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 -> MP 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 -> MP m (Seq Content)
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> MP m (Seq Content)) -> FilePath -> MP 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
  Markup
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 Markup
tok of
    Markup
ParBreak -> Identifier -> Arguments -> MP 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 -> MP 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 -> MP 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 ()
-> MP m (Seq Content) -> MP 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 -> MP m (Seq Content)
forall (m :: * -> *). Monad m => Expr -> MP m (Seq Content)
pExpr Expr
expr
    Emph [Markup]
ms -> do
      Seq Content
body <- [Markup] -> MP m (Seq Content)
forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Markup]
ms
      Identifier -> Arguments -> MP m (Seq Content)
forall (m :: * -> *).
Monad m =>
Identifier -> Arguments -> MP m (Seq Content)
element Identifier
"emph" Arguments {positional :: [Val]
positional = [Seq Content -> Val
VContent Seq Content
body], named :: OMap Identifier Val
named = OMap Identifier Val
forall k v. OMap k v
OM.empty}
    Strong [Markup]
ms -> do
      Seq Content
body <- [Markup] -> MP m (Seq Content)
forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Markup]
ms
      Identifier -> Arguments -> MP m (Seq Content)
forall (m :: * -> *).
Monad m =>
Identifier -> Arguments -> MP m (Seq Content)
element Identifier
"strong" Arguments {positional :: [Val]
positional = [Seq Content -> Val
VContent Seq Content
body], named :: OMap Identifier Val
named = OMap Identifier Val
forall k v. OMap k v
OM.empty}
    Bracketed [Markup]
ms -> do
      Seq Content
body <- [Markup] -> MP m (Seq Content)
forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Markup]
ms
      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
$ (Text -> Content
Txt Text
"[" Content -> Seq Content -> Seq Content
forall a. a -> Seq a -> Seq a
Seq.<| Seq Content
body) Seq Content -> Content -> Seq Content
forall a. Seq a -> a -> Seq a
Seq.|> Text -> Content
Txt Text
"]"
    RawBlock Text
lang Text
txt ->
      Identifier -> Arguments -> MP 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 -> MP 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
      Seq Content
content <- [Markup] -> MP m (Seq Content)
forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Markup]
ms
      Identifier -> Arguments -> MP m (Seq Content)
forall (m :: * -> *).
Monad m =>
Identifier -> Arguments -> MP m (Seq Content)
element
        Identifier
"heading"
        Arguments
          { positional :: [Val]
positional = [Seq Content -> Val
VContent Seq Content
content],
            named :: OMap Identifier Val
named =
              [(Identifier, Val)] -> OMap Identifier Val
forall k v. Ord k => [(k, v)] -> OMap k v
OM.fromList
                [(Identifier
"level", Integer -> Val
VInteger (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
level))]
          }
    Equation Bool
display [Markup]
ms -> Scope -> MP m (Seq Content) -> MP m (Seq Content)
forall (m :: * -> *) a. Monad m => Scope -> MP m a -> MP m a
inBlock Scope
BlockScope (MP m (Seq Content) -> MP m (Seq Content))
-> MP m (Seq Content) -> MP m (Seq Content)
forall a b. (a -> b) -> a -> b
$ do
      Map Identifier Val -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *). Monad m => Map Identifier Val -> MP m ()
importModule Map Identifier Val
mathModule
      Map Identifier Val -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *). Monad m => Map Identifier Val -> MP m ()
importModule Map Identifier Val
symModule
      Map Identifier Val -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *). Monad m => Map Identifier Val -> MP m ()
importModule Map Identifier Val
sysModule
      Bool
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
      (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 {evalMath = True}
      Seq Content
content <- [Markup] -> MP m (Seq Content)
forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Markup]
ms
      (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 {evalMath = oldMath}
      Identifier -> Arguments -> MP m (Seq Content)
forall (m :: * -> *).
Monad m =>
Identifier -> Arguments -> MP m (Seq Content)
element
        Identifier
"equation"
        Arguments
          { positional :: [Val]
positional = [Seq Content -> Val
VContent Seq Content
content],
            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
display),
                  (Identifier
"numbering", Val
VNone)
                ]
          }
    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
      Seq Content
num <- [Markup] -> MP m (Seq Content)
forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Markup -> Markup
handleParens Markup
numexp]
      Seq Content
den <- [Markup] -> MP m (Seq Content)
forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Markup -> Markup
handleParens Markup
denexp]
      Identifier -> Arguments -> MP m (Seq Content)
forall (m :: * -> *).
Monad m =>
Identifier -> Arguments -> MP m (Seq Content)
element
        Identifier
"frac"
        Arguments
          { positional :: [Val]
positional = [Seq Content -> Val
VContent Seq Content
num, Seq Content -> Val
VContent Seq Content
den],
            named :: OMap Identifier Val
named = OMap Identifier Val
forall k v. OMap k v
OM.empty
          }
    MAttach Maybe Markup
mbBottomExp Maybe Markup
mbTopExp Markup
baseExp -> do
      Seq Content
base' <- [Markup] -> MP m (Seq Content)
forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Item [Markup]
Markup
baseExp]
      SourcePos
pos <- ParsecT [Markup] (EvalState m) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
      let base :: Seq Content
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'
      Maybe (Seq Content)
mbBottom <-
        ParsecT [Markup] (EvalState m) m (Maybe (Seq Content))
-> (Markup
    -> ParsecT [Markup] (EvalState m) m (Maybe (Seq Content)))
-> Maybe Markup
-> ParsecT [Markup] (EvalState m) m (Maybe (Seq Content))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
          (Maybe (Seq Content)
-> ParsecT [Markup] (EvalState m) m (Maybe (Seq Content))
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Seq Content)
forall a. Maybe a
Nothing)
          ((Seq Content -> Maybe (Seq Content))
-> MP m (Seq Content)
-> ParsecT [Markup] (EvalState m) m (Maybe (Seq Content))
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 -> Maybe (Seq Content)
forall a. a -> Maybe a
Just (MP m (Seq Content)
 -> ParsecT [Markup] (EvalState m) m (Maybe (Seq Content)))
-> (Markup -> MP m (Seq Content))
-> Markup
-> ParsecT [Markup] (EvalState m) m (Maybe (Seq Content))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Markup] -> MP m (Seq Content)
forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents ([Markup] -> MP m (Seq Content))
-> (Markup -> [Markup]) -> Markup -> MP m (Seq Content)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Markup -> [Markup] -> [Markup]
forall a. a -> [a] -> [a]
: []))
          Maybe Markup
mbBottomExp
      Maybe (Seq Content)
mbTop <-
        ParsecT [Markup] (EvalState m) m (Maybe (Seq Content))
-> (Markup
    -> ParsecT [Markup] (EvalState m) m (Maybe (Seq Content)))
-> Maybe Markup
-> ParsecT [Markup] (EvalState m) m (Maybe (Seq Content))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
          (Maybe (Seq Content)
-> ParsecT [Markup] (EvalState m) m (Maybe (Seq Content))
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Seq Content)
forall a. Maybe a
Nothing)
          ((Seq Content -> Maybe (Seq Content))
-> MP m (Seq Content)
-> ParsecT [Markup] (EvalState m) m (Maybe (Seq Content))
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 -> Maybe (Seq Content)
forall a. a -> Maybe a
Just (MP m (Seq Content)
 -> ParsecT [Markup] (EvalState m) m (Maybe (Seq Content)))
-> (Markup -> MP m (Seq Content))
-> Markup
-> ParsecT [Markup] (EvalState m) m (Maybe (Seq Content))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Markup] -> MP m (Seq Content)
forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents ([Markup] -> MP m (Seq Content))
-> (Markup -> [Markup]) -> Markup -> MP m (Seq Content)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Markup -> [Markup] -> [Markup]
forall a. a -> [a] -> [a]
: []))
          Maybe Markup
mbTopExp
      Identifier -> Arguments -> MP m (Seq Content)
forall (m :: * -> *).
Monad m =>
Identifier -> Arguments -> MP m (Seq Content)
element
        Identifier
"attach"
        Arguments
          { positional :: [Val]
positional = [Seq Content -> Val
VContent Seq Content
base],
            named :: OMap Identifier Val
named =
              [(Identifier, Val)] -> OMap Identifier Val
forall k v. Ord k => [(k, v)] -> OMap k v
OM.fromList
                [ (Identifier
"b", Val -> (Seq Content -> Val) -> Maybe (Seq Content) -> Val
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Val
VNone Seq Content -> Val
VContent Maybe (Seq Content)
mbBottom),
                  (Identifier
"t", Val -> (Seq Content -> Val) -> Maybe (Seq Content) -> Val
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Val
VNone Seq Content -> Val
VContent Maybe (Seq Content)
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)
-> MP m (Seq Content) -> MP m (Seq Content)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Markup] -> MP m (Seq Content)
forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Markup]
ms
    Markup
MAlignPoint -> Identifier -> Arguments -> MP 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
      Val
supp' <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
supp
      Identifier -> Arguments -> MP m (Seq Content)
forall (m :: * -> *).
Monad m =>
Identifier -> Arguments -> MP m (Seq Content)
element
        Identifier
"ref"
        Arguments
          { positional :: [Val]
positional = [Text -> Val
VLabel Text
ident],
            named :: OMap Identifier Val
named =
              [(Identifier, Val)] -> OMap Identifier Val
forall k v. Ord k => [(k, v)] -> OMap k v
OM.fromList
                [ ( Identifier
"supplement", Val
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
      Seq Content
firstItem <- [Markup] -> MP m (Seq Content)
forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Markup]
ms
      -- parse a sequence of list items and put them in a list element
      [Seq Content]
items <- (Seq Content
firstItem Seq Content -> [Seq Content] -> [Seq Content]
forall 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
<$> MP 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 MP m (Seq Content)
forall (m :: * -> *). Monad m => MP m (Seq Content)
pListItem
      Identifier -> Arguments -> MP m (Seq Content)
forall (m :: * -> *).
Monad m =>
Identifier -> Arguments -> MP m (Seq Content)
element
        Identifier
"list"
        Arguments
          { positional :: [Val]
positional = (Seq Content -> Val) -> [Seq Content] -> [Val]
forall a b. (a -> b) -> [a] -> [b]
map Seq Content -> Val
VContent [Seq Content]
items,
            named :: OMap Identifier Val
named = OMap Identifier Val
forall k v. OMap k v
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
      Seq Content
firstItem <- [Markup] -> MP m (Seq Content)
forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Markup]
ms
      -- parse a sequence of list items and put them in a list element
      [Seq Content]
items <- (Seq Content
firstItem Seq Content -> [Seq Content] -> [Seq Content]
forall 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
<$> MP 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 MP m (Seq Content)
forall (m :: * -> *). Monad m => MP m (Seq Content)
pEnumItem
      Identifier -> Arguments -> MP m (Seq Content)
forall (m :: * -> *).
Monad m =>
Identifier -> Arguments -> MP m (Seq Content)
element
        Identifier
"enum"
        Arguments
          { positional :: [Val]
positional = (Seq Content -> Val) -> [Seq Content] -> [Val]
forall a b. (a -> b) -> [a] -> [b]
map Seq Content -> Val
VContent [Seq Content]
items,
            named :: OMap Identifier Val
named =
              OMap Identifier Val
-> (Int -> OMap Identifier Val) -> Maybe Int -> OMap Identifier Val
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                OMap Identifier Val
forall k v. OMap k v
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))]
                )
                Maybe Int
mbStart
          }
    DescListItem [Markup]
ts [Markup]
ds -> do
      Seq Content
ts' <- [Markup] -> MP m (Seq Content)
forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Markup]
ts
      Seq Content
ds' <- [Markup] -> MP m (Seq Content)
forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Markup]
ds
      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)
      let firstItem :: Val
firstItem = Vector Val -> Val
VArray [Seq Content -> Val
VContent Seq Content
ts', Seq Content -> Val
VContent Seq Content
ds']
      [Val]
items <- (Val
firstItem Val -> [Val] -> [Val]
forall a. a -> [a] -> [a]
:) ([Val] -> [Val])
-> ParsecT [Markup] (EvalState m) m [Val]
-> ParsecT [Markup] (EvalState m) m [Val]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MP m Val -> ParsecT [Markup] (EvalState m) m [Val]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many MP m Val
forall (m :: * -> *). Monad m => MP m Val
pDescItem
      Identifier -> Arguments -> MP m (Seq Content)
forall (m :: * -> *).
Monad m =>
Identifier -> Arguments -> MP m (Seq Content)
element
        Identifier
"terms"
        Arguments
          { positional :: [Val]
positional = [Val]
items,
            named :: OMap Identifier Val
named = OMap Identifier Val
forall k v. OMap k v
OM.empty
          }
    Url Text
t ->
      Identifier -> Arguments -> MP 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 -> MP m (Seq Content)
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> MP m (Seq Content)) -> FilePath -> MP 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
  Markup
tok <- (Markup -> Bool) -> MP m Markup
forall (m :: * -> *). Monad m => (Markup -> Bool) -> MP m Markup
satisfyTok Markup -> Bool
isDescListItem
  case Markup
tok of
    DescListItem [Markup]
ts [Markup]
ds -> do
      Seq Content
ts' <- [Markup] -> MP m (Seq Content)
forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Markup]
ts
      Seq Content
ds' <- [Markup] -> MP m (Seq Content)
forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Markup]
ds
      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)
      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
$ Vector Val -> Val
VArray [Seq Content -> Val
VContent Seq Content
ts', Seq Content -> Val
VContent Seq Content
ds']
    Markup
_ -> FilePath -> MP 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
  Markup
tok <- (Markup -> Bool) -> MP m Markup
forall (m :: * -> *). Monad m => (Markup -> Bool) -> MP m Markup
satisfyTok Markup -> Bool
isEnumListItem
  case Markup
tok of
    EnumListItem Maybe Int
_ [Markup]
ms -> [Markup] -> MP m (Seq Content)
forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Markup]
ms MP m (Seq Content)
-> ParsecT [Markup] (EvalState m) m () -> MP 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 -> MP 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
  Markup
tok <- (Markup -> Bool) -> MP m Markup
forall (m :: * -> *). Monad m => (Markup -> Bool) -> MP m Markup
satisfyTok Markup -> Bool
isBulletListItem
  case Markup
tok of
    BulletListItem [Markup]
ms -> [Markup] -> MP m (Seq Content)
forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Markup]
ms MP m (Seq Content)
-> ParsecT [Markup] (EvalState m) m () -> MP 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 -> MP 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 =
  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
$
        -- let, etc. inside block are isolated
        -- we concat the results inside the block
        (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
val <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
                    FlowDirective
flow <- EvalState m -> FlowDirective
forall (m :: * -> *). EvalState m -> FlowDirective
evalFlowDirective (EvalState m -> FlowDirective)
-> ParsecT [Markup] (EvalState m) m (EvalState m)
-> ParsecT [Markup] (EvalState m) m FlowDirective
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 FlowDirective
flow of
                      FlowDirective
FlowNormal -> do
                        Val
combined <- Val -> Val -> MP m Val
forall (m :: * -> *). MonadFail m => Val -> Val -> m Val
joinVals Val
result Val
val
                        (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
combined, Bool
False)
                      FlowDirective
FlowContinue -> do
                        Val
combined <- Val -> Val -> MP m Val
forall (m :: * -> *). MonadFail m => Val -> Val -> m Val
joinVals Val
result Val
val
                        (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
combined, Bool
True)
                      FlowDirective
FlowBreak -> do
                        Val
combined <- Val -> Val -> MP m Val
forall (m :: * -> *). MonadFail m => Val -> Val -> m Val
joinVals Val
result Val
val
                        (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
combined, Bool
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
                        Val
combined <- Val -> Val -> MP m Val
forall (m :: * -> *). MonadFail m => Val -> Val -> m Val
joinVals Val
result Val
val
                        (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
combined, Bool
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
val <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
y
                   case Val
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
val <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
                   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 -> Val -> Vector Val
forall a. Vector a -> a -> Vector a
V.snoc Vector Val
xs Val
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
                  Identifier
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 Text
s <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
k
                                   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 -> ParsecT [Markup] (EvalState m) m Identifier)
-> Identifier -> ParsecT [Markup] (EvalState m) m Identifier
forall a b. (a -> b) -> a -> b
$ Text -> Identifier
Identifier Text
s
                  Val
val <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
                  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
 -> ParsecT [Markup] (EvalState m) m (OMap Identifier Val))
-> OMap Identifier Val
-> ParsecT [Markup] (EvalState m) m (OMap Identifier Val)
forall a b. (a -> b) -> a -> b
$ OMap Identifier Val
m OMap Identifier Val -> (Identifier, Val) -> OMap Identifier Val
forall k v. Ord k => OMap k v -> (k, v) -> OMap k v
OM.|> (Identifier
k', Val
val)
                Spr Expr
y -> do
                  Val
val <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
y
                  case Val
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
val <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
      case Val
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
      Val
val1 <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
      case Val
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
          Val
val2 <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e2
          case Val
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
      Val
val1 <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
      case Val
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
          Val
val2 <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e2
          case Val
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
val <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
      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
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
      Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
VNone
    LetFunc Identifier
name [Param]
params Expr
e -> do
      Val
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
      Identifier -> Val -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ()
addIdentifier Identifier
name Val
val
      Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
VNone
    FieldAccess (Ident (Identifier Text
fld)) Expr
e -> do
      Val
val <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
      (forall (n :: * -> *). Monad n => Val -> MP n ())
-> Val -> Text -> MP m Val
forall (m :: * -> *).
MonadFail m =>
(forall (n :: * -> *). Monad n => Val -> MP n ())
-> Val -> Text -> m Val
getMethod (Expr -> Val -> MP n ()
forall (m :: * -> *). Monad m => Expr -> Val -> MP m ()
updateExpression Expr
e) Val
val Text
fld
        MP m Val -> MP m Val -> MP m Val
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> case Val
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
val <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
      Bool
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
      case Val
val of
        VFunction (Just Identifier
i) Map Identifier Val
_ (Function forall (m :: * -> *). Monad m => Arguments -> MP m Val
f) -> do
          Arguments
arguments <- [Arg] -> MP m Arguments
forall (m :: * -> *). Monad m => [Arg] -> MP m Arguments
toArguments [Arg]
args
          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
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
        VSymbol (Symbol Text
_ Bool
True [(Set Text, Text)]
_) | Bool
mathMode ->
          do
            Val
val' <- Identifier -> MP m Val
forall (m :: * -> *). Monad m => Identifier -> MP m Val
lookupIdentifier Identifier
"accent"
            case Val
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
              Arguments
args' <- [Arg] -> MP m Arguments
forall (m :: * -> *). Monad m => [Arg] -> MP m Arguments
toArguments [Arg]
args
              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
val
                    Seq Content -> Seq Content -> Seq Content
forall a. Semigroup a => a -> a -> a
<> Content -> Seq Content
single Content
"("
                    Seq Content -> Seq Content -> Seq Content
forall a. Semigroup a => a -> a -> a
<> [Seq Content] -> Seq Content
forall a. Monoid a => [a] -> a
mconcat
                      ( Seq Content -> [Seq Content] -> [Seq Content]
forall a. a -> [a] -> [a]
intersperse
                          (Content -> Seq Content
single Content
",")
                          ((Val -> Seq Content) -> [Val] -> [Seq Content]
forall a b. (a -> b) -> [a] -> [b]
map Val -> Seq Content
valToContent (Arguments -> [Val]
positional Arguments
args'))
                      )
                    Seq Content -> Seq Content -> Seq Content
forall a. Semigroup a => a -> a -> a
<> Content -> Seq Content
single Content
")"
          | 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
      Val
v1 <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
      Val
v2 <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e2
      case Val -> Val -> Maybe Ordering
forall a. Compare a => a -> a -> Maybe Ordering
comp Val
v1 Val
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
      Val
v1 <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
      Val
v2 <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e2
      case Val -> Val -> Maybe Ordering
forall a. Compare a => a -> a -> Maybe Ordering
comp Val
v1 Val
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
      Val
v1 <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
      Val
v2 <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e2
      case Val -> Val -> Maybe Ordering
forall a. Compare a => a -> a -> Maybe Ordering
comp Val
v1 Val
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
      Val
v1 <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
      Val
v2 <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e2
      case Val -> Val -> Maybe Ordering
forall a. Compare a => a -> a -> Maybe Ordering
comp Val
v1 Val
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
      Val
v1 <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
      Val
v2 <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e2
      case Val -> Val -> Maybe Ordering
forall a. Compare a => a -> a -> Maybe Ordering
comp Val
v1 Val
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
      Val
v1 <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
      Val
v2 <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e2
      case Val
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
      Val
v <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
      case Val -> Maybe Val
forall a. Negatable a => a -> Maybe a
maybeNegate Val
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
      Val
e <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
      Val
b <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e2
      case (Val
b, Val
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
      Val
v1 <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
      Val
v2 <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e2
      case (Val
v1, Val
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)
        (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
      Val
v1 <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
      Val
v2 <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e2
      case Val -> Val -> Maybe Val
forall a. Summable a => a -> a -> Maybe a
maybeMinus 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
    Times Expr
e1 Expr
e2 -> do
      Val
v1 <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
      Val
v2 <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e2
      case Val -> Val -> Maybe Val
forall a. Multipliable a => a -> a -> Maybe a
maybeTimes 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
    Divided Expr
e1 Expr
e2 -> do
      Val
v1 <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
      Val
v2 <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e2
      case Val -> Val -> Maybe Val
forall a. Multipliable a => a -> a -> Maybe a
maybeDividedBy 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
    Set Expr
e [Arg]
args -> do
      Val
v <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
      Arguments
as' <- [Arg] -> MP m Arguments
forall (m :: * -> *). Monad m => [Arg] -> MP m Arguments
toArguments [Arg]
args
      case Val
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"
      Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
VNone
    Show Maybe Expr
mbSelExpr Expr
e -> do
      Val
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 Maybe Expr
mbSelExpr of
        Maybe Expr
Nothing -> do
          Seq Content
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 Val
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
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 Val
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
                        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
                  }
            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
                      selector
                      ( \Content
c ->
                          case Expr
e of
                            -- ignore show set for now TODO
                            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
                }
          Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
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
val <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e2
      case Expr
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
      Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
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
val <- Expr -> ParsecT [Markup] (EvalState m) m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
cond
            case Val
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
            Val
condval <- Expr -> ParsecT [Markup] (EvalState m) m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
            case Val
condval of
              VBoolean Bool
True -> do
                Val
val <- Expr -> ParsecT [Markup] (EvalState m) m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e2
                Bool
hadBreak <- (FlowDirective -> FlowDirective -> Bool
forall a. Eq a => a -> a -> Bool
== FlowDirective
FlowBreak) (FlowDirective -> Bool)
-> (EvalState m -> FlowDirective) -> EvalState m -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalState m -> FlowDirective
forall (m :: * -> *). EvalState m -> FlowDirective
evalFlowDirective (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
                Val -> Val -> ParsecT [Markup] (EvalState m) m Val
forall (m :: * -> *). MonadFail m => Val -> Val -> m Val
joinVals Val
result Val
val ParsecT [Markup] (EvalState m) m Val
-> (Val -> ParsecT [Markup] (EvalState m) m Val)
-> ParsecT [Markup] (EvalState m) 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
>>= if Bool
hadBreak then 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 else Val -> ParsecT [Markup] (EvalState m) m Val
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 -> ParsecT [Markup] (EvalState m) 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
val <- Expr -> ParsecT [Markup] (EvalState m) m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e2
            Bool
hadBreak <- (FlowDirective -> FlowDirective -> Bool
forall a. Eq a => a -> a -> Bool
== FlowDirective
FlowBreak) (FlowDirective -> Bool)
-> (EvalState m -> FlowDirective) -> EvalState m -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalState m -> FlowDirective
forall (m :: * -> *). EvalState m -> FlowDirective
evalFlowDirective (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
            Val -> Val -> ParsecT [Markup] (EvalState m) m Val
forall (m :: * -> *). MonadFail m => Val -> Val -> m Val
joinVals Val
result Val
val ParsecT [Markup] (EvalState m) m Val
-> (Val -> ParsecT [Markup] (EvalState m) m Val)
-> ParsecT [Markup] (EvalState m) 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
>>= if Bool
hadBreak then 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 else [Val] -> Val -> ParsecT [Markup] (EvalState m) m Val
go [Val]
xs
      Val
source <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
      [Val]
items <- case Val
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"
      (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] -> Val -> MP m Val
forall {m :: * -> *}.
Monad m =>
[Val] -> Val -> ParsecT [Markup] (EvalState m) m Val
go [Val]
items Val
VNone
    Return Maybe Expr
mbe -> do
      -- these flow directives are examined in CodeBlock
      (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
      Val
argval <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
      (Identifier
modid, Map Identifier Val
modmap) <-
        case Val
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
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)
      Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
VNone
    Include Expr
e -> do
      Val
argval <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
      case Val
argval of
        VString Text
t -> do
          (Seq Content
cs, (Identifier, Map Identifier Val)
_) <- 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
          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
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
  [(Scope, Map Identifier Val)]
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 :: Val
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
        -- set identifiers from params and arguments
        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
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
              Identifier -> Val -> MP m ()
forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ()
addIdentifier Identifier
ident Val
val
              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 {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
          -- We create a closure around the identifiers defined
          -- where the function is defined:
          EvalState m
oldState <- ParsecT [Markup] (EvalState m) m (EvalState m)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
          (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 = idents}
          case Maybe Identifier
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 (Param -> Bool) -> [Param] -> ([Param], [Param])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Param -> Bool
isSinkParam [Param]
params of
            ([Param]
befores, SinkParam Maybe Identifier
mbident : [Param]
afters) -> do
              Arguments
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
              Arguments
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
as' {positional = reverse $ positional as'}
                  ([Param] -> [Param]
forall a. [a] -> [a]
reverse [Param]
afters)
              let as :: Arguments
as = Arguments
as'' {positional = reverse $ positional as''}
              case Maybe Identifier
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
          Val
res <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
          EvalState m -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
setState EvalState m
oldState
          Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
res
  Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
fn

-- | Type of TOML configuration file used in 'findPackageEntryPoint' saved as `typst.toml`
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)

-- | Derived generically from record field names
instance Toml.FromValue Config where
  fromValue :: Value -> Matcher Config
fromValue = ParseTable Config -> Value -> Matcher Config
forall a. ParseTable a -> Value -> Matcher a
Toml.parseTableFromValue ParseTable Config
forall a. (Generic a, GParseTable (Rep a)) => ParseTable a
Toml.genericParseTable

-- | Derived generically from record field names
instance Toml.FromValue PackageConfig where
  fromValue :: Value -> Matcher PackageConfig
fromValue = ParseTable PackageConfig -> Value -> Matcher PackageConfig
forall a. ParseTable a -> Value -> Matcher a
Toml.parseTableFromValue ParseTable PackageConfig
forall a. (Generic a, GParseTable (Rep a)) => ParseTable a
Toml.genericParseTable

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 m
operations <- EvalState m -> Operations m
forall (m :: * -> *). EvalState m -> Operations m
evalOperations (EvalState m -> Operations m)
-> ParsecT [Markup] (EvalState m) m (EvalState m)
-> ParsecT [Markup] (EvalState m) m (Operations m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Markup] (EvalState m) m (EvalState m)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  let getEnv :: FilePath -> t m FilePath
getEnv FilePath
var = do
        Maybe FilePath
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 Maybe FilePath
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
  FilePath
homeDir <- FilePath -> MP m FilePath
forall {t :: (* -> *) -> * -> *}.
(MonadTrans t, MonadFail (t m)) =>
FilePath -> t m FilePath
getEnv FilePath
"HOME"
  FilePath
dataDir <- m (Maybe FilePath)
-> ParsecT [Markup] (EvalState m) m (Maybe FilePath)
forall (m :: * -> *) a.
Monad m =>
m a -> ParsecT [Markup] (EvalState m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Operations m -> FilePath -> m (Maybe FilePath)
forall (m :: * -> *).
Operations m -> FilePath -> m (Maybe FilePath)
lookupEnvVar Operations m
operations FilePath
"XDG_DATA_HOME") ParsecT [Markup] (EvalState m) m (Maybe FilePath)
-> (Maybe FilePath -> MP m FilePath) -> MP m FilePath
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
>>=
               MP m FilePath
-> (FilePath -> MP m FilePath) -> Maybe FilePath -> MP m FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> MP m FilePath
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath
homeDir FilePath -> FilePath -> FilePath
</> FilePath
".local" FilePath -> FilePath -> FilePath
</> FilePath
"share")) FilePath -> MP m FilePath
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  FilePath
cacheDir' <- m (Maybe FilePath)
-> ParsecT [Markup] (EvalState m) m (Maybe FilePath)
forall (m :: * -> *) a.
Monad m =>
m a -> ParsecT [Markup] (EvalState m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Operations m -> FilePath -> m (Maybe FilePath)
forall (m :: * -> *).
Operations m -> FilePath -> m (Maybe FilePath)
lookupEnvVar Operations m
operations FilePath
"XDG_CACHE_HOME") ParsecT [Markup] (EvalState m) m (Maybe FilePath)
-> (Maybe FilePath -> MP m FilePath) -> MP m FilePath
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
>>=
               MP m FilePath
-> (FilePath -> MP m FilePath) -> Maybe FilePath -> MP m FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> MP m FilePath
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath
homeDir FilePath -> FilePath -> FilePath
</> FilePath
".cache")) FilePath -> MP m FilePath
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  let localDir :: FilePath
localDir = FilePath
dataDir FilePath -> FilePath -> FilePath
</> FilePath
"typst"
  let cacheDir :: FilePath
cacheDir = FilePath
cacheDir' FilePath -> FilePath -> FilePath
</> FilePath
"typst"
#endif
  let subpath :: FilePath
subpath = FilePath
"packages" FilePath -> FilePath -> FilePath
</> FilePath
namespace FilePath -> FilePath -> FilePath
</> FilePath
name FilePath -> FilePath -> FilePath
</> FilePath
version
  Bool
inLocal <- m Bool -> ParsecT [Markup] (EvalState m) m Bool
forall (m :: * -> *) a.
Monad m =>
m a -> ParsecT [Markup] (EvalState m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> ParsecT [Markup] (EvalState m) m Bool)
-> m Bool -> ParsecT [Markup] (EvalState m) m Bool
forall a b. (a -> b) -> a -> b
$ Operations m -> FilePath -> m Bool
forall (m :: * -> *). Operations m -> FilePath -> m Bool
checkExistence Operations m
operations (FilePath
localDir FilePath -> FilePath -> FilePath
</> FilePath
subpath FilePath -> FilePath -> FilePath
</> FilePath
"typst.toml")
  FilePath
tomlPath <-
     if Bool
inLocal
        then FilePath -> MP m FilePath
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath
localDir FilePath -> FilePath -> FilePath
</> FilePath
subpath FilePath -> FilePath -> FilePath
</> FilePath
"typst.toml")
        else do
          Bool
inCache <- m Bool -> ParsecT [Markup] (EvalState m) m Bool
forall (m :: * -> *) a.
Monad m =>
m a -> ParsecT [Markup] (EvalState m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> ParsecT [Markup] (EvalState m) m Bool)
-> m Bool -> ParsecT [Markup] (EvalState m) m Bool
forall a b. (a -> b) -> a -> b
$ Operations m -> FilePath -> m Bool
forall (m :: * -> *). Operations m -> FilePath -> m Bool
checkExistence Operations m
operations (FilePath
cacheDir FilePath -> FilePath -> FilePath
</> FilePath
subpath FilePath -> FilePath -> FilePath
</> FilePath
"typst.toml")
          if Bool
inCache
             then FilePath -> MP m FilePath
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath
cacheDir FilePath -> FilePath -> FilePath
</> FilePath
subpath FilePath -> FilePath -> FilePath
</> FilePath
"typst.toml")
             else FilePath -> MP m FilePath
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> MP m FilePath) -> FilePath -> MP m FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"Could not find package in local packages or cache. Looked in\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
                    (FilePath
localDir FilePath -> FilePath -> FilePath
</> FilePath
subpath) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (FilePath
cacheDir FilePath -> FilePath -> FilePath
</> FilePath
subpath) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
                    FilePath
"\nCompile with typst compile to bring the package into your local cache."
             -- TODO? fetch from CDN if not present in cache?
  FilePath
tomlString <- Text -> FilePath
T.unpack (Text -> FilePath)
-> (ByteString -> Text) -> ByteString -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
TE.decodeUtf8 (ByteString -> FilePath)
-> ParsecT [Markup] (EvalState m) m ByteString -> MP m FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m ByteString -> ParsecT [Markup] (EvalState m) m ByteString
forall (m :: * -> *) a.
Monad m =>
m a -> ParsecT [Markup] (EvalState m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Operations m -> FilePath -> m ByteString
forall (m :: * -> *). Operations m -> FilePath -> m ByteString
loadBytes Operations m
operations FilePath
tomlPath)
  case FilePath -> Result FilePath Config
forall a. FromValue a => FilePath -> Result FilePath a
Toml.decode FilePath
tomlString of
    Toml.Failure [FilePath]
e -> FilePath -> MP 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 -> -- ignores warnings like unused keys in TOML
      FilePath -> MP 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
  SourcePos
pos <- ParsecT [Markup] (EvalState m) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  (FilePath
fp, Identifier
modid, Maybe FilePath
mbPackageRoot) <-
        if Int -> Text -> Text
T.take Int
1 Text
modname Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"@"
           then do
            FilePath
fp' <- Text -> MP m FilePath
forall (m :: * -> *). Monad m => Text -> MP m FilePath
findPackageEntryPoint Text
modname
            (FilePath, Identifier, Maybe FilePath)
-> ParsecT
     [Markup] (EvalState m) m (FilePath, Identifier, Maybe FilePath)
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath
fp',
                   Text -> Identifier
Identifier
                    (FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
':') (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
takeBaseName (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$
                       Text -> FilePath
T.unpack Text
modname),
                   FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> FilePath
takeDirectory FilePath
fp'))
           else if Int -> Text -> Text
T.take Int
1 Text
modname Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"/" -- refers to path relative to package root
                then do
                  FilePath
packageRoot <- EvalState m -> FilePath
forall (m :: * -> *). EvalState m -> FilePath
evalPackageRoot (EvalState m -> FilePath)
-> ParsecT [Markup] (EvalState m) m (EvalState m) -> MP m FilePath
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
                  (FilePath, Identifier, Maybe FilePath)
-> ParsecT
     [Markup] (EvalState m) m (FilePath, Identifier, Maybe FilePath)
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath
packageRoot FilePath -> FilePath -> FilePath
</> Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop Int
1 (Text -> FilePath
T.unpack Text
modname),
                        Text -> Identifier
Identifier (FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
takeBaseName (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
modname),
                        Maybe FilePath
forall a. Maybe a
Nothing)
                else (FilePath, Identifier, Maybe FilePath)
-> ParsecT
     [Markup] (EvalState m) m (FilePath, Identifier, Maybe FilePath)
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> FilePath -> FilePath
replaceFileName (SourcePos -> FilePath
sourceName SourcePos
pos) (Text -> FilePath
T.unpack Text
modname),
                        Text -> Identifier
Identifier (FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
takeBaseName (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
modname),
                        Maybe FilePath
forall a. Maybe a
Nothing)
  Text
txt <- FilePath -> MP m Text
forall (m :: * -> *). Monad m => FilePath -> MP m Text
loadFileText FilePath
fp
  case FilePath -> Text -> Either ParseError [Markup]
parseTypst FilePath
fp Text
txt of
    Left ParseError
err -> FilePath -> MP 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 -> MP m (Seq Content, (Identifier, Map Identifier Val)))
-> FilePath -> MP 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 m
operations <- EvalState m -> Operations m
forall (m :: * -> *). EvalState m -> Operations m
evalOperations (EvalState m -> Operations m)
-> ParsecT [Markup] (EvalState m) m (EvalState m)
-> ParsecT [Markup] (EvalState m) m (Operations m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Markup] (EvalState m) m (EvalState m)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
      Either ParseError (Seq Content, EvalState m)
res <-
        m (Either ParseError (Seq Content, EvalState m))
-> ParsecT
     [Markup]
     (EvalState m)
     m
     (Either ParseError (Seq Content, EvalState m))
forall (m :: * -> *) a.
Monad m =>
m a -> ParsecT [Markup] (EvalState m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either ParseError (Seq Content, EvalState m))
 -> ParsecT
      [Markup]
      (EvalState m)
      m
      (Either ParseError (Seq Content, EvalState m)))
-> m (Either ParseError (Seq Content, EvalState m))
-> ParsecT
     [Markup]
     (EvalState m)
     m
     (Either ParseError (Seq Content, EvalState m))
forall a b. (a -> b) -> a -> b
$
          ParsecT [Markup] (EvalState m) m (Seq Content, EvalState m)
-> EvalState m
-> FilePath
-> [Markup]
-> m (Either ParseError (Seq Content, EvalState m))
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> u -> FilePath -> s -> m (Either ParseError a)
runParserT
            ( Scope
-> ParsecT [Markup] (EvalState m) m (Seq Content, EvalState m)
-> ParsecT [Markup] (EvalState m) m (Seq Content, EvalState m)
forall (m :: * -> *) a. Monad m => Scope -> MP m a -> MP m a
inBlock Scope
BlockScope (ParsecT [Markup] (EvalState m) m (Seq Content, EvalState m)
 -> ParsecT [Markup] (EvalState m) m (Seq Content, EvalState m))
-> ParsecT [Markup] (EvalState m) m (Seq Content, EvalState m)
-> ParsecT [Markup] (EvalState m) m (Seq Content, EvalState m)
forall a b. (a -> b) -> a -> b
$ do -- add new identifiers list
                Seq Content
cs <- [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 ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
                EvalState m
s <- ParsecT [Markup] (EvalState m) m (EvalState m)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
                (Seq Content, EvalState m)
-> ParsecT [Markup] (EvalState m) m (Seq Content, EvalState m)
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Seq Content
cs, EvalState m
s)
            )
            EvalState Any
forall (m :: * -> *). EvalState m
initialEvalState{evalOperations = operations,
                             evalPackageRoot = fromMaybe (evalPackageRoot initialEvalState)
                                                   mbPackageRoot }
            FilePath
fp
            [Markup]
ms
      case Either ParseError (Seq Content, EvalState m)
res of
        Left ParseError
err' -> FilePath -> MP 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 -> MP m (Seq Content, (Identifier, Map Identifier Val)))
-> FilePath -> MP 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 -> MP 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))
-> MP 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
val <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
      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 {named = named args OM.|> (ident, val)}
    addArg Arguments
args (NormalArg Expr
e) = do
      Val
val <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
      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 {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]
: []))
      [Val]
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
      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 {positional = positional args ++ vals}
    addArg Arguments
args (SpreadArg Expr
e) = do
      Val
val <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
      case Val
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
      Seq Content
val <- [Markup] -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Markup]
ms
      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 {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
  [(Scope, Map Identifier Val)]
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 [(Scope, Map Identifier Val)]
identifiers of
    [] -> FilePath -> MP 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) -> MP m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((EvalState m -> EvalState m) -> MP m ())
-> (EvalState m -> EvalState m) -> MP m ()
forall a b. (a -> b) -> a -> b
$ \EvalState m
st ->
      EvalState m
st
        { 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)
  (Bool
finished, [(Scope, Map Identifier Val)]
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 Bool
finished
    then (EvalState m -> EvalState m) -> MP m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((EvalState m -> EvalState m) -> MP m ())
-> (EvalState m -> EvalState m) -> MP m ()
forall a b. (a -> b) -> a -> b
$ \EvalState m
st -> EvalState m
st {evalIdentifiers = reverse newmaps}
    else 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
$ Identifier -> FilePath
forall a. Show a => a -> FilePath
show Identifier
ident FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" 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
  Map Identifier Arguments
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
  -- add a new identifiers map
  (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 = (scope, mempty) : evalIdentifiers st
      }
  a
result <- MP m a
pa
  (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 = drop 1 (evalIdentifiers st),
        evalStyles = oldStyles
      }
  a -> MP m a
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
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 -- see #26
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
    Val
container <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
    Val
idx <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
arg
    case Val
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 -> 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
"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 -> MP m ()
forall (m :: * -> *). Monad m => Expr -> Val -> MP m ()
updateExpression Expr
e (Val -> MP m ()) -> Val -> MP 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 -> 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 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 -> 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
"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 -> MP m ()
forall (m :: * -> *). Monad m => Expr -> Val -> MP m ()
updateExpression Expr
e (Val -> MP m ()) -> Val -> MP 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 -> 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 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 -> 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


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"