{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Typst.Evaluate
  ( evaluateTypst,
    valToContent,
  )
where

import Control.Monad (MonadPlus (mplus), foldM, foldM_)
import Control.Monad.State (MonadTrans (lift))
import Data.List (intersperse, sortOn)
import qualified Data.Map as M
import qualified Data.Map.Ordered as OM
import Data.Maybe (isJust, fromMaybe)
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified Data.Vector as V
import GHC.Generics (Generic)
import System.FilePath (replaceFileName, takeBaseName,
                        takeFileName, takeDirectory, (</>))
import Text.Parsec
import Typst.Bind (destructuringBind)
import Typst.Constructors (getConstructor)
import Typst.Methods (getMethod)
import Typst.Module.Standard (loadFileText, standardModule, symModule)
import Typst.Module.Math (mathModule)
import Typst.MathClass (mathClassOf, MathClass(Relation))
import Typst.Parse (parseTypst)
import Typst.Regex (match)
import Typst.Show (applyShowRules)
import Typst.Syntax
import Typst.Types
import Typst.Util (makeFunction, nthArg)
import qualified Toml as Toml
import qualified Toml.Schema as Toml

-- 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 FilePath
fp =
  ParsecT [Markup] (EvalState m) m Content
-> EvalState m
-> FilePath
-> [Markup]
-> m (Either ParseError Content)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> u -> FilePath -> s -> m (Either ParseError a)
runParserT
    (do contents <- [Seq Content] -> Seq Content
forall a. Monoid a => [a] -> a
mconcat ([Seq Content] -> Seq Content)
-> ParsecT [Markup] (EvalState m) m [Seq Content]
-> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Markup] (EvalState m) m (Seq Content)
-> ParsecT [Markup] (EvalState m) m [Seq Content]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *). Monad m => MP m (Seq Content)
pContent ParsecT [Markup] (EvalState m) m (Seq Content)
-> ParsecT [Markup] (EvalState m) m ()
-> ParsecT [Markup] (EvalState m) m (Seq Content)
forall a b.
ParsecT [Markup] (EvalState m) m a
-> ParsecT [Markup] (EvalState m) m b
-> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT [Markup] (EvalState m) m ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
        -- "All documents are automatically wrapped in a document element."
        pure $ Elt "document" Nothing [("body", VContent contents)])
    EvalState (ZonkAny 1)
forall (m :: * -> *). EvalState m
initialEvalState { evalOperations = operations,
                       evalLocalDir = takeDirectory fp }
    FilePath
fp

initialEvalState :: EvalState m
initialEvalState :: forall (m :: * -> *). EvalState m
initialEvalState =
  EvalState m
forall (m :: * -> *). EvalState m
emptyEvalState { evalIdentifiers = [(BlockScope, mempty)]
                 , evalMathIdentifiers = [(BlockScope, mathModule <> symModule)]
                 , evalStandardIdentifiers = [(BlockScope, standardModule'')]
                 , evalPackageRoot = "."
                 }
  where
    standardModule' :: Map Identifier Val
standardModule' = Identifier -> Val -> Map Identifier Val -> Map Identifier Val
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Identifier
"eval" Val
evalFunction Map Identifier Val
standardModule
    standardModule'' :: Map Identifier Val
standardModule'' = Identifier -> Val -> Map Identifier Val -> Map Identifier Val
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Identifier
"std" (Identifier -> Map Identifier Val -> Val
VModule Identifier
"std" Map Identifier Val
standardModule') Map Identifier Val
standardModule'
    evalFunction :: Val
evalFunction = (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction ((forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
 -> Val)
-> (forall (m' :: * -> *).
    Monad m' =>
    ReaderT Arguments (MP m') Val)
-> Val
forall a b. (a -> b) -> a -> b
$ do
      code :: Text <- Int -> ReaderT Arguments (MP m') Text
forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
      case parseTypst "eval" ("#{\n" <> code <> "\n}") of
        Left ParseError
e -> FilePath -> ReaderT Arguments (MP m') Val
forall a. FilePath -> ReaderT Arguments (MP m') a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> ReaderT Arguments (MP m') Val)
-> FilePath -> ReaderT Arguments (MP m') Val
forall a b. (a -> b) -> a -> b
$ FilePath
"eval: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> ParseError -> FilePath
forall a. Show a => a -> FilePath
show ParseError
e
        Right [Code SourcePos
_ Expr
expr] ->
          -- 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

applyShowRulesToVal :: Monad m => Val -> MP m Val
applyShowRulesToVal :: forall (m :: * -> *). Monad m => Val -> MP m Val
applyShowRulesToVal (VContent Seq Content
cs) = Seq Content -> Val
VContent (Seq Content -> Val)
-> ParsecT [Markup] (EvalState m) m (Seq Content)
-> ParsecT [Markup] (EvalState m) m Val
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq Content -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *). Monad m => Seq Content -> MP m (Seq Content)
applyShowRules Seq Content
cs
applyShowRulesToVal Val
x = Val -> ParsecT [Markup] (EvalState m) m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
x

addTextElement :: Monad m => Seq Content -> MP m (Seq Content)
addTextElement :: forall (m :: * -> *). Monad m => Seq Content -> MP m (Seq Content)
addTextElement = (Seq Content
 -> Content -> ParsecT [Markup] (EvalState m) m (Seq Content))
-> Seq Content
-> Seq Content
-> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Seq Content
-> Content -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall {m :: * -> *}.
Monad m =>
Seq Content
-> Content -> ParsecT [Markup] (EvalState m) m (Seq Content)
go Seq Content
forall a. Monoid a => a
mempty
  where
    go :: Seq Content
-> Content -> ParsecT [Markup] (EvalState m) m (Seq Content)
go Seq Content
acc (Txt Text
"") = Seq Content -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Seq Content
acc
    go Seq Content
acc (Txt Text
t) = (Seq Content
acc Seq Content -> Seq Content -> Seq Content
forall a. Semigroup a => a -> a -> a
<>) (Seq Content -> Seq Content)
-> ParsecT [Markup] (EvalState m) m (Seq Content)
-> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Identifier
-> Arguments -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *).
Monad m =>
Identifier -> Arguments -> MP m (Seq Content)
element Identifier
"text" ([Val] -> OMap Identifier Val -> Arguments
Arguments [Seq Content -> Val
VContent [Text -> Content
Txt Text
t]] OMap Identifier Val
forall k v. OMap k v
OM.empty)
    go Seq Content
acc Content
x = Seq Content -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Seq Content
acc Seq Content -> Content -> Seq Content
forall a. Seq a -> a -> Seq a
Seq.|> Content
x)

isText :: Markup -> Bool
isText :: Markup -> Bool
isText Text {} = Bool
True
isText Markup
Space = Bool
True
isText Markup
SoftBreak = Bool
True
isText Markup
Nbsp = Bool
True
isText Markup
Shy = Bool
True
isText Markup
EmDash = Bool
True
isText Markup
EnDash = Bool
True
isText Markup
Ellipsis = Bool
True
isText (Quote Char
_) = Bool
True
isText Markup
_ = Bool
False

getText :: Markup -> Text
getText :: Markup -> Text
getText (Text Text
t) = Text
t
getText Markup
Space = Text
" "
getText Markup
SoftBreak = Text
"\n"
getText Markup
Nbsp = Text
"\xa0"
getText Markup
Shy = Text
"\xad"
getText Markup
EmDash = Text
"\x2014"
getText Markup
EnDash = Text
"\x2013"
getText Markup
Ellipsis = Text
"\x2026"
getText (Quote Char
c) = Char -> Text
T.singleton Char
c -- TODO localize
getText Markup
_ = Text
""

pTxt :: Monad m => MP m (Seq Content)
pTxt :: forall (m :: * -> *). Monad m => MP m (Seq Content)
pTxt = do
  mathMode <- EvalState m -> Bool
forall (m :: * -> *). EvalState m -> Bool
evalMath (EvalState m -> Bool)
-> ParsecT [Markup] (EvalState m) m (EvalState m)
-> ParsecT [Markup] (EvalState m) m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Markup] (EvalState m) m (EvalState m)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  txt <-
    if mathMode
      then getText <$> satisfyTok isText
      else mconcat . map getText . setQuotes <$> many1 (satisfyTok isText)
  pure $ Seq.singleton $ Txt txt

setQuotes :: [Markup] -> [Markup]
setQuotes :: [Markup] -> [Markup]
setQuotes [] = []
setQuotes (Quote Char
'"' : Markup
x : [Markup]
rest)
  | Markup
x Markup -> Markup -> Bool
forall a. Eq a => a -> a -> Bool
== Markup
Space Bool -> Bool -> Bool
|| Markup
x Markup -> Markup -> Bool
forall a. Eq a => a -> a -> Bool
== Markup
SoftBreak = Char -> Markup
Quote Char
'\x201D' Markup -> [Markup] -> [Markup]
forall a. a -> [a] -> [a]
: [Markup] -> [Markup]
setQuotes (Markup
x Markup -> [Markup] -> [Markup]
forall a. a -> [a] -> [a]
: [Markup]
rest)
setQuotes (Quote Char
'\'' : Markup
x : [Markup]
rest)
  | Markup
x Markup -> Markup -> Bool
forall a. Eq a => a -> a -> Bool
== Markup
Space Bool -> Bool -> Bool
|| Markup
x Markup -> Markup -> Bool
forall a. Eq a => a -> a -> Bool
== Markup
SoftBreak = Char -> Markup
Quote Char
'\x201D' Markup -> [Markup] -> [Markup]
forall a. a -> [a] -> [a]
: [Markup] -> [Markup]
setQuotes (Markup
x Markup -> [Markup] -> [Markup]
forall a. a -> [a] -> [a]
: [Markup]
rest)
setQuotes (Markup
x : Quote Char
'"' : [Markup]
rest)
  | Markup
x Markup -> Markup -> Bool
forall a. Eq a => a -> a -> Bool
== Markup
Space Bool -> Bool -> Bool
|| Markup
x Markup -> Markup -> Bool
forall a. Eq a => a -> a -> Bool
== Markup
SoftBreak = Markup
x Markup -> [Markup] -> [Markup]
forall a. a -> [a] -> [a]
: Char -> Markup
Quote Char
'\x201C' Markup -> [Markup] -> [Markup]
forall a. a -> [a] -> [a]
: [Markup] -> [Markup]
setQuotes [Markup]
rest
setQuotes (Markup
x : Quote Char
'\'' : [Markup]
rest)
  | Markup
x Markup -> Markup -> Bool
forall a. Eq a => a -> a -> Bool
== Markup
Space Bool -> Bool -> Bool
|| Markup
x Markup -> Markup -> Bool
forall a. Eq a => a -> a -> Bool
== Markup
SoftBreak = Markup
x Markup -> [Markup] -> [Markup]
forall a. a -> [a] -> [a]
: Char -> Markup
Quote Char
'\x2018' Markup -> [Markup] -> [Markup]
forall a. a -> [a] -> [a]
: [Markup] -> [Markup]
setQuotes [Markup]
rest
setQuotes (Text Text
t1 : Quote Char
'\'' : Text Text
t2 : [Markup]
rest) =
  Text -> Markup
Text Text
t1 Markup -> [Markup] -> [Markup]
forall a. a -> [a] -> [a]
: Char -> Markup
Quote Char
'\x2019' Markup -> [Markup] -> [Markup]
forall a. a -> [a] -> [a]
: [Markup] -> [Markup]
setQuotes (Text -> Markup
Text Text
t2 Markup -> [Markup] -> [Markup]
forall a. a -> [a] -> [a]
: [Markup]
rest)
setQuotes (Quote Char
'"' : Text Text
t : [Markup]
rest)
  | Text
t Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` ([Item [Text]
Text
")", Item [Text]
Text
".", Item [Text]
Text
",", Item [Text]
Text
";", Item [Text]
Text
":", Item [Text]
Text
"?", Item [Text]
Text
"!", Item [Text]
Text
"]"] :: [Text]) =
      Char -> Markup
Quote Char
'\x201C' Markup -> [Markup] -> [Markup]
forall a. a -> [a] -> [a]
: [Markup] -> [Markup]
setQuotes (Text -> Markup
Text Text
t Markup -> [Markup] -> [Markup]
forall a. a -> [a] -> [a]
: [Markup]
rest)
setQuotes (Quote Char
'\'' : Text Text
t : [Markup]
rest)
  | Text
t Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` ([Item [Text]
Text
")", Item [Text]
Text
".", Item [Text]
Text
",", Item [Text]
Text
";", Item [Text]
Text
":", Item [Text]
Text
"?", Item [Text]
Text
"!", Item [Text]
Text
"]"] :: [Text]) =
      Char -> Markup
Quote Char
'\x2018' Markup -> [Markup] -> [Markup]
forall a. a -> [a] -> [a]
: [Markup] -> [Markup]
setQuotes (Text -> Markup
Text Text
t Markup -> [Markup] -> [Markup]
forall a. a -> [a] -> [a]
: [Markup]
rest)
setQuotes (Quote Char
'"' : [Markup]
rest) = Char -> Markup
Quote Char
'\x201D' Markup -> [Markup] -> [Markup]
forall a. a -> [a] -> [a]
: [Markup] -> [Markup]
setQuotes [Markup]
rest
setQuotes (Quote Char
'\'' : [Markup]
rest) = Char -> Markup
Quote Char
'\x2019' Markup -> [Markup] -> [Markup]
forall a. a -> [a] -> [a]
: [Markup] -> [Markup]
setQuotes [Markup]
rest
setQuotes (Markup
x : [Markup]
xs) = Markup
x Markup -> [Markup] -> [Markup]
forall a. a -> [a] -> [a]
: [Markup] -> [Markup]
setQuotes [Markup]
xs

pInnerContents :: Monad m => [Markup] -> MP m (Seq Content)
pInnerContents :: forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Markup]
ms = do
  oldInput <- ParsecT [Markup] (EvalState m) m [Markup]
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
  oldPos <- getPosition
  oldShowRules <- evalShowRules <$> getState
  setInput ms
  result <- mconcat <$> (many pContent <* eof)
  setInput oldInput
  setPosition oldPos
  updateState $ \EvalState m
st -> EvalState m
st {evalShowRules = oldShowRules}
  pure result

single :: Content -> Seq Content
single :: Content -> Seq Content
single = Content -> Seq Content
forall a. a -> Seq a
Seq.singleton

applyElementFunction :: Monad m => Identifier -> Function -> Arguments -> MP m Val
applyElementFunction :: forall (m :: * -> *).
Monad m =>
Identifier -> Function -> Arguments -> MP m Val
applyElementFunction Identifier
name (Function forall (m :: * -> *). Monad m => Arguments -> MP m Val
f) Arguments
args = do
  -- lookup styles set by "set" and apply them as defaults:
  mbSty <- Identifier -> Map Identifier Arguments -> Maybe Arguments
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Identifier
name (Map Identifier Arguments -> Maybe Arguments)
-> (EvalState m -> Map Identifier Arguments)
-> EvalState m
-> Maybe Arguments
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalState m -> Map Identifier Arguments
forall (m :: * -> *). EvalState m -> Map Identifier Arguments
evalStyles (EvalState m -> Maybe Arguments)
-> ParsecT [Markup] (EvalState m) m (EvalState m)
-> ParsecT [Markup] (EvalState m) m (Maybe Arguments)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Markup] (EvalState m) m (EvalState m)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  f $ maybe args (<> args) mbSty

element :: Monad m => Identifier -> Arguments -> MP m (Seq Content)
element :: forall (m :: * -> *).
Monad m =>
Identifier -> Arguments -> MP m (Seq Content)
element name :: Identifier
name@(Identifier Text
n) Arguments
args = do
  eltfn <- Identifier -> MP m Val
forall (m :: * -> *). Monad m => Identifier -> MP m Val
lookupIdentifier Identifier
name
  case eltfn of
    VFunction Maybe Identifier
Nothing Map Identifier Val
_ (Function forall (m :: * -> *). Monad m => Arguments -> MP m Val
f) -> Val -> Seq Content
valToContent (Val -> Seq Content)
-> MP m Val -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Arguments -> MP m Val
forall (m :: * -> *). Monad m => Arguments -> MP m Val
f Arguments
args
    VFunction (Just Identifier
i) Map Identifier Val
_ (Function forall (m :: * -> *). Monad m => Arguments -> MP m Val
f) ->
      Val -> Seq Content
valToContent (Val -> Seq Content)
-> MP m Val -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Identifier -> Function -> Arguments -> MP m Val
forall (m :: * -> *).
Monad m =>
Identifier -> Function -> Arguments -> MP m Val
applyElementFunction Identifier
i ((forall (m :: * -> *). Monad m => Arguments -> MP m Val)
-> Function
Function Arguments -> MP m Val
forall (m :: * -> *). Monad m => Arguments -> MP m Val
f) Arguments
args
    Val
_ -> FilePath -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> ParsecT [Markup] (EvalState m) m (Seq Content))
-> FilePath -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
n FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" is not an element function"

pElt :: Monad m => MP m (Seq Content)
pElt :: forall (m :: * -> *). Monad m => MP m (Seq Content)
pElt = do
  tok <- (Markup -> Bool) -> MP m Markup
forall (m :: * -> *). Monad m => (Markup -> Bool) -> MP m Markup
satisfyTok (Bool -> Bool
not (Bool -> Bool) -> (Markup -> Bool) -> Markup -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Markup -> Bool
isText)
  case tok of
    Markup
ParBreak -> Identifier
-> Arguments -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *).
Monad m =>
Identifier -> Arguments -> MP m (Seq Content)
element Identifier
"parbreak" Arguments
forall a. Monoid a => a
mempty
    Markup
HardBreak -> Identifier
-> Arguments -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *).
Monad m =>
Identifier -> Arguments -> MP m (Seq Content)
element Identifier
"linebreak" Arguments
forall a. Monoid a => a
mempty
    Markup
Comment -> Seq Content -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Seq Content
forall a. Monoid a => a
mempty
    Code SourcePos
pos Expr
expr -> SourcePos -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition SourcePos
pos ParsecT [Markup] (EvalState m) m ()
-> ParsecT [Markup] (EvalState m) m (Seq Content)
-> ParsecT [Markup] (EvalState m) m (Seq Content)
forall a b.
ParsecT [Markup] (EvalState m) m a
-> ParsecT [Markup] (EvalState m) m b
-> ParsecT [Markup] (EvalState m) m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Expr -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *). Monad m => Expr -> MP m (Seq Content)
pExpr Expr
expr
    Emph [Markup]
ms -> do
      body <- [Markup] -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Markup]
ms
      element "emph" Arguments {positional = [VContent body], named = OM.empty}
    Strong [Markup]
ms -> do
      body <- [Markup] -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Markup]
ms
      element "strong" Arguments {positional = [VContent body], named = OM.empty}
    Bracketed [Markup]
ms -> do
      body <- [Markup] -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Markup]
ms
      pure $ (Txt "[" Seq.<| body) Seq.|> Txt "]"
    RawBlock Text
lang Text
txt ->
      Identifier
-> Arguments -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *).
Monad m =>
Identifier -> Arguments -> MP m (Seq Content)
element
        Identifier
"raw"
        Arguments
          { positional :: [Val]
positional = [Text -> Val
VString Text
txt],
            named :: OMap Identifier Val
named =
              [(Identifier, Val)] -> OMap Identifier Val
forall k v. Ord k => [(k, v)] -> OMap k v
OM.fromList
                [ (Identifier
"block", Bool -> Val
VBoolean Bool
True),
                  ( Identifier
"lang",
                    if Text -> Bool
T.null Text
lang
                      then Val
VNone
                      else Text -> Val
VString Text
lang
                  )
                ]
          }
    RawInline Text
txt -> do
      Identifier
-> Arguments -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *).
Monad m =>
Identifier -> Arguments -> MP m (Seq Content)
element
        Identifier
"raw"
        Arguments
          { positional :: [Val]
positional = [Text -> Val
VString Text
txt],
            named :: OMap Identifier Val
named =
              [(Identifier, Val)] -> OMap Identifier Val
forall k v. Ord k => [(k, v)] -> OMap k v
OM.fromList
                [ (Identifier
"lang", Val
VNone),
                  (Identifier
"block", Bool -> Val
VBoolean Bool
False)
                ]
          }
    Heading Int
level [Markup]
ms -> do
      content <- [Markup] -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Markup]
ms
      element
        "heading"
        Arguments
          { positional = [VContent content],
            named =
              OM.fromList
                [("level", VInteger (fromIntegral level))]
          }
    Equation Bool
display [Markup]
ms -> Scope
-> ParsecT [Markup] (EvalState m) m (Seq Content)
-> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *) a. Monad m => Scope -> MP m a -> MP m a
inBlock Scope
BlockScope (ParsecT [Markup] (EvalState m) m (Seq Content)
 -> ParsecT [Markup] (EvalState m) m (Seq Content))
-> ParsecT [Markup] (EvalState m) m (Seq Content)
-> ParsecT [Markup] (EvalState m) m (Seq Content)
forall a b. (a -> b) -> a -> b
$ do
      oldMath <- EvalState m -> Bool
forall (m :: * -> *). EvalState m -> Bool
evalMath (EvalState m -> Bool)
-> ParsecT [Markup] (EvalState m) m (EvalState m)
-> ParsecT [Markup] (EvalState m) m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Markup] (EvalState m) m (EvalState m)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
      updateState $ \EvalState m
st -> EvalState m
st {evalMath = True}
      content <- pInnerContents ms
      element
        "equation"
        Arguments
          { positional = [VContent content],
            named =
              OM.fromList
                [ ("block", VBoolean display),
                  ("numbering", VNone)
                ]
          } <* updateState (\EvalState m
st -> EvalState m
st {evalMath = oldMath})
    MFrac Markup
numexp Markup
denexp -> do
      let handleParens :: Markup -> Markup
handleParens (MGroup (Just Text
"(") (Just Text
")") [Markup]
xs) = Maybe Text -> Maybe Text -> [Markup] -> Markup
MGroup Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing [Markup]
xs
          handleParens Markup
x = Markup
x
      num <- [Markup] -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Markup -> Markup
handleParens Markup
numexp]
      den <- pInnerContents [handleParens denexp]
      element
        "frac"
        Arguments
          { positional = [VContent num, VContent den],
            named = OM.empty
          }
    MAttach Maybe Markup
mbBottomExp Maybe Markup
mbTopExp Markup
baseExp -> do
      base' <- [Markup] -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Item [Markup]
Markup
baseExp]
      pos <- getPosition
      let base =
            case Seq Content
base' of
              [Elt Identifier
"text" Maybe SourcePos
mbpos [(Identifier
"body", VContent [Txt Text
t])]]
                     | (Char -> Bool) -> Text -> Bool
T.all ((MathClass -> MathClass -> Bool
forall a. Eq a => a -> a -> Bool
== MathClass
Relation) (MathClass -> Bool) -> (Char -> MathClass) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> MathClass
mathClassOf ) Text
t
                -> [Identifier -> Maybe SourcePos -> Map Identifier Val -> Content
Elt Identifier
"math.limits" Maybe SourcePos
mbpos
                        [(Identifier
"body", Seq Content -> Val
VContent Seq Content
base')]]
              [Txt Text
t] | (Char -> Bool) -> Text -> Bool
T.all ((MathClass -> MathClass -> Bool
forall a. Eq a => a -> a -> Bool
== MathClass
Relation) (MathClass -> Bool) -> (Char -> MathClass) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> MathClass
mathClassOf ) Text
t
                -> [Identifier -> Maybe SourcePos -> Map Identifier Val -> Content
Elt Identifier
"math.limits" (SourcePos -> Maybe SourcePos
forall a. a -> Maybe a
Just SourcePos
pos)
                        [(Identifier
"body", Seq Content -> Val
VContent Seq Content
base')]]
              Seq Content
_ -> Seq Content
base'
      mbBottom <-
        maybe
          (pure Nothing)
          (fmap Just . pInnerContents . (: []))
          mbBottomExp
      mbTop <-
        maybe
          (pure Nothing)
          (fmap Just . pInnerContents . (: []))
          mbTopExp
      element
        "attach"
        Arguments
          { positional = [VContent base],
            named =
              OM.fromList
                [ ("b", maybe VNone VContent mbBottom),
                  ("t", maybe VNone VContent mbTop)
                ]
          }
    MGroup Maybe Text
mbOp Maybe Text
mbCl [Markup]
ms -> Maybe Text -> Maybe Text -> Seq Content -> Seq Content
wrapIn Maybe Text
mbOp Maybe Text
mbCl (Seq Content -> Seq Content)
-> ParsecT [Markup] (EvalState m) m (Seq Content)
-> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Markup] -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Markup]
ms
    Markup
MAlignPoint -> Identifier
-> Arguments -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *).
Monad m =>
Identifier -> Arguments -> MP m (Seq Content)
element Identifier
"alignpoint" Arguments
forall a. Monoid a => a
mempty
    Ref Text
ident Expr
supp -> do
      supp' <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
supp
      element
        "ref"
        Arguments
          { positional = [VLabel ident],
            named =
              OM.fromList
                [ ( "supplement", supp' ) ]
          }
    BulletListItem [Markup]
ms -> do
      MP m Markup -> ParsecT [Markup] (EvalState m) m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (MP m Markup -> ParsecT [Markup] (EvalState m) m ())
-> MP m Markup -> ParsecT [Markup] (EvalState m) m ()
forall a b. (a -> b) -> a -> b
$ (Markup -> Bool) -> MP m Markup
forall (m :: * -> *). Monad m => (Markup -> Bool) -> MP m Markup
satisfyTok Markup -> Bool
isBreak
      firstItem <- [Markup] -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Markup]
ms
      -- parse a sequence of list items and put them in a list element
      items <- (firstItem :) <$> many pListItem
      element
        "list"
        Arguments
          { positional = map VContent items,
            named = OM.empty
          }
    EnumListItem Maybe Int
mbStart [Markup]
ms -> do
      MP m Markup -> ParsecT [Markup] (EvalState m) m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (MP m Markup -> ParsecT [Markup] (EvalState m) m ())
-> MP m Markup -> ParsecT [Markup] (EvalState m) m ()
forall a b. (a -> b) -> a -> b
$ (Markup -> Bool) -> MP m Markup
forall (m :: * -> *). Monad m => (Markup -> Bool) -> MP m Markup
satisfyTok Markup -> Bool
isBreak
      firstItem <- [Markup] -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Markup]
ms
      -- parse a sequence of list items and put them in a list element
      items <- (firstItem :) <$> many pEnumItem
      element
        "enum"
        Arguments
          { positional = map VContent items,
            named =
              maybe
                OM.empty
                ( \Int
x ->
                    [(Identifier, Val)] -> OMap Identifier Val
forall k v. Ord k => [(k, v)] -> OMap k v
OM.fromList
                      [(Identifier
"start", Integer -> Val
VInteger (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x))]
                )
                mbStart
          }
    DescListItem [Markup]
ts [Markup]
ds -> do
      ts' <- [Markup] -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Markup]
ts
      ds' <- pInnerContents ds
      skipMany (satisfyTok isBreak)
      let firstItem = Vector Val -> Val
VArray [Seq Content -> Val
VContent Seq Content
ts', Seq Content -> Val
VContent Seq Content
ds']
      items <- (firstItem :) <$> many pDescItem
      element
        "terms"
        Arguments
          { positional = items,
            named = OM.empty
          }
    Url Text
t ->
      Identifier
-> Arguments -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *).
Monad m =>
Identifier -> Arguments -> MP m (Seq Content)
element
        Identifier
"link"
        Arguments
          { positional :: [Val]
positional =
              [ Text -> Val
VString Text
t,
                Seq Content -> Val
VContent (Content -> Seq Content
forall a. a -> Seq a
Seq.singleton (Text -> Content
Txt Text
t))
              ],
            named :: OMap Identifier Val
named = OMap Identifier Val
forall k v. OMap k v
OM.empty
          }
    Markup
_ -> FilePath -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> ParsecT [Markup] (EvalState m) m (Seq Content))
-> FilePath -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall a b. (a -> b) -> a -> b
$ FilePath
"Encountered " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Markup -> FilePath
forall a. Show a => a -> FilePath
show Markup
tok FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" in pElt"

pDescItem :: Monad m => MP m Val
pDescItem :: forall (m :: * -> *). Monad m => MP m Val
pDescItem = do
  tok <- (Markup -> Bool) -> MP m Markup
forall (m :: * -> *). Monad m => (Markup -> Bool) -> MP m Markup
satisfyTok Markup -> Bool
isDescListItem
  case tok of
    DescListItem [Markup]
ts [Markup]
ds -> do
      ts' <- [Markup] -> MP m (Seq Content)
forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Markup]
ts
      ds' <- pInnerContents ds
      skipMany (satisfyTok isBreak)
      pure $ VArray [VContent ts', VContent ds']
    Markup
_ -> FilePath -> ParsecT [Markup] (EvalState m) m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"pDescItem encountered non DescListItem"
  where
    isDescListItem :: Markup -> Bool
isDescListItem DescListItem {} = Bool
True
    isDescListItem Markup
_ = Bool
False

pEnumItem :: Monad m => MP m (Seq Content)
pEnumItem :: forall (m :: * -> *). Monad m => MP m (Seq Content)
pEnumItem = do
  tok <- (Markup -> Bool) -> MP m Markup
forall (m :: * -> *). Monad m => (Markup -> Bool) -> MP m Markup
satisfyTok Markup -> Bool
isEnumListItem
  case tok of
    EnumListItem Maybe Int
_ [Markup]
ms -> [Markup] -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Markup]
ms ParsecT [Markup] (EvalState m) m (Seq Content)
-> ParsecT [Markup] (EvalState m) m ()
-> ParsecT [Markup] (EvalState m) m (Seq Content)
forall a b.
ParsecT [Markup] (EvalState m) m a
-> ParsecT [Markup] (EvalState m) m b
-> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* MP m Markup -> ParsecT [Markup] (EvalState m) m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ((Markup -> Bool) -> MP m Markup
forall (m :: * -> *). Monad m => (Markup -> Bool) -> MP m Markup
satisfyTok Markup -> Bool
isBreak)
    Markup
_ -> FilePath -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"pEnumItem encountered non EnumListItem"
  where
    isEnumListItem :: Markup -> Bool
isEnumListItem EnumListItem {} = Bool
True
    isEnumListItem Markup
_ = Bool
False

pListItem :: Monad m => MP m (Seq Content)
pListItem :: forall (m :: * -> *). Monad m => MP m (Seq Content)
pListItem = do
  tok <- (Markup -> Bool) -> MP m Markup
forall (m :: * -> *). Monad m => (Markup -> Bool) -> MP m Markup
satisfyTok Markup -> Bool
isBulletListItem
  case tok of
    BulletListItem [Markup]
ms -> [Markup] -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Markup]
ms ParsecT [Markup] (EvalState m) m (Seq Content)
-> ParsecT [Markup] (EvalState m) m ()
-> ParsecT [Markup] (EvalState m) m (Seq Content)
forall a b.
ParsecT [Markup] (EvalState m) m a
-> ParsecT [Markup] (EvalState m) m b
-> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* MP m Markup -> ParsecT [Markup] (EvalState m) m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ((Markup -> Bool) -> MP m Markup
forall (m :: * -> *). Monad m => (Markup -> Bool) -> MP m Markup
satisfyTok Markup -> Bool
isBreak)
    Markup
_ -> FilePath -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"pListItem encountered non BulletListItem"
  where
    isBulletListItem :: Markup -> Bool
isBulletListItem BulletListItem {} = Bool
True
    isBulletListItem Markup
_ = Bool
False

isBreak :: Markup -> Bool
isBreak :: Markup -> Bool
isBreak Markup
SoftBreak = Bool
True
isBreak Markup
ParBreak = Bool
True
isBreak Markup
_ = Bool
False

wrapIn :: Maybe Text -> Maybe Text -> Seq Content -> Seq Content
wrapIn :: Maybe Text -> Maybe Text -> Seq Content -> Seq Content
wrapIn Maybe Text
Nothing Maybe Text
Nothing Seq Content
cs = Seq Content
cs
wrapIn (Just Text
op) (Just Text
cl) Seq Content
cs =
  Content -> Seq Content
forall a. a -> Seq a
Seq.singleton (Content -> Seq Content) -> Content -> Seq Content
forall a b. (a -> b) -> a -> b
$
    Identifier -> Maybe SourcePos -> Map Identifier Val -> Content
Elt
      Identifier
"math.lr"
      Maybe SourcePos
forall a. Maybe a
Nothing
      [ ( Identifier
"body",
          Vector Val -> Val
VArray (Vector Val -> Val) -> Vector Val -> Val
forall a b. (a -> b) -> a -> b
$
            [Val] -> Vector Val
forall a. [a] -> Vector a
V.fromList
              [Seq Content -> Val
VContent (Seq Content -> Val) -> Seq Content -> Val
forall a b. (a -> b) -> a -> b
$ Text -> Content
Txt Text
op Content -> Seq Content -> Seq Content
forall a. a -> Seq a -> Seq a
Seq.<| (Seq Content
cs Seq Content -> Content -> Seq Content
forall a. Seq a -> a -> Seq a
Seq.|> Text -> Content
Txt Text
cl)]
        )
      ]
wrapIn Maybe Text
Nothing (Just Text
cl) Seq Content
cs = Seq Content
cs Seq Content -> Content -> Seq Content
forall a. Seq a -> a -> Seq a
Seq.|> Text -> Content
Txt Text
cl
wrapIn (Just Text
op) Maybe Text
Nothing Seq Content
cs = Text -> Content
Txt Text
op Content -> Seq Content -> Seq Content
forall a. a -> Seq a -> Seq a
Seq.<| Seq Content
cs

pExpr :: Monad m => Expr -> MP m (Seq Content)
pExpr :: forall (m :: * -> *). Monad m => Expr -> MP m (Seq Content)
pExpr Expr
expr = Val -> Seq Content
valToContent (Val -> Seq Content)
-> ParsecT [Markup] (EvalState m) m Val
-> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> ParsecT [Markup] (EvalState m) m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
expr

evalExpr :: Monad m => Expr -> MP m Val
evalExpr :: forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
expr = Val -> MP m Val
forall (m :: * -> *). Monad m => Val -> MP m Val
applyShowRulesToVal (Val -> MP m Val) -> MP m Val -> MP m Val
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
  case Expr
expr of
    Literal Literal
lit -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Literal -> Val
evalLiteral Literal
lit
    Group Expr
e -> Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
    Block (Content [Markup]
ms) -> Seq Content -> Val
VContent (Seq Content -> Val)
-> ParsecT [Markup] (EvalState m) m (Seq Content) -> MP m Val
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Markup] -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Markup]
ms
    Block (CodeBlock [Expr]
exprs) ->
      Scope -> MP m Val -> MP m Val
forall (m :: * -> *) a. Monad m => Scope -> MP m a -> MP m a
inBlock Scope
BlockScope (MP m Val -> MP m Val) -> MP m Val -> MP m Val
forall a b. (a -> b) -> a -> b
$
        -- 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 <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
                    flow <- evalFlowDirective <$> getState
                    case flow of
                      FlowDirective
FlowNormal -> do
                        combined <- Val -> Val -> MP m Val
forall (m :: * -> *). MonadFail m => Val -> Val -> m Val
joinVals Val
result Val
val
                        pure (combined, False)
                      FlowDirective
FlowContinue -> do
                        combined <- Val -> Val -> MP m Val
forall (m :: * -> *). MonadFail m => Val -> Val -> m Val
joinVals Val
result Val
val
                        pure (combined, True)
                      FlowDirective
FlowBreak -> do
                        combined <- Val -> Val -> MP m Val
forall (m :: * -> *). MonadFail m => Val -> Val -> m Val
joinVals Val
result Val
val
                        pure (combined, True)
                      FlowReturn Bool
True -> (Val, Bool) -> ParsecT [Markup] (EvalState m) m (Val, Bool)
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val
val, Bool
True)
                      FlowReturn Bool
False -> do
                        combined <- Val -> Val -> MP m Val
forall (m :: * -> *). MonadFail m => Val -> Val -> m Val
joinVals Val
result Val
val
                        pure (combined, True)
            )
            (Val
VNone, Bool
False)
            [Expr]
exprs
    Array [Spreadable Expr]
es -> Vector Val -> Val
VArray (Vector Val -> Val)
-> ParsecT [Markup] (EvalState m) m (Vector Val) -> MP m Val
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Vector Val
 -> Spreadable Expr
 -> ParsecT [Markup] (EvalState m) m (Vector Val))
-> Vector Val
-> [Spreadable Expr]
-> ParsecT [Markup] (EvalState m) m (Vector Val)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM
           ( \Vector Val
xs Spreadable Expr
x ->
               case Spreadable Expr
x of
                 Spr Expr
y -> do
                   val <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
y
                   case val of
                     VArray Vector Val
ys -> Vector Val -> ParsecT [Markup] (EvalState m) m (Vector Val)
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Vector Val
xs Vector Val -> Vector Val -> Vector Val
forall a. Semigroup a => a -> a -> a
<> Vector Val
ys)
                     Val
_ -> FilePath -> ParsecT [Markup] (EvalState m) m (Vector Val)
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> ParsecT [Markup] (EvalState m) m (Vector Val))
-> FilePath -> ParsecT [Markup] (EvalState m) m (Vector Val)
forall a b. (a -> b) -> a -> b
$ FilePath
"Could not spread " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> ValType -> FilePath
forall a. Show a => a -> FilePath
show (Val -> ValType
valType Val
val) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>
                                 FilePath
" into array"
                 Reg Expr
e -> do
                   val <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
                   pure (V.snoc xs val ) )
           []
           [Spreadable Expr]
es
    Dict [Spreadable (Expr, Expr)]
items ->
      OMap Identifier Val -> Val
VDict
        (OMap Identifier Val -> Val)
-> ParsecT [Markup] (EvalState m) m (OMap Identifier Val)
-> MP m Val
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (OMap Identifier Val
 -> Spreadable (Expr, Expr)
 -> ParsecT [Markup] (EvalState m) m (OMap Identifier Val))
-> OMap Identifier Val
-> [Spreadable (Expr, Expr)]
-> ParsecT [Markup] (EvalState m) m (OMap Identifier Val)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM
          ( \OMap Identifier Val
m Spreadable (Expr, Expr)
v -> do
              case Spreadable (Expr, Expr)
v of
                Reg (Expr
k, Expr
e) -> do
                  k' <- case Expr
k of
                           Ident Identifier
i -> Identifier -> ParsecT [Markup] (EvalState m) m Identifier
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Identifier
i
                           Expr
_ -> do VString s <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
k
                                   pure $ Identifier s
                  val <- evalExpr e
                  pure $ m OM.|> (k', val)
                Spr Expr
y -> do
                  val <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
y
                  case val of
                    VDict OMap Identifier Val
m' -> OMap Identifier Val
-> ParsecT [Markup] (EvalState m) m (OMap Identifier Val)
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OMap Identifier Val
m' OMap Identifier Val -> OMap Identifier Val -> OMap Identifier Val
forall k v. Ord k => OMap k v -> OMap k v -> OMap k v
OM.|<> OMap Identifier Val
m)
                    Val
_ -> FilePath -> ParsecT [Markup] (EvalState m) m (OMap Identifier Val)
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath
 -> ParsecT [Markup] (EvalState m) m (OMap Identifier Val))
-> FilePath
-> ParsecT [Markup] (EvalState m) m (OMap Identifier Val)
forall a b. (a -> b) -> a -> b
$ FilePath
"Could not spread " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> ValType -> FilePath
forall a. Show a => a -> FilePath
show (Val -> ValType
valType Val
val) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>
                                FilePath
" into dictionary"
          )
          OMap Identifier Val
forall k v. OMap k v
OM.empty
          [Spreadable (Expr, Expr)]
items
    Not Expr
e -> do
      val <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
      case val of
        VBoolean Bool
b -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean (Bool -> Bool
not Bool
b)
        Val
_ -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> MP m Val) -> FilePath -> MP m Val
forall a b. (a -> b) -> a -> b
$ FilePath
"Cannot apply 'not' to " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
val
    And Expr
e1 Expr
e2 -> do
      val1 <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
      case val1 of
        VBoolean Bool
False -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
False
        VBoolean Bool
True -> do
          val2 <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e2
          case val2 of
            VBoolean Bool
True -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
True
            VBoolean Bool
False -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
False
            Val
_ -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> MP m Val) -> FilePath -> MP m Val
forall a b. (a -> b) -> a -> b
$ FilePath
"Cannot apply 'and' to " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
val1
        Val
_ -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> MP m Val) -> FilePath -> MP m Val
forall a b. (a -> b) -> a -> b
$ FilePath
"Cannot apply 'and' to " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
val1
    Or Expr
e1 Expr
e2 -> do
      val1 <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
      case val1 of
        VBoolean Bool
True -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
True
        VBoolean Bool
False -> do
          val2 <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e2
          case val2 of
            VBoolean Bool
True -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
True
            VBoolean Bool
False -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
False
            Val
_ -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> MP m Val) -> FilePath -> MP m Val
forall a b. (a -> b) -> a -> b
$ FilePath
"Cannot apply 'or' to " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
val1
        Val
_ -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> MP m Val) -> FilePath -> MP m Val
forall a b. (a -> b) -> a -> b
$ FilePath
"Cannot apply 'or' to " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
val1
    Ident Identifier
ident -> Identifier -> MP m Val
forall (m :: * -> *). Monad m => Identifier -> MP m Val
lookupIdentifier Identifier
ident
    Let Bind
bind Expr
e -> do
      val <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
      case bind of
        BasicBind (Just Identifier
ident) -> Identifier -> Val -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ()
addIdentifier Identifier
ident Val
val
        BasicBind Maybe Identifier
Nothing -> () -> ParsecT [Markup] (EvalState m) m ()
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        DestructuringBind [BindPart]
parts -> (forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ())
-> [BindPart] -> Val -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *).
Monad m =>
(forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ())
-> [BindPart] -> Val -> MP m ()
destructuringBind Identifier -> Val -> MP m' ()
forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ()
addIdentifier [BindPart]
parts Val
val
      pure VNone
    LetFunc Identifier
name [Param]
params Expr
e -> do
      val <- Maybe Identifier -> [Param] -> Expr -> MP m Val
forall (m :: * -> *).
Monad m =>
Maybe Identifier -> [Param] -> Expr -> MP m Val
toFunction (Identifier -> Maybe Identifier
forall a. a -> Maybe a
Just Identifier
name) [Param]
params Expr
e
      addIdentifier name val
      pure VNone
    FieldAccess (Ident (Identifier Text
fld)) Expr
e -> do
      val <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
      getMethod (updateExpression e) val fld
        <|> case val of
          VSymbol (Symbol Text
_ Bool
accent [(Set Text, Text)]
variants) -> do
            let variants' :: [(Set Text, Text)]
variants' =
                  ((Set Text, Text) -> Int)
-> [(Set Text, Text)] -> [(Set Text, Text)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Set Text -> Int
forall a. Set a -> Int
Set.size (Set Text -> Int)
-> ((Set Text, Text) -> Set Text) -> (Set Text, Text) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set Text, Text) -> Set Text
forall a b. (a, b) -> a
fst) ([(Set Text, Text)] -> [(Set Text, Text)])
-> [(Set Text, Text)] -> [(Set Text, Text)]
forall a b. (a -> b) -> a -> b
$
                    ((Set Text, Text) -> Bool)
-> [(Set Text, Text)] -> [(Set Text, Text)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Set Text
var, Text
_) -> Text
fld Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
var) [(Set Text, Text)]
variants
            case [(Set Text, Text)]
variants' of
              [] -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> MP m Val) -> FilePath -> MP m Val
forall a b. (a -> b) -> a -> b
$ FilePath
"Symbol does not have variant " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
forall a. Show a => a -> FilePath
show Text
fld
              ((Set Text
_, Text
s) : [(Set Text, Text)]
_) -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Symbol -> Val
VSymbol (Symbol -> Val) -> Symbol -> Val
forall a b. (a -> b) -> a -> b
$ Text -> Bool -> [(Set Text, Text)] -> Symbol
Symbol Text
s Bool
accent [(Set Text, Text)]
variants'
          VModule Identifier
_ Map Identifier Val
m ->
            case Identifier -> Map Identifier Val -> Maybe Val
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Text -> Identifier
Identifier Text
fld) Map Identifier Val
m of
              Just Val
x -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
x
              Maybe Val
Nothing -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> MP m Val) -> FilePath -> MP m Val
forall a b. (a -> b) -> a -> b
$ FilePath
"Module does not contain " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
forall a. Show a => a -> FilePath
show Text
fld
          VFunction Maybe Identifier
_ Map Identifier Val
m Function
_ ->
            case Identifier -> Map Identifier Val -> Maybe Val
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Text -> Identifier
Identifier Text
fld) Map Identifier Val
m of
              Just Val
x -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
x
              Maybe Val
Nothing -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> MP m Val) -> FilePath -> MP m Val
forall a b. (a -> b) -> a -> b
$ FilePath
"Function scope does not contain " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
forall a. Show a => a -> FilePath
show Text
fld
          VDict OMap Identifier Val
m ->
            case Identifier -> OMap Identifier Val -> Maybe Val
forall k v. Ord k => k -> OMap k v -> Maybe v
OM.lookup (Text -> Identifier
Identifier Text
fld) OMap Identifier Val
m of
              Just Val
x -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
x
              Maybe Val
Nothing -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> MP m Val) -> FilePath -> MP m Val
forall a b. (a -> b) -> a -> b
$ Identifier -> FilePath
forall a. Show a => a -> FilePath
show (Text -> Identifier
Identifier Text
fld) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" not found"
          Val
_ -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"FieldAccess requires a dictionary"
    FieldAccess Expr
_ Expr
_ -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"FieldAccess requires an identifier"
    FuncCall Expr
e [Arg]
args -> do
      (EvalState m -> EvalState m) -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((EvalState m -> EvalState m)
 -> ParsecT [Markup] (EvalState m) m ())
-> (EvalState m -> EvalState m)
-> ParsecT [Markup] (EvalState m) m ()
forall a b. (a -> b) -> a -> b
$ \EvalState m
st -> EvalState m
st {evalFlowDirective = FlowNormal}
      val <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
      mathMode <- evalMath <$> getState
      case val of
        VFunction (Just Identifier
i) Map Identifier Val
_ (Function forall (m :: * -> *). Monad m => Arguments -> MP m Val
f) -> do
          arguments <- [Arg] -> MP m Arguments
forall (m :: * -> *). Monad m => [Arg] -> MP m Arguments
toArguments [Arg]
args
          applyElementFunction i (Function f) arguments
        VFunction Maybe Identifier
Nothing Map Identifier Val
_ (Function forall (m :: * -> *). Monad m => Arguments -> MP m Val
f) -> [Arg] -> MP m Arguments
forall (m :: * -> *). Monad m => [Arg] -> MP m Arguments
toArguments [Arg]
args MP m Arguments -> (Arguments -> MP m Val) -> MP m Val
forall a b.
ParsecT [Markup] (EvalState m) m a
-> (a -> ParsecT [Markup] (EvalState m) m b)
-> ParsecT [Markup] (EvalState m) m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Arguments -> MP m Val
forall (m :: * -> *). Monad m => Arguments -> MP m Val
f
        VType ValType
ty ->
          case ValType -> Maybe Val
getConstructor ValType
ty of
            Just (VFunction Maybe Identifier
_ Map Identifier Val
_ (Function forall (m :: * -> *). Monad m => Arguments -> MP m Val
f)) -> [Arg] -> MP m Arguments
forall (m :: * -> *). Monad m => [Arg] -> MP m Arguments
toArguments [Arg]
args MP m Arguments -> (Arguments -> MP m Val) -> MP m Val
forall a b.
ParsecT [Markup] (EvalState m) m a
-> (a -> ParsecT [Markup] (EvalState m) m b)
-> ParsecT [Markup] (EvalState m) m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Arguments -> MP m Val
forall (m :: * -> *). Monad m => Arguments -> MP m Val
f
            Maybe Val
_ -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> MP m Val) -> FilePath -> MP m Val
forall a b. (a -> b) -> a -> b
$ FilePath
"No constructor defined for type " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> ValType -> FilePath
forall a. Show a => a -> FilePath
show ValType
ty
        VSymbol (Symbol Text
_ Bool
True [(Set Text, Text)]
_) | Bool
mathMode ->
          do
            val' <- Identifier -> MP m Val
forall (m :: * -> *). Monad m => Identifier -> MP m Val
lookupIdentifier Identifier
"accent"
            case val' of
              VFunction Maybe Identifier
_ Map Identifier Val
_ (Function forall (m :: * -> *). Monad m => Arguments -> MP m Val
f) ->
                [Arg] -> MP m Arguments
forall (m :: * -> *). Monad m => [Arg] -> MP m Arguments
toArguments [Arg]
args
                  MP m Arguments -> (Arguments -> MP m Val) -> MP m Val
forall a b.
ParsecT [Markup] (EvalState m) m a
-> (a -> ParsecT [Markup] (EvalState m) m b)
-> ParsecT [Markup] (EvalState m) m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Arguments -> MP m Val
forall (m :: * -> *). Monad m => Arguments -> MP m Val
f (Arguments -> MP m Val)
-> (Arguments -> Arguments) -> Arguments -> MP m Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Arguments
a -> Arguments
a {positional = positional a ++ [val]})
              Val
_ -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"accent not defined"
        Val
_
          | Bool
mathMode -> do
              args' <- [Arg] -> MP m Arguments
forall (m :: * -> *). Monad m => [Arg] -> MP m Arguments
toArguments [Arg]
args
              pure $
                VContent $
                  valToContent val
                    <> single "("
                    <> mconcat
                      ( intersperse
                          (single ",")
                          (map valToContent (positional args'))
                      )
                    <> single ")"
          | Bool
otherwise -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Attempt to call a non-function"
    FuncExpr [Param]
params Expr
e -> Maybe Identifier -> [Param] -> Expr -> MP m Val
forall (m :: * -> *).
Monad m =>
Maybe Identifier -> [Param] -> Expr -> MP m Val
toFunction Maybe Identifier
forall a. Maybe a
Nothing [Param]
params Expr
e
    Equals Expr
e1 Expr
e2 -> do
      v1 <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
      v2 <- evalExpr e2
      case comp v1 v2 of
        Just Ordering
EQ -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
True
        Maybe Ordering
_ -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
False
    LessThan Expr
e1 Expr
e2 -> do
      v1 <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
      v2 <- evalExpr e2
      case comp v1 v2 of
        Maybe Ordering
Nothing -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> MP m Val) -> FilePath -> MP m Val
forall a b. (a -> b) -> a -> b
$ FilePath
"Can't compare " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
v1 FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" and " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
v2
        Just Ordering
LT -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
True
        Maybe Ordering
_ -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
False
    GreaterThan Expr
e1 Expr
e2 -> do
      v1 <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
      v2 <- evalExpr e2
      case comp v1 v2 of
        Maybe Ordering
Nothing -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> MP m Val) -> FilePath -> MP m Val
forall a b. (a -> b) -> a -> b
$ FilePath
"Can't compare " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
v1 FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" and " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
v2
        Just Ordering
GT -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
True
        Maybe Ordering
_ -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
False
    LessThanOrEqual Expr
e1 Expr
e2 -> do
      v1 <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
      v2 <- evalExpr e2
      case comp v1 v2 of
        Maybe Ordering
Nothing -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> MP m Val) -> FilePath -> MP m Val
forall a b. (a -> b) -> a -> b
$ FilePath
"Can't compare " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Expr -> FilePath
forall a. Show a => a -> FilePath
show Expr
e1 FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" and " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Expr -> FilePath
forall a. Show a => a -> FilePath
show Expr
e2
        Just Ordering
LT -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
True
        Just Ordering
EQ -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
True
        Maybe Ordering
_ -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
False
    GreaterThanOrEqual Expr
e1 Expr
e2 -> do
      v1 <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
      v2 <- evalExpr e2
      case comp v1 v2 of
        Maybe Ordering
Nothing -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> MP m Val) -> FilePath -> MP m Val
forall a b. (a -> b) -> a -> b
$ FilePath
"Can't compare " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
v1 FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" and " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
v2
        Just Ordering
GT -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
True
        Just Ordering
EQ -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
True
        Maybe Ordering
_ -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
False
    InCollection Expr
e1 Expr
e2 -> do
      v1 <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
      v2 <- evalExpr e2
      case v2 of
        VString Text
t ->
          case Val
v1 of
            VString Text
t' -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean (Bool -> Val) -> Bool -> Val
forall a b. (a -> b) -> a -> b
$ Text
t' Text -> Text -> Bool
`T.isInfixOf` Text
t
            VRegex RE
re -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean (Bool -> Val) -> Bool -> Val
forall a b. (a -> b) -> a -> b
$ RE -> Text -> Bool
forall source target.
RegexContext Regex source target =>
RE -> source -> target
match RE
re Text
t
            Val
_ -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> MP m Val) -> FilePath -> MP m Val
forall a b. (a -> b) -> a -> b
$ FilePath
"Can't apply 'in' to " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
v1 FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" and string"
        VType ValType
ty ->
          case Val
v1 of
            VString Text
t' -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean (Bool -> Val) -> Bool -> Val
forall a b. (a -> b) -> a -> b
$ Text
t' Text -> Text -> Bool
`T.isInfixOf` (ValType -> Text
prettyType ValType
ty)
            VRegex RE
re -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean (Bool -> Val) -> Bool -> Val
forall a b. (a -> b) -> a -> b
$ RE -> Text -> Bool
forall source target.
RegexContext Regex source target =>
RE -> source -> target
match RE
re (ValType -> Text
prettyType ValType
ty)
            Val
_ -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> MP m Val) -> FilePath -> MP m Val
forall a b. (a -> b) -> a -> b
$ FilePath
"Can't apply 'in' to " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
v1
        VArray Vector Val
vec -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean (Bool -> Val) -> Bool -> Val
forall a b. (a -> b) -> a -> b
$ Val -> Vector Val -> Bool
forall a. Eq a => a -> Vector a -> Bool
V.elem Val
v1 Vector Val
vec
        VDict OMap Identifier Val
m ->
          case Val
v1 of
            VString Text
t -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean (Bool -> Val) -> Bool -> Val
forall a b. (a -> b) -> a -> b
$ Maybe Val -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Val -> Bool) -> Maybe Val -> Bool
forall a b. (a -> b) -> a -> b
$ Identifier -> OMap Identifier Val -> Maybe Val
forall k v. Ord k => k -> OMap k v -> Maybe v
OM.lookup (Text -> Identifier
Identifier Text
t) OMap Identifier Val
m
            Val
_ -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
False
        Val
_ -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> MP m Val) -> FilePath -> MP m Val
forall a b. (a -> b) -> a -> b
$ FilePath
"Can't apply 'in' to " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
v2 FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> (Expr, Expr) -> FilePath
forall a. Show a => a -> FilePath
show (Expr
e1,Expr
e2)

    Negated Expr
e -> do
      v <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
      case maybeNegate v of
        Maybe Val
Nothing -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> MP m Val) -> FilePath -> MP m Val
forall a b. (a -> b) -> a -> b
$ FilePath
"Can't negate " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
v
        Just Val
v' -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
v'
    ToPower Expr
e1 Expr
e2 -> do
      e <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
      b <- evalExpr e2
      case (b, e) of
        (VInteger Integer
i, VInteger Integer
j) ->
          Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$
            Integer -> Val
VInteger (Integer -> Val) -> Integer -> Val
forall a b. (a -> b) -> a -> b
$
              Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor ((Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i :: Double) Double -> Double -> Double
forall a. Floating a => a -> a -> a
** (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
j :: Double))
        (VInteger Integer
i, VRatio Rational
j) ->
          Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$
            Double -> Val
VFloat ((Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i :: Double) Double -> Double -> Double
forall a. Floating a => a -> a -> a
** (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
j :: Double))
        (VRatio Rational
i, VInteger Integer
j) ->
          Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$
            Double -> Val
VFloat (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
i Double -> Double -> Double
forall a. Floating a => a -> a -> a
** (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
j :: Double))
        (VRatio Rational
i, VRatio Rational
j) -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Double -> Val
VFloat (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
i Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
j)
        (VFloat Double
i, VInteger Integer
j) -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Double -> Val
VFloat (Double
i Double -> Double -> Double
forall a. Floating a => a -> a -> a
** (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
j :: Double))
        (VFloat Double
i, VFloat Double
j) -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Double -> Val
VFloat (Double
i Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Double
j)
        (VInteger Integer
i, VFloat Double
j) -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Double -> Val
VFloat ((Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i :: Double) Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Double
j)
        (VFloat Double
i, VRatio Rational
j) -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Double -> Val
VFloat (Double
i Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
j)
        (Val, Val)
_ -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> MP m Val) -> FilePath -> MP m Val
forall a b. (a -> b) -> a -> b
$ FilePath
"Can't exponentiate " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
b FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" to " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
e
    Plus Expr
e1 Expr
e2 -> do
      v1 <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
      v2 <- evalExpr e2
      case (v1, v2) of
        (VAlignment Maybe Horiz
x1 Maybe Vert
y1, VAlignment Maybe Horiz
x2 Maybe Vert
y2) ->
          Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Maybe Horiz -> Maybe Vert -> Val
VAlignment (Maybe Horiz
x1 Maybe Horiz -> Maybe Horiz -> Maybe Horiz
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe Horiz
x2) (Maybe Vert
y1 Maybe Vert -> Maybe Vert -> Maybe Vert
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe Vert
y2)
        (VArguments Arguments
xs, VArguments Arguments
ys) ->
          Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Arguments -> Val
VArguments (Arguments
xs Arguments -> Arguments -> Arguments
forall a. Semigroup a => a -> a -> a
<> Arguments
ys)
        (Val, Val)
_ -> case Val -> Val -> Maybe Val
forall a. Summable a => a -> a -> Maybe a
maybePlus Val
v1 Val
v2 of
          Maybe Val
Nothing -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> MP m Val) -> FilePath -> MP m Val
forall a b. (a -> b) -> a -> b
$ FilePath
"Can't + " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
v1 FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" and " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
v2
          Just Val
v -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
v
    Minus Expr
e1 Expr
e2 -> do
      v1 <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
      v2 <- evalExpr e2
      case maybeMinus v1 v2 of
        Maybe Val
Nothing -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> MP m Val) -> FilePath -> MP m Val
forall a b. (a -> b) -> a -> b
$ FilePath
"Can't - " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
v1 FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" and " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
v2
        Just Val
v -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
v
    Times Expr
e1 Expr
e2 -> do
      v1 <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
      v2 <- evalExpr e2
      case maybeTimes v1 v2 of
        Maybe Val
Nothing -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> MP m Val) -> FilePath -> MP m Val
forall a b. (a -> b) -> a -> b
$ FilePath
"Can't * " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
v1 FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" and " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
v2
        Just Val
v -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
v
    Divided Expr
e1 Expr
e2 -> do
      v1 <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
      v2 <- evalExpr e2
      case maybeDividedBy v1 v2 of
        Maybe Val
Nothing -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> MP m Val) -> FilePath -> MP m Val
forall a b. (a -> b) -> a -> b
$ FilePath
"Can't / " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
v1 FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" and " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
v2
        Just Val
v -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
v
    Set Expr
e [Arg]
args -> do
      v <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
      as' <- toArguments args
      case v of
        VFunction (Just Identifier
name) Map Identifier Val
_ Function
_ ->
          (EvalState m -> EvalState m) -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((EvalState m -> EvalState m)
 -> ParsecT [Markup] (EvalState m) m ())
-> (EvalState m -> EvalState m)
-> ParsecT [Markup] (EvalState m) m ()
forall a b. (a -> b) -> a -> b
$ \EvalState m
st ->
            EvalState m
st
              { evalStyles =
                  M.alter
                    ( \case
                        Maybe Arguments
Nothing -> Arguments -> Maybe Arguments
forall a. a -> Maybe a
Just Arguments
as'
                        Just Arguments
as'' -> Arguments -> Maybe Arguments
forall a. a -> Maybe a
Just (Arguments
as'' Arguments -> Arguments -> Arguments
forall a. Semigroup a => a -> a -> a
<> Arguments
as')
                    )
                    name
                    $ evalStyles st
              }
        Val
_ -> FilePath -> ParsecT [Markup] (EvalState m) m ()
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> ParsecT [Markup] (EvalState m) m ())
-> FilePath -> ParsecT [Markup] (EvalState m) m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Set expects an element name"
      pure VNone
    Show Maybe Expr
mbSelExpr Expr
e -> do
      renderVal <- Scope -> MP m Val -> MP m Val
forall (m :: * -> *) a. Monad m => Scope -> MP m a -> MP m a
inBlock Scope
FunctionScope (MP m Val -> MP m Val) -> MP m Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
      case mbSelExpr of
        Maybe Expr
Nothing -> do
          rest <- [Seq Content] -> Seq Content
forall a. Monoid a => [a] -> a
mconcat ([Seq Content] -> Seq Content)
-> ParsecT [Markup] (EvalState m) m [Seq Content]
-> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT [Markup] (EvalState m) m (Seq Content)
-> ParsecT [Markup] (EvalState m) m [Seq Content]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *). Monad m => MP m (Seq Content)
pContent ParsecT [Markup] (EvalState m) m [Seq Content]
-> ParsecT [Markup] (EvalState m) m ()
-> ParsecT [Markup] (EvalState m) m [Seq Content]
forall a b.
ParsecT [Markup] (EvalState m) m a
-> ParsecT [Markup] (EvalState m) m b
-> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT [Markup] (EvalState m) m ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)
          case renderVal of
            VFunction Maybe Identifier
_ Map Identifier Val
_ (Function forall (m :: * -> *). Monad m => Arguments -> MP m Val
f) ->
              Seq Content -> Val
VContent (Seq Content -> Val) -> (Val -> Seq Content) -> Val -> Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Val -> Seq Content
valToContent
                (Val -> Val) -> MP m Val -> MP m Val
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Arguments -> MP m Val
forall (m :: * -> *). Monad m => Arguments -> MP m Val
f Arguments {positional :: [Val]
positional = [Seq Content -> Val
VContent Seq Content
rest], named :: OMap Identifier Val
named = OMap Identifier Val
forall k v. OMap k v
OM.empty}
            Val
_ -> Val -> MP m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> MP m Val) -> Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ Seq Content -> Val
VContent (Seq Content -> Val) -> Seq Content -> Val
forall a b. (a -> b) -> a -> b
$ Val -> Seq Content
valToContent Val
renderVal
        Just Expr
selExpr -> do
          selector <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
selExpr MP m Val
-> (Val -> ParsecT [Markup] (EvalState m) m Selector)
-> ParsecT [Markup] (EvalState m) m Selector
forall a b.
ParsecT [Markup] (EvalState m) m a
-> (a -> ParsecT [Markup] (EvalState m) m b)
-> ParsecT [Markup] (EvalState m) m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Val -> ParsecT [Markup] (EvalState m) m Selector
forall (m :: * -> *). Monad m => Val -> MP m Selector
toSelector
          case renderVal of
            VFunction Maybe Identifier
_ Map Identifier Val
_ (Function forall (m :: * -> *). Monad m => Arguments -> MP m Val
f) ->
              (EvalState m -> EvalState m) -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((EvalState m -> EvalState m)
 -> ParsecT [Markup] (EvalState m) m ())
-> (EvalState m -> EvalState m)
-> ParsecT [Markup] (EvalState m) m ()
forall a b. (a -> b) -> a -> b
$ \EvalState m
st ->
                EvalState m
st
                  { evalShowRules =
                      ShowRule
                        (evalNextShowRuleIdentifier st)
                        selector
                        ( \Content
c ->
                            Val -> Seq Content
valToContent
                              (Val -> Seq Content)
-> ParsecT [Markup] (EvalState m) m Val -> MP m (Seq Content)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Arguments -> ParsecT [Markup] (EvalState m) m Val
forall (m :: * -> *). Monad m => Arguments -> MP m Val
f
                                Arguments
                                  { positional :: [Val]
positional = [Seq Content -> Val
VContent (Content -> Seq Content
forall a. a -> Seq a
Seq.singleton Content
c)],
                                    named :: OMap Identifier Val
named = OMap Identifier Val
forall k v. OMap k v
OM.empty
                                  }
                        )
                        : evalShowRules st,
                    evalNextShowRuleIdentifier = evalNextShowRuleIdentifier st + 1
                  }
            Val
_ -> (EvalState m -> EvalState m) -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((EvalState m -> EvalState m)
 -> ParsecT [Markup] (EvalState m) m ())
-> (EvalState m -> EvalState m)
-> ParsecT [Markup] (EvalState m) m ()
forall a b. (a -> b) -> a -> b
$ \EvalState m
st ->
              EvalState m
st
                { evalShowRules =
                    ShowRule
                      (evalNextShowRuleIdentifier st)
                      selector
                      ( \Content
c ->
                          case Expr
e of
                            -- 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,
                    evalNextShowRuleIdentifier = evalNextShowRuleIdentifier st + 1
                }
          pure VNone
    Binding Bind
_ -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> MP m Val) -> FilePath -> MP m Val
forall a b. (a -> b) -> a -> b
$ FilePath
"Encountered binding out of proper context"
    Assign Expr
e1 Expr
e2 -> do
      val <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e2
      case e1 of
        Binding (BasicBind (Just Identifier
ident)) -> Identifier -> Val -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ()
updateIdentifier Identifier
ident Val
val
        Binding (BasicBind Maybe Identifier
Nothing) -> () -> ParsecT [Markup] (EvalState m) m ()
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Binding (DestructuringBind [BindPart]
parts) ->
          (forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ())
-> [BindPart] -> Val -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *).
Monad m =>
(forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ())
-> [BindPart] -> Val -> MP m ()
destructuringBind Identifier -> Val -> MP m' ()
forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ()
updateIdentifier [BindPart]
parts Val
val
        Expr
x -> Expr -> Val -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *). Monad m => Expr -> Val -> MP m ()
updateExpression Expr
x Val
val
      pure VNone
    If [(Expr, Expr)]
clauses -> do
      let go :: [(Expr, Expr)] -> ParsecT [Markup] (EvalState m) m Val
go [] = Val -> ParsecT [Markup] (EvalState m) m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
VNone
          go ((Expr
cond, Expr
e) : [(Expr, Expr)]
rest) = do
            val <- Expr -> ParsecT [Markup] (EvalState m) m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
cond
            case val of
              VBoolean Bool
True -> Expr -> ParsecT [Markup] (EvalState m) m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
              VBoolean Bool
False -> [(Expr, Expr)] -> ParsecT [Markup] (EvalState m) m Val
go [(Expr, Expr)]
rest
              Val
_ -> FilePath -> ParsecT [Markup] (EvalState m) m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"If requires a boolean condition"
      [(Expr, Expr)] -> MP m Val
forall {m :: * -> *}.
Monad m =>
[(Expr, Expr)] -> ParsecT [Markup] (EvalState m) m Val
go [(Expr, Expr)]
clauses
    While Expr
e1 Expr
e2 -> do
      let go :: Val -> ParsecT [Markup] (EvalState m) m Val
go Val
result = do
            condval <- Expr -> ParsecT [Markup] (EvalState m) m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
            case condval of
              VBoolean Bool
True -> do
                val <- Expr -> ParsecT [Markup] (EvalState m) m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e2
                hadBreak <- (== FlowBreak) . evalFlowDirective <$> getState
                joinVals result val >>= if hadBreak then pure else go
              VBoolean Bool
False -> Val -> ParsecT [Markup] (EvalState m) m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
result
              Val
_ -> FilePath -> ParsecT [Markup] (EvalState m) m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"While loop requires a boolean condition"
      (EvalState m -> EvalState m) -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((EvalState m -> EvalState m)
 -> ParsecT [Markup] (EvalState m) m ())
-> (EvalState m -> EvalState m)
-> ParsecT [Markup] (EvalState m) m ()
forall a b. (a -> b) -> a -> b
$ \EvalState m
st -> EvalState m
st {evalFlowDirective = FlowNormal}
      Val -> MP m Val
forall (m :: * -> *). Monad m => Val -> MP m Val
go Val
VNone
    For Bind
bind Expr
e1 Expr
e2 -> do
      let go :: [Val] -> Val -> ParsecT [Markup] (EvalState m) m Val
go [] Val
result = Val -> ParsecT [Markup] (EvalState m) m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
result
          go (Val
x : [Val]
xs) Val
result = do
            case Bind
bind of
              BasicBind (Just Identifier
ident) -> Identifier -> Val -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ()
addIdentifier Identifier
ident Val
x
              BasicBind Maybe Identifier
Nothing -> () -> ParsecT [Markup] (EvalState m) m ()
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
              DestructuringBind [BindPart]
parts ->
                (forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ())
-> [BindPart] -> Val -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *).
Monad m =>
(forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ())
-> [BindPart] -> Val -> MP m ()
destructuringBind Identifier -> Val -> MP m' ()
forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ()
addIdentifier [BindPart]
parts Val
x
            val <- Expr -> ParsecT [Markup] (EvalState m) m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e2
            hadBreak <- (== FlowBreak) . evalFlowDirective <$> getState
            joinVals result val >>= if hadBreak then pure else go xs
      source <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
      items <- case source of
        VString Text
t -> [Val] -> ParsecT [Markup] (EvalState m) m [Val]
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Val] -> ParsecT [Markup] (EvalState m) m [Val])
-> [Val] -> ParsecT [Markup] (EvalState m) m [Val]
forall a b. (a -> b) -> a -> b
$ (Char -> Val) -> FilePath -> [Val]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Val
VString (Text -> Val) -> (Char -> Text) -> Char -> Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton) (Text -> FilePath
T.unpack Text
t)
        VArray Vector Val
v -> [Val] -> ParsecT [Markup] (EvalState m) m [Val]
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Val] -> ParsecT [Markup] (EvalState m) m [Val])
-> [Val] -> ParsecT [Markup] (EvalState m) m [Val]
forall a b. (a -> b) -> a -> b
$ Vector Val -> [Val]
forall a. Vector a -> [a]
V.toList Vector Val
v
        VDict OMap Identifier Val
m ->
          [Val] -> ParsecT [Markup] (EvalState m) m [Val]
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Val] -> ParsecT [Markup] (EvalState m) m [Val])
-> [Val] -> ParsecT [Markup] (EvalState m) m [Val]
forall a b. (a -> b) -> a -> b
$
            ((Identifier, Val) -> Val) -> [(Identifier, Val)] -> [Val]
forall a b. (a -> b) -> [a] -> [b]
map
              ( \(Identifier Text
k, Val
v) ->
                  Vector Val -> Val
VArray ([Val] -> Vector Val
forall a. [a] -> Vector a
V.fromList [Text -> Val
VString Text
k, Item [Val]
Val
v])
              )
              (OMap Identifier Val -> [(Identifier, Val)]
forall k v. OMap k v -> [(k, v)]
OM.assocs OMap Identifier Val
m)
        Val
_ -> FilePath -> ParsecT [Markup] (EvalState m) m [Val]
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> ParsecT [Markup] (EvalState m) m [Val])
-> FilePath -> ParsecT [Markup] (EvalState m) m [Val]
forall a b. (a -> b) -> a -> b
$ FilePath
"For expression requires an Array or Dictionary"
      updateState $ \EvalState m
st -> EvalState m
st {evalFlowDirective = FlowNormal}
      go items VNone
    Context Expr
e -> do
      Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e -- TODO for now we just ignore "context"
    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
      argval <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
      (modid, modmap) <-
        case argval of
          VString Text
t -> (Seq Content, (Identifier, Map Identifier Val))
-> (Identifier, Map Identifier Val)
forall a b. (a, b) -> b
snd ((Seq Content, (Identifier, Map Identifier Val))
 -> (Identifier, Map Identifier Val))
-> ParsecT
     [Markup]
     (EvalState m)
     m
     (Seq Content, (Identifier, Map Identifier Val))
-> ParsecT
     [Markup] (EvalState m) m (Identifier, Map Identifier Val)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> ParsecT
     [Markup]
     (EvalState m)
     m
     (Seq Content, (Identifier, Map Identifier Val))
forall (m :: * -> *).
Monad m =>
Text -> MP m (Seq Content, (Identifier, Map Identifier Val))
loadModule Text
t
          VModule Identifier
i Map Identifier Val
m -> (Identifier, Map Identifier Val)
-> ParsecT
     [Markup] (EvalState m) m (Identifier, Map Identifier Val)
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Identifier
i, Map Identifier Val
m)
          VFunction (Just Identifier
i) Map Identifier Val
m Function
_ -> (Identifier, Map Identifier Val)
-> ParsecT
     [Markup] (EvalState m) m (Identifier, Map Identifier Val)
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Identifier
i, Map Identifier Val
m)
          VFunction Maybe Identifier
Nothing Map Identifier Val
m Function
_ -> (Identifier, Map Identifier Val)
-> ParsecT
     [Markup] (EvalState m) m (Identifier, Map Identifier Val)
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Identifier
"anonymous", Map Identifier Val
m)
          Val
_ -> FilePath
-> ParsecT
     [Markup] (EvalState m) m (Identifier, Map Identifier Val)
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Import requires a path or module or function"
      case imports of
        Imports
AllIdentifiers -> Map Identifier Val -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *). Monad m => Map Identifier Val -> MP m ()
importModule Map Identifier Val
modmap
        SomeIdentifiers [(Identifier, Maybe Identifier)]
pairs -> do
          let addFromModule :: Map Identifier Val
-> (Identifier, Maybe Identifier) -> m (Map Identifier Val)
addFromModule Map Identifier Val
m (Identifier
ident, Maybe Identifier
mbAs) =
                case Identifier -> Map Identifier Val -> Maybe Val
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Identifier
ident Map Identifier Val
modmap of
                  Maybe Val
Nothing -> FilePath -> m (Map Identifier Val)
forall a. FilePath -> m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> m (Map Identifier Val))
-> FilePath -> m (Map Identifier Val)
forall a b. (a -> b) -> a -> b
$ Identifier -> FilePath
forall a. Show a => a -> FilePath
show Identifier
ident FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" not defined in module"
                  Just Val
v -> Map Identifier Val -> m (Map Identifier Val)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map Identifier Val -> m (Map Identifier Val))
-> Map Identifier Val -> m (Map Identifier Val)
forall a b. (a -> b) -> a -> b
$ Identifier -> Val -> Map Identifier Val -> Map Identifier Val
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Identifier -> Maybe Identifier -> Identifier
forall a. a -> Maybe a -> a
fromMaybe Identifier
ident Maybe Identifier
mbAs) Val
v Map Identifier Val
m
          (Map Identifier Val
 -> (Identifier, Maybe Identifier)
 -> ParsecT [Markup] (EvalState m) m (Map Identifier Val))
-> Map Identifier Val
-> [(Identifier, Maybe Identifier)]
-> ParsecT [Markup] (EvalState m) m (Map Identifier Val)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Map Identifier Val
-> (Identifier, Maybe Identifier)
-> ParsecT [Markup] (EvalState m) m (Map Identifier Val)
forall {m :: * -> *}.
MonadFail m =>
Map Identifier Val
-> (Identifier, Maybe Identifier) -> m (Map Identifier Val)
addFromModule Map Identifier Val
forall a. Monoid a => a
mempty [(Identifier, Maybe Identifier)]
pairs ParsecT [Markup] (EvalState m) m (Map Identifier Val)
-> (Map Identifier Val -> ParsecT [Markup] (EvalState m) m ())
-> ParsecT [Markup] (EvalState m) m ()
forall a b.
ParsecT [Markup] (EvalState m) m a
-> (a -> ParsecT [Markup] (EvalState m) m b)
-> ParsecT [Markup] (EvalState m) m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Map Identifier Val -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *). Monad m => Map Identifier Val -> MP m ()
importModule
        NoIdentifiers Maybe Identifier
mbAs -> do
          let ident :: Identifier
ident = Identifier -> Maybe Identifier -> Identifier
forall a. a -> Maybe a -> a
fromMaybe Identifier
modid Maybe Identifier
mbAs
          Identifier -> Val -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ()
addIdentifier Identifier
ident (Identifier -> Map Identifier Val -> Val
VModule Identifier
ident Map Identifier Val
modmap)
      pure VNone
    Include Expr
e -> do
      argval <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
      case argval of
        VString Text
t -> do
          (cs, _) <- Text
-> ParsecT
     [Markup]
     (EvalState m)
     m
     (Seq Content, (Identifier, Map Identifier Val))
forall (m :: * -> *).
Monad m =>
Text -> MP m (Seq Content, (Identifier, Map Identifier Val))
loadModule Text
t
          pure $ VContent cs
        Val
_ -> FilePath -> MP m Val
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Include requires a path"

toFunction ::
  Monad m =>
  Maybe Identifier ->
  [Param] ->
  Expr ->
  MP m Val
toFunction :: forall (m :: * -> *).
Monad m =>
Maybe Identifier -> [Param] -> Expr -> MP m Val
toFunction Maybe Identifier
mbname [Param]
params Expr
e = do
  idents <- EvalState m -> [(Scope, Map Identifier Val)]
forall (m :: * -> *). EvalState m -> [(Scope, Map Identifier Val)]
evalIdentifiers (EvalState m -> [(Scope, Map Identifier Val)])
-> ParsecT [Markup] (EvalState m) m (EvalState m)
-> ParsecT [Markup] (EvalState m) m [(Scope, Map Identifier Val)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Markup] (EvalState m) m (EvalState m)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  let fn = Maybe Identifier -> Map Identifier Val -> Function -> Val
VFunction Maybe Identifier
forall a. Maybe a
Nothing Map Identifier Val
forall a. Monoid a => a
mempty (Function -> Val) -> Function -> Val
forall a b. (a -> b) -> a -> b
$ (forall (m :: * -> *). Monad m => Arguments -> MP m Val)
-> Function
Function ((forall (m :: * -> *). Monad m => Arguments -> MP m Val)
 -> Function)
-> (forall (m :: * -> *). Monad m => Arguments -> MP m Val)
-> Function
forall a b. (a -> b) -> a -> b
$ \Arguments
arguments -> do
        -- 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 <- case Identifier -> OMap Identifier Val -> Maybe Val
forall k v. Ord k => k -> OMap k v -> Maybe v
OM.lookup Identifier
ident (Arguments -> OMap Identifier Val
named Arguments
as) of
                Maybe Val
Nothing -> Expr -> ParsecT [Markup] (EvalState m) m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e'
                Just Val
v -> Val -> ParsecT [Markup] (EvalState m) m Val
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
v
              addIdentifier ident val
              pure $ as {named = OM.delete ident (named as)}
            setParam Arguments
as (NormalParam Identifier
ident) = do
              case Arguments -> [Val]
positional Arguments
as of
                [] -> FilePath -> ParsecT [Markup] (EvalState m) m Arguments
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath
"Expected parameter " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Identifier -> FilePath
showIdentifier Identifier
ident)
                (Val
x : [Val]
xs) -> do
                  Identifier -> Val -> MP m ()
forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ()
addIdentifier Identifier
ident Val
x
                  Arguments -> ParsecT [Markup] (EvalState m) m Arguments
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Arguments -> ParsecT [Markup] (EvalState m) m Arguments)
-> Arguments -> ParsecT [Markup] (EvalState m) m Arguments
forall a b. (a -> b) -> a -> b
$ Arguments
as {positional = xs}
            setParam Arguments
_ (SinkParam {}) =
              FilePath -> ParsecT [Markup] (EvalState m) m Arguments
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"setParam encountered SinkParam"
            setParam Arguments
as (DestructuringParam [BindPart]
parts) =
              case Arguments -> [Val]
positional Arguments
as of
                [] -> FilePath -> ParsecT [Markup] (EvalState m) m Arguments
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath
"Expected parameter " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> [BindPart] -> FilePath
forall a. Show a => a -> FilePath
show [BindPart]
parts)
                (Val
x : [Val]
xs) -> do
                  (forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ())
-> [BindPart] -> Val -> MP m ()
forall (m :: * -> *).
Monad m =>
(forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ())
-> [BindPart] -> Val -> MP m ()
destructuringBind Identifier -> Val -> MP m' ()
forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ()
addIdentifier [BindPart]
parts Val
x
                  Arguments -> ParsecT [Markup] (EvalState m) m Arguments
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Arguments -> ParsecT [Markup] (EvalState m) m Arguments)
-> Arguments -> ParsecT [Markup] (EvalState m) m Arguments
forall a b. (a -> b) -> a -> b
$ Arguments
as {positional = xs}
            setParam Arguments
as Param
SkipParam = Arguments -> ParsecT [Markup] (EvalState m) m Arguments
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Arguments
as
        Scope -> MP m Val -> MP m Val
forall (m :: * -> *) a. Monad m => Scope -> MP m a -> MP m a
inBlock Scope
FunctionScope (MP m Val -> MP m Val) -> MP m Val -> MP m Val
forall a b. (a -> b) -> a -> b
$ do
          -- We create a closure around the identifiers defined
          -- where the function is defined:
          oldState <- ParsecT [Markup] (EvalState m) m (EvalState m)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
          updateState $ \EvalState m
st -> EvalState m
st {evalIdentifiers = idents}
          case mbname of
            Maybe Identifier
Nothing -> () -> ParsecT [Markup] (EvalState m) m ()
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            Just Identifier
name -> Identifier -> Val -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ()
addIdentifier Identifier
name Val
fn
          case break isSinkParam params of
            ([Param]
befores, SinkParam Maybe Identifier
mbident : [Param]
afters) -> do
              as' <- (Arguments -> Param -> ParsecT [Markup] (EvalState m) m Arguments)
-> Arguments
-> [Param]
-> ParsecT [Markup] (EvalState m) m Arguments
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Arguments -> Param -> ParsecT [Markup] (EvalState m) m Arguments
forall {m :: * -> *}.
Monad m =>
Arguments -> Param -> ParsecT [Markup] (EvalState m) m Arguments
setParam Arguments
arguments [Param]
befores
              as'' <-
                foldM
                  setParam
                  as' {positional = reverse $ positional as'}
                  (reverse afters)
              let as = Arguments
as'' {positional = reverse $ positional as''}
              case mbident of
                Just Identifier
ident -> Identifier -> Val -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ()
addIdentifier Identifier
ident (Arguments -> Val
VArguments Arguments
as)
                Maybe Identifier
Nothing -> () -> ParsecT [Markup] (EvalState m) m ()
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            ([Param], [Param])
_ -> (Arguments -> Param -> ParsecT [Markup] (EvalState m) m Arguments)
-> Arguments -> [Param] -> ParsecT [Markup] (EvalState m) m ()
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m ()
foldM_ Arguments -> Param -> ParsecT [Markup] (EvalState m) m Arguments
forall {m :: * -> *}.
Monad m =>
Arguments -> Param -> ParsecT [Markup] (EvalState m) m Arguments
setParam Arguments
arguments [Param]
params
          res <- evalExpr e
          setState oldState
          pure res
  pure fn

-- | 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 :: forall l. Value' l -> Matcher l Config
fromValue = Value' l -> Matcher l Config
forall a l.
(Generic a, GParseTable (Rep a)) =>
Value' l -> Matcher l a
Toml.genericFromTable

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

findPackageEntryPoint :: Monad m => Text -> MP m FilePath
findPackageEntryPoint :: forall (m :: * -> *). Monad m => Text -> MP m FilePath
findPackageEntryPoint Text
modname = do
  let (FilePath
namespace, FilePath
rest) = (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'/') (Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop Int
1 (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
modname)
  let (FilePath
name, FilePath
rest') = (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
':') (FilePath -> (FilePath, FilePath))
-> FilePath -> (FilePath, FilePath)
forall a b. (a -> b) -> a -> b
$ Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop Int
1 FilePath
rest
  let version :: FilePath
version = Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop Int
1 FilePath
rest'
  operations <- EvalState m -> Operations m
forall (m :: * -> *). EvalState m -> Operations m
evalOperations (EvalState m -> Operations m)
-> ParsecT [Markup] (EvalState m) m (EvalState m)
-> ParsecT [Markup] (EvalState m) m (Operations m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Markup] (EvalState m) m (EvalState m)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  let getEnv FilePath
var = do
        mbv <- m (Maybe FilePath) -> t m (Maybe FilePath)
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe FilePath) -> t m (Maybe FilePath))
-> m (Maybe FilePath) -> t m (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ Operations m -> FilePath -> m (Maybe FilePath)
forall (m :: * -> *).
Operations m -> FilePath -> m (Maybe FilePath)
lookupEnvVar Operations m
operations FilePath
var
        case mbv of
          Just FilePath
v -> FilePath -> t m FilePath
forall a. a -> t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
v
          Maybe FilePath
Nothing -> FilePath -> t m FilePath
forall a. FilePath -> t m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath
var FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" not defined")
#ifdef __MACOS__
  homeDir <- getEnv "HOME"
  let localDir = homeDir </> "Library" </> "Application Support" </> "typst"
  let cacheDir = homeDir </> "Library" </> "Caches" </> "typst"
#elif __WINDOWS__
  appDataDir <- getEnv "APPDATA"
  let localDir = appDataDir </> "typst"
  localAppDataDir <- getEnv "LOCALAPPDATA"
  let cacheDir = localAppDataDir </> "typst"
#else
  homeDir <- getEnv "HOME"
  dataDir <- lift (lookupEnvVar operations "XDG_DATA_HOME") >>=
               maybe (pure (homeDir </> ".local" </> "share")) pure
  cacheDir' <- lift (lookupEnvVar operations "XDG_CACHE_HOME") >>=
               maybe (pure (homeDir </> ".cache")) pure
  let localDir = FilePath
dataDir FilePath -> FilePath -> FilePath
</> FilePath
"typst"
  let cacheDir = FilePath
cacheDir' FilePath -> FilePath -> FilePath
</> FilePath
"typst"
#endif
  let subpath = FilePath
"packages" FilePath -> FilePath -> FilePath
</> FilePath
namespace FilePath -> FilePath -> FilePath
</> FilePath
name FilePath -> FilePath -> FilePath
</> FilePath
version
  inLocal <- lift $ checkExistence operations (localDir </> subpath </> "typst.toml")
  tomlPath <-
     if inLocal
        then pure (localDir </> subpath </> "typst.toml")
        else do
          inCache <- lift $ checkExistence operations (cacheDir </> subpath </> "typst.toml")
          if inCache
             then pure (cacheDir </> subpath </> "typst.toml")
             else fail $ "Could not find package in local packages or cache. Looked in\n" ++
                    (localDir </> subpath) ++ "\n" ++ (cacheDir </> subpath) ++
                    "\nCompile with typst compile to bring the package into your local cache."
             -- TODO? fetch from CDN if not present in cache?
  tomlString <- TE.decodeUtf8 <$> lift (loadBytes operations tomlPath)
  case Toml.decode tomlString of
    Toml.Failure [FilePath]
e -> FilePath -> ParsecT [Markup] (EvalState m) m FilePath
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail ([FilePath] -> FilePath
unlines (FilePath
"Failure loading typst.toml" FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
e))
    Toml.Success [FilePath]
_warnings Config
cfg -> -- ignores warnings like unused keys in TOML
      FilePath -> ParsecT [Markup] (EvalState m) m FilePath
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> FilePath -> FilePath
replaceFileName FilePath
tomlPath (PackageConfig -> FilePath
entrypoint (Config -> PackageConfig
package Config
cfg)))

loadModule :: Monad m => Text
           -> MP m (Seq Content, (Identifier, M.Map Identifier Val))
loadModule :: forall (m :: * -> *).
Monad m =>
Text -> MP m (Seq Content, (Identifier, Map Identifier Val))
loadModule Text
modname = do
  (fp, modid, mbPackageRoot, txt) <-
        if Int -> Text -> Text
T.take Int
1 Text
modname Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"@"
           then do
            fp' <- Text -> MP m FilePath
forall (m :: * -> *). Monad m => Text -> MP m FilePath
findPackageEntryPoint Text
modname
            operations <- evalOperations <$> getState
            txt <- lift $ TE.decodeUtf8 <$> loadBytes operations fp'
            pure ( takeFileName fp',
                   Identifier
                    (T.pack $ takeWhile (/= ':') . takeBaseName $
                       T.unpack modname),
                   Just (takeDirectory fp'),
                   txt )
           else do
             let fp :: FilePath
fp = Text -> FilePath
T.unpack Text
modname
             txt <- FilePath -> ParsecT [Markup] (EvalState m) m Text
forall (m :: * -> *). Monad m => FilePath -> MP m Text
loadFileText FilePath
fp
             pure ( fp,
                    Identifier (T.pack $ takeBaseName fp),
                    Nothing,
                    txt )
  case parseTypst fp txt of
    Left ParseError
err -> FilePath
-> ParsecT
     [Markup]
     (EvalState m)
     m
     (Seq Content, (Identifier, Map Identifier Val))
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath
 -> ParsecT
      [Markup]
      (EvalState m)
      m
      (Seq Content, (Identifier, Map Identifier Val)))
-> FilePath
-> ParsecT
     [Markup]
     (EvalState m)
     m
     (Seq Content, (Identifier, Map Identifier Val))
forall a b. (a -> b) -> a -> b
$ ParseError -> FilePath
forall a. Show a => a -> FilePath
show ParseError
err
    Right [Markup]
ms -> do
      operations <- EvalState m -> Operations m
forall (m :: * -> *). EvalState m -> Operations m
evalOperations (EvalState m -> Operations m)
-> ParsecT [Markup] (EvalState m) m (EvalState m)
-> ParsecT [Markup] (EvalState m) m (Operations m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Markup] (EvalState m) m (EvalState m)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
      currentLocalDir <- evalLocalDir <$> getState
      currentPackageRoot <- evalPackageRoot <$> getState
      let (pkgroot , localdir) =
            case mbPackageRoot of
              Just FilePath
r -> (FilePath
r , FilePath -> FilePath
takeDirectory FilePath
fp)
              Maybe FilePath
Nothing -> (FilePath
currentPackageRoot,
                          FilePath
currentLocalDir FilePath -> FilePath -> FilePath
</> FilePath -> FilePath
takeDirectory FilePath
fp)
      res <-
        lift $
          runParserT
            ( inBlock BlockScope $ do -- add new identifiers list
                cs <- mconcat <$> many pContent
                eof
                s <- getState
                pure (cs, s)
            )
            initialEvalState{evalOperations = operations,
                             evalLocalDir = localdir,
                             evalPackageRoot = pkgroot }
            fp
            ms
      case res of
        Left ParseError
err' -> FilePath
-> ParsecT
     [Markup]
     (EvalState m)
     m
     (Seq Content, (Identifier, Map Identifier Val))
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath
 -> ParsecT
      [Markup]
      (EvalState m)
      m
      (Seq Content, (Identifier, Map Identifier Val)))
-> FilePath
-> ParsecT
     [Markup]
     (EvalState m)
     m
     (Seq Content, (Identifier, Map Identifier Val))
forall a b. (a -> b) -> a -> b
$ ParseError -> FilePath
forall a. Show a => a -> FilePath
show ParseError
err'
        Right (Seq Content
contents, EvalState m
st) ->
          case EvalState m -> [(Scope, Map Identifier Val)]
forall (m :: * -> *). EvalState m -> [(Scope, Map Identifier Val)]
evalIdentifiers EvalState m
st of
            [] -> FilePath
-> ParsecT
     [Markup]
     (EvalState m)
     m
     (Seq Content, (Identifier, Map Identifier Val))
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Empty evalIdentifiers in module!"
            ((Scope
_, Map Identifier Val
m) : [(Scope, Map Identifier Val)]
_) -> (Seq Content, (Identifier, Map Identifier Val))
-> ParsecT
     [Markup]
     (EvalState m)
     m
     (Seq Content, (Identifier, Map Identifier Val))
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Seq Content
contents, (Identifier
modid, Map Identifier Val
m))

importModule :: Monad m => M.Map Identifier Val -> MP m ()
importModule :: forall (m :: * -> *). Monad m => Map Identifier Val -> MP m ()
importModule Map Identifier Val
m = (EvalState m -> EvalState m) -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((EvalState m -> EvalState m)
 -> ParsecT [Markup] (EvalState m) m ())
-> (EvalState m -> EvalState m)
-> ParsecT [Markup] (EvalState m) m ()
forall a b. (a -> b) -> a -> b
$ \EvalState m
st ->
  EvalState m
st
    { evalIdentifiers =
        case evalIdentifiers st of
          [] -> [(Scope
BlockScope, Map Identifier Val
m)]
          ((Scope
s, Map Identifier Val
i) : [(Scope, Map Identifier Val)]
is) -> (Scope
s, Map Identifier Val
m Map Identifier Val -> Map Identifier Val -> Map Identifier Val
forall a. Semigroup a => a -> a -> a
<> Map Identifier Val
i) (Scope, Map Identifier Val)
-> [(Scope, Map Identifier Val)] -> [(Scope, Map Identifier Val)]
forall a. a -> [a] -> [a]
: [(Scope, Map Identifier Val)]
is
    }

evalLiteral :: Literal -> Val
evalLiteral :: Literal -> Val
evalLiteral Literal
lit =
  case Literal
lit of
    String Text
t -> Text -> Val
VString Text
t
    Boolean Bool
b -> Bool -> Val
VBoolean Bool
b
    Float Double
x -> Double -> Val
VFloat Double
x
    Int Integer
i -> Integer -> Val
VInteger Integer
i
    Numeric Double
x Unit
unit ->
      case Unit
unit of
        Unit
Fr -> Double -> Val
VFraction Double
x
        Unit
Percent -> Rational -> Val
VRatio (Double -> Rational
forall a. Real a => a -> Rational
toRational Double
x Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
100)
        Unit
Deg -> Double -> Val
VAngle Double
x
        Unit
Rad -> Double -> Val
VAngle (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
180 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
forall a. Floating a => a
pi))
        Unit
Pt -> Length -> Val
VLength (Double -> LUnit -> Length
LExact Double
x LUnit
LPt)
        Unit
Em -> Length -> Val
VLength (Double -> LUnit -> Length
LExact Double
x LUnit
LEm)
        Unit
Mm -> Length -> Val
VLength (Double -> LUnit -> Length
LExact Double
x LUnit
LMm)
        Unit
Cm -> Length -> Val
VLength (Double -> LUnit -> Length
LExact Double
x LUnit
LCm)
        Unit
In -> Length -> Val
VLength (Double -> LUnit -> Length
LExact Double
x LUnit
LIn)
    Literal
None -> Val
VNone
    Literal
Auto -> Val
VAuto

toArguments :: Monad m => [Arg] -> MP m Arguments
toArguments :: forall (m :: * -> *). Monad m => [Arg] -> MP m Arguments
toArguments = (Arguments -> Arg -> ParsecT [Markup] (EvalState m) m Arguments)
-> Arguments -> [Arg] -> ParsecT [Markup] (EvalState m) m Arguments
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Arguments -> Arg -> ParsecT [Markup] (EvalState m) m Arguments
forall {m :: * -> *}.
Monad m =>
Arguments -> Arg -> ParsecT [Markup] (EvalState m) m Arguments
addArg ([Val] -> OMap Identifier Val -> Arguments
Arguments [Val]
forall a. Monoid a => a
mempty OMap Identifier Val
forall k v. OMap k v
OM.empty)
  where
    addArg :: Arguments -> Arg -> ParsecT [Markup] (EvalState m) m Arguments
addArg Arguments
args (KeyValArg Identifier
ident Expr
e) = do
      val <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
      pure $ args {named = named args OM.|> (ident, val)}
    addArg Arguments
args (NormalArg Expr
e) = do
      val <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
      pure $ args {positional = positional args ++ [val]}
    addArg Arguments
args (ArrayArg [[Markup]]
rows) = do
      let pRow :: [Markup] -> MP m Val
pRow =
            ([Val] -> Val)
-> ParsecT [Markup] (EvalState m) m [Val] -> MP m Val
forall a b.
(a -> b)
-> ParsecT [Markup] (EvalState m) m a
-> ParsecT [Markup] (EvalState m) m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Vector Val -> Val
VArray (Vector Val -> Val) -> ([Val] -> Vector Val) -> [Val] -> Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Val] -> Vector Val
forall a. [a] -> Vector a
V.fromList)
              (ParsecT [Markup] (EvalState m) m [Val] -> MP m Val)
-> ([Markup] -> ParsecT [Markup] (EvalState m) m [Val])
-> [Markup]
-> MP m Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Markup -> MP m Val)
-> [Markup] -> ParsecT [Markup] (EvalState m) m [Val]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Seq Content -> Val)
-> ParsecT [Markup] (EvalState m) m (Seq Content) -> MP m Val
forall a b.
(a -> b)
-> ParsecT [Markup] (EvalState m) m a
-> ParsecT [Markup] (EvalState m) m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Seq Content -> Val
VContent (ParsecT [Markup] (EvalState m) m (Seq Content) -> MP m Val)
-> (Markup -> ParsecT [Markup] (EvalState m) m (Seq Content))
-> Markup
-> MP m Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Markup] -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents ([Markup] -> ParsecT [Markup] (EvalState m) m (Seq Content))
-> (Markup -> [Markup])
-> Markup
-> ParsecT [Markup] (EvalState m) m (Seq Content)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Markup -> [Markup] -> [Markup]
forall a. a -> [a] -> [a]
: []))
      vals <- ([Markup] -> MP m Val)
-> [[Markup]] -> ParsecT [Markup] (EvalState m) m [Val]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Markup] -> MP m Val
pRow [[Markup]]
rows
      pure $ args {positional = positional args ++ vals}
    addArg Arguments
args (SpreadArg Expr
e) = do
      val <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
      case val of
        Val
VNone -> Arguments -> ParsecT [Markup] (EvalState m) m Arguments
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Arguments
forall a. Monoid a => a
mempty
        VArguments Arguments
args' -> Arguments -> ParsecT [Markup] (EvalState m) m Arguments
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Arguments -> ParsecT [Markup] (EvalState m) m Arguments)
-> Arguments -> ParsecT [Markup] (EvalState m) m Arguments
forall a b. (a -> b) -> a -> b
$ Arguments
args Arguments -> Arguments -> Arguments
forall a. Semigroup a => a -> a -> a
<> Arguments
args'
        VDict OMap Identifier Val
m ->
          Arguments -> ParsecT [Markup] (EvalState m) m Arguments
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Arguments -> ParsecT [Markup] (EvalState m) m Arguments)
-> Arguments -> ParsecT [Markup] (EvalState m) m Arguments
forall a b. (a -> b) -> a -> b
$
            Arguments
args
              Arguments -> Arguments -> Arguments
forall a. Semigroup a => a -> a -> a
<> Arguments {positional :: [Val]
positional = [Val]
forall a. Monoid a => a
mempty, named :: OMap Identifier Val
named = OMap Identifier Val
m}
        VArray Vector Val
v ->
          Arguments -> ParsecT [Markup] (EvalState m) m Arguments
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Arguments -> ParsecT [Markup] (EvalState m) m Arguments)
-> Arguments -> ParsecT [Markup] (EvalState m) m Arguments
forall a b. (a -> b) -> a -> b
$
            Arguments
args
              Arguments -> Arguments -> Arguments
forall a. Semigroup a => a -> a -> a
<> Arguments {positional :: [Val]
positional = Vector Val -> [Val]
forall a. Vector a -> [a]
V.toList Vector Val
v, named :: OMap Identifier Val
named = OMap Identifier Val
forall k v. OMap k v
OM.empty}
        Val
_ -> FilePath -> ParsecT [Markup] (EvalState m) m Arguments
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> ParsecT [Markup] (EvalState m) m Arguments)
-> FilePath -> ParsecT [Markup] (EvalState m) m Arguments
forall a b. (a -> b) -> a -> b
$ FilePath
"spread requires an argument value, got " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
val
    addArg Arguments
args (BlockArg [Markup]
ms) = do
      val <- [Markup] -> ParsecT [Markup] (EvalState m) m (Seq Content)
forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Markup]
ms
      pure $ args {positional = positional args ++ [VContent val]}

addIdentifier :: Monad m => Identifier -> Val -> MP m ()
addIdentifier :: forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ()
addIdentifier Identifier
ident Val
val = do
  identifiers <- EvalState m -> [(Scope, Map Identifier Val)]
forall (m :: * -> *). EvalState m -> [(Scope, Map Identifier Val)]
evalIdentifiers (EvalState m -> [(Scope, Map Identifier Val)])
-> ParsecT [Markup] (EvalState m) m (EvalState m)
-> ParsecT [Markup] (EvalState m) m [(Scope, Map Identifier Val)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Markup] (EvalState m) m (EvalState m)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  case identifiers of
    [] -> FilePath -> ParsecT [Markup] (EvalState m) m ()
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Empty evalIdentifiers"
    ((Scope
s, Map Identifier Val
i) : [(Scope, Map Identifier Val)]
is) -> (EvalState m -> EvalState m) -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((EvalState m -> EvalState m)
 -> ParsecT [Markup] (EvalState m) m ())
-> (EvalState m -> EvalState m)
-> ParsecT [Markup] (EvalState m) m ()
forall a b. (a -> b) -> a -> b
$ \EvalState m
st ->
      EvalState m
st { evalIdentifiers = (s, M.insert ident val i) : is }

updateIdentifier :: Monad m => Identifier -> Val -> MP m ()
updateIdentifier :: forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ()
updateIdentifier Identifier
ident Val
val = do
  let go :: (Bool, [(Scope, Map Identifier Val)])
-> (Scope, Map Identifier Val)
-> f (Bool, [(Scope, Map Identifier Val)])
go (Bool
True, [(Scope, Map Identifier Val)]
is) (Scope
s, Map Identifier Val
m) = (Bool, [(Scope, Map Identifier Val)])
-> f (Bool, [(Scope, Map Identifier Val)])
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
True, (Scope
s, Map Identifier Val
m) (Scope, Map Identifier Val)
-> [(Scope, Map Identifier Val)] -> [(Scope, Map Identifier Val)]
forall a. a -> [a] -> [a]
: [(Scope, Map Identifier Val)]
is)
      go (Bool
False, [(Scope, Map Identifier Val)]
is) (Scope
s, Map Identifier Val
m) =
        case Identifier -> Map Identifier Val -> Maybe Val
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Identifier
ident Map Identifier Val
m of
          Maybe Val
Nothing
            | Scope
s Scope -> Scope -> Bool
forall a. Eq a => a -> a -> Bool
== Scope
FunctionScope -> FilePath -> f (Bool, [(Scope, Map Identifier Val)])
forall a. FilePath -> f a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> f (Bool, [(Scope, Map Identifier Val)]))
-> FilePath -> f (Bool, [(Scope, Map Identifier Val)])
forall a b. (a -> b) -> a -> b
$ Identifier -> FilePath
forall a. Show a => a -> FilePath
show Identifier
ident FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" not defined in scope"
            | Bool
otherwise -> (Bool, [(Scope, Map Identifier Val)])
-> f (Bool, [(Scope, Map Identifier Val)])
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
False, (Scope
s, Map Identifier Val
m) (Scope, Map Identifier Val)
-> [(Scope, Map Identifier Val)] -> [(Scope, Map Identifier Val)]
forall a. a -> [a] -> [a]
: [(Scope, Map Identifier Val)]
is)
          Just Val
_ -> (Bool, [(Scope, Map Identifier Val)])
-> f (Bool, [(Scope, Map Identifier Val)])
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
True, (Scope
s, (Val -> Val)
-> Identifier -> Map Identifier Val -> Map Identifier Val
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust (Val -> Val -> Val
forall a b. a -> b -> a
const Val
val) Identifier
ident Map Identifier Val
m) (Scope, Map Identifier Val)
-> [(Scope, Map Identifier Val)] -> [(Scope, Map Identifier Val)]
forall a. a -> [a] -> [a]
: [(Scope, Map Identifier Val)]
is)
  (finished, newmaps) <- ParsecT [Markup] (EvalState m) m (EvalState m)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState ParsecT [Markup] (EvalState m) m (EvalState m)
-> (EvalState m
    -> ParsecT
         [Markup] (EvalState m) m (Bool, [(Scope, Map Identifier Val)]))
-> ParsecT
     [Markup] (EvalState m) m (Bool, [(Scope, Map Identifier Val)])
forall a b.
ParsecT [Markup] (EvalState m) m a
-> (a -> ParsecT [Markup] (EvalState m) m b)
-> ParsecT [Markup] (EvalState m) m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((Bool, [(Scope, Map Identifier Val)])
 -> (Scope, Map Identifier Val)
 -> ParsecT
      [Markup] (EvalState m) m (Bool, [(Scope, Map Identifier Val)]))
-> (Bool, [(Scope, Map Identifier Val)])
-> [(Scope, Map Identifier Val)]
-> ParsecT
     [Markup] (EvalState m) m (Bool, [(Scope, Map Identifier Val)])
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Bool, [(Scope, Map Identifier Val)])
-> (Scope, Map Identifier Val)
-> ParsecT
     [Markup] (EvalState m) m (Bool, [(Scope, Map Identifier Val)])
forall {f :: * -> *}.
MonadFail f =>
(Bool, [(Scope, Map Identifier Val)])
-> (Scope, Map Identifier Val)
-> f (Bool, [(Scope, Map Identifier Val)])
go (Bool
False, []) ([(Scope, Map Identifier Val)]
 -> ParsecT
      [Markup] (EvalState m) m (Bool, [(Scope, Map Identifier Val)]))
-> (EvalState m -> [(Scope, Map Identifier Val)])
-> EvalState m
-> ParsecT
     [Markup] (EvalState m) m (Bool, [(Scope, Map Identifier Val)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalState m -> [(Scope, Map Identifier Val)]
forall (m :: * -> *). EvalState m -> [(Scope, Map Identifier Val)]
evalIdentifiers
  if finished
    then updateState $ \EvalState m
st -> EvalState m
st {evalIdentifiers = reverse newmaps}
    else fail $ show ident <> " not defined"

inBlock :: Monad m => Scope -> MP m a -> MP m a
inBlock :: forall (m :: * -> *) a. Monad m => Scope -> MP m a -> MP m a
inBlock Scope
scope MP m a
pa = do
  oldStyles <- EvalState m -> Map Identifier Arguments
forall (m :: * -> *). EvalState m -> Map Identifier Arguments
evalStyles (EvalState m -> Map Identifier Arguments)
-> ParsecT [Markup] (EvalState m) m (EvalState m)
-> ParsecT [Markup] (EvalState m) m (Map Identifier Arguments)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Markup] (EvalState m) m (EvalState m)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  -- add a new identifiers map
  updateState $ \EvalState m
st ->
    EvalState m
st
      { evalIdentifiers = (scope, mempty) : evalIdentifiers st
      }
  result <- pa
  updateState $ \EvalState m
st ->
    EvalState m
st
      { evalIdentifiers = drop 1 (evalIdentifiers st),
        evalStyles = oldStyles
      }
  pure result

updateExpression :: Monad m => Expr -> Val -> MP m ()
updateExpression :: forall (m :: * -> *). Monad m => Expr -> Val -> MP m ()
updateExpression
  (FuncCall (FieldAccess (Ident (Identifier Text
"first")) Expr
e') []) Val
val
  = Expr -> Val -> MP m ()
forall (m :: * -> *). Monad m => Expr -> Val -> MP m ()
updateExpression ( Expr -> [Arg] -> Expr
FuncCall
                       (Expr -> Expr -> Expr
FieldAccess (Identifier -> Expr
Ident (Text -> Identifier
Identifier Text
"at")) Expr
e')
                       [Expr -> Arg
NormalArg (Literal -> Expr
Literal (Integer -> Literal
Int Integer
0))]
                     ) Val
val
updateExpression
  (FuncCall (FieldAccess (Ident (Identifier Text
"last")) Expr
e') []) Val
val
  = Expr -> Val -> MP m ()
forall (m :: * -> *). Monad m => Expr -> Val -> MP m ()
updateExpression ( Expr -> [Arg] -> Expr
FuncCall
                       (Expr -> Expr -> Expr
FieldAccess (Identifier -> Expr
Ident (Text -> Identifier
Identifier Text
"at")) Expr
e')
                       [Expr -> Arg
NormalArg (Literal -> Expr
Literal (Integer -> Literal
Int (-Integer
1)))]
                     ) Val
val
updateExpression
  (FieldAccess (Ident (Identifier Text
fld)) Expr
e') Val
val
  = Bool -> Expr -> Expr -> Val -> MP m ()
forall (m :: * -> *).
Monad m =>
Bool -> Expr -> Expr -> Val -> MP m ()
updateExpression' Bool
True Expr
e' (Literal -> Expr
Literal (Text -> Literal
String Text
fld)) Val
val -- 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
    container <- Expr -> MP m Val
forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
    idx <- evalExpr arg
    case container of
      VArray Vector Val
v ->
        case Val
idx of
          VInteger Integer
i ->
            let i' :: Int
i' = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i
            in case Vector Val
v Vector Val -> Int -> Maybe Val
forall a. Vector a -> Int -> Maybe a
V.!? Int
i' of
                 Maybe Val
Nothing | Bool -> Bool
not Bool
allowNewIndices
                     -> FilePath -> ParsecT [Markup] (EvalState m) m ()
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> ParsecT [Markup] (EvalState m) m ())
-> FilePath -> ParsecT [Markup] (EvalState m) m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Vector does not contain index " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a. Show a => a -> FilePath
show Int
i'
                 Maybe Val
_ -> Expr -> Val -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *). Monad m => Expr -> Val -> MP m ()
updateExpression Expr
e (Val -> ParsecT [Markup] (EvalState m) m ())
-> Val -> ParsecT [Markup] (EvalState m) m ()
forall a b. (a -> b) -> a -> b
$ Vector Val -> Val
VArray (Vector Val -> Val) -> Vector Val -> Val
forall a b. (a -> b) -> a -> b
$ Vector Val
v Vector Val -> [(Int, Val)] -> Vector Val
forall a. Vector a -> [(Int, a)] -> Vector a
V.// [(Int
i', Val
val)]
          Val
_ -> FilePath -> ParsecT [Markup] (EvalState m) m ()
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> ParsecT [Markup] (EvalState m) m ())
-> FilePath -> ParsecT [Markup] (EvalState m) m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Cannot index array with " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
idx
      VDict OMap Identifier Val
d ->
        case Val
idx of
          VString Text
fld ->
            case Identifier -> OMap Identifier Val -> Maybe Val
forall k v. Ord k => k -> OMap k v -> Maybe v
OM.lookup (Text -> Identifier
Identifier Text
fld) OMap Identifier Val
d of
              Maybe Val
Nothing | Bool -> Bool
not Bool
allowNewIndices
                     -> FilePath -> ParsecT [Markup] (EvalState m) m ()
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> ParsecT [Markup] (EvalState m) m ())
-> FilePath -> ParsecT [Markup] (EvalState m) m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Dictionary does not contain key " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
forall a. Show a => a -> FilePath
show Text
fld
              Maybe Val
_ -> Expr -> Val -> ParsecT [Markup] (EvalState m) m ()
forall (m :: * -> *). Monad m => Expr -> Val -> MP m ()
updateExpression Expr
e (Val -> ParsecT [Markup] (EvalState m) m ())
-> Val -> ParsecT [Markup] (EvalState m) m ()
forall a b. (a -> b) -> a -> b
$
                           OMap Identifier Val -> Val
VDict (OMap Identifier Val -> Val) -> OMap Identifier Val -> Val
forall a b. (a -> b) -> a -> b
$
                             (Maybe Val -> Maybe Val)
-> Identifier -> OMap Identifier Val -> OMap Identifier Val
forall k v.
Ord k =>
(Maybe v -> Maybe v) -> k -> OMap k v -> OMap k v
OM.alter
                               ( \case
                                   Just Val
_ -> Val -> Maybe Val
forall a. a -> Maybe a
Just Val
val
                                   Maybe Val
Nothing -> Val -> Maybe Val
forall a. a -> Maybe a
Just Val
val
                               )
                               (Text -> Identifier
Identifier Text
fld)
                               OMap Identifier Val
d
          Val
_ -> FilePath -> ParsecT [Markup] (EvalState m) m ()
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> ParsecT [Markup] (EvalState m) m ())
-> FilePath -> ParsecT [Markup] (EvalState m) m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Cannot index dictionary with " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
idx
      Val
_ -> FilePath -> ParsecT [Markup] (EvalState m) m ()
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> ParsecT [Markup] (EvalState m) m ())
-> FilePath -> ParsecT [Markup] (EvalState m) m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Cannot update expression " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Expr -> FilePath
forall a. Show a => a -> FilePath
show Expr
e


toSelector :: Monad m => Val -> MP m Selector
toSelector :: forall (m :: * -> *). Monad m => Val -> MP m Selector
toSelector (VSelector Selector
s) = Selector -> ParsecT [Markup] (EvalState m) m Selector
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Selector
s
toSelector (VFunction (Just Identifier
name) Map Identifier Val
_ Function
_) = Selector -> ParsecT [Markup] (EvalState m) m Selector
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Selector -> ParsecT [Markup] (EvalState m) m Selector)
-> Selector -> ParsecT [Markup] (EvalState m) m Selector
forall a b. (a -> b) -> a -> b
$ Identifier -> [(Identifier, Val)] -> Selector
SelectElement Identifier
name []
toSelector (VString Text
t) = Selector -> ParsecT [Markup] (EvalState m) m Selector
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Selector -> ParsecT [Markup] (EvalState m) m Selector)
-> Selector -> ParsecT [Markup] (EvalState m) m Selector
forall a b. (a -> b) -> a -> b
$ Text -> Selector
SelectString Text
t
toSelector (VRegex RE
re) = Selector -> ParsecT [Markup] (EvalState m) m Selector
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Selector -> ParsecT [Markup] (EvalState m) m Selector)
-> Selector -> ParsecT [Markup] (EvalState m) m Selector
forall a b. (a -> b) -> a -> b
$ RE -> Selector
SelectRegex RE
re
toSelector (VLabel Text
t) = Selector -> ParsecT [Markup] (EvalState m) m Selector
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Selector -> ParsecT [Markup] (EvalState m) m Selector)
-> Selector -> ParsecT [Markup] (EvalState m) m Selector
forall a b. (a -> b) -> a -> b
$ Text -> Selector
SelectLabel Text
t
toSelector (VSymbol (Symbol Text
t Bool
_ [(Set Text, Text)]
_)) = Selector -> ParsecT [Markup] (EvalState m) m Selector
forall a. a -> ParsecT [Markup] (EvalState m) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Selector -> ParsecT [Markup] (EvalState m) m Selector)
-> Selector -> ParsecT [Markup] (EvalState m) m Selector
forall a b. (a -> b) -> a -> b
$ Text -> Selector
SelectString Text
t
toSelector Val
v = FilePath -> ParsecT [Markup] (EvalState m) m Selector
forall a. FilePath -> ParsecT [Markup] (EvalState m) m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> ParsecT [Markup] (EvalState m) m Selector)
-> FilePath -> ParsecT [Markup] (EvalState m) m Selector
forall a b. (a -> b) -> a -> b
$ FilePath
"could not convert " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Val -> FilePath
forall a. Show a => a -> FilePath
show Val
v FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" to selector"