{-# 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 qualified Data.ByteString as BS
import Data.List (intersperse, sortOn)
import qualified Data.Map as M
import qualified Data.Map.Ordered as OM
import Data.Maybe (isJust)
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.Vector as V
import System.FilePath (replaceFileName, takeBaseName)
import Text.Parsec
import Typst.Bind (destructuringBind)
import Typst.Methods (getMethod)
import Typst.Module.Standard (loadFileText, standardModule)
import Typst.Parse (parseTypst)
import Typst.Regex (match)
import Typst.Show (applyShowRules)
import Typst.Syntax
import Typst.Types
import Typst.Util (makeFunction, nthArg)

-- import Debug.Trace

-- | Evaluate a parsed typst expression, evaluating the code and
-- replacing it with content.
evaluateTypst ::
  Monad m =>
  -- | Function to read a file
  (FilePath -> m BS.ByteString) ->
  -- | Path of parsed content
  FilePath ->
  -- | Markup produced by 'parseTypst'
  [Markup] ->
  m (Either ParseError (Seq Content))
evaluateTypst :: forall (m :: * -> *).
Monad m =>
(FilePath -> m ByteString)
-> FilePath -> [Markup] -> m (Either ParseError (Seq Content))
evaluateTypst FilePath -> m ByteString
loadBytes =
  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> u -> FilePath -> s -> m (Either ParseError a)
runParserT
    (forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall (m :: * -> *). Monad m => MP m (Seq Content)
pContent forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)
    forall (m :: * -> *). EvalState m
initialEvalState {evalLoadBytes :: FilePath -> m ByteString
evalLoadBytes = FilePath -> m ByteString
loadBytes}

initialEvalState :: EvalState m
initialEvalState :: forall (m :: * -> *). EvalState m
initialEvalState =
  forall (m :: * -> *). EvalState m
emptyEvalState { evalIdentifiers :: [(Scope, Map Identifier Val)]
evalIdentifiers = [(Scope
BlockScope, Map Identifier Val
standardModule')] }
  where
    standardModule' :: Map Identifier Val
standardModule' = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Identifier
"eval" Val
evalFunction Map Identifier Val
standardModule
    evalFunction :: Val
evalFunction = (forall (m' :: * -> *). Monad m' => ReaderT Arguments (MP m') Val)
-> Val
makeFunction forall a b. (a -> b) -> a -> b
$ do
      Text
code :: Text <- forall (m :: * -> *) a.
(Monad m, FromVal a) =>
Int -> ReaderT Arguments (MP m) a
nthArg Int
1
      case FilePath -> Text -> Either ParseError [Markup]
parseTypst FilePath
"eval" (Text
"#{\n" forall a. Semigroup a => a -> a -> a
<> Text
code forall a. Semigroup a => a -> a -> a
<> Text
"\n}") of
        Left ParseError
e -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"eval: " forall a. Semigroup a => a -> a -> a
<> 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 forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> u -> FilePath -> s -> m (Either ParseError a)
runParserT (forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
expr) forall (m :: * -> *). EvalState m
initialEvalState FilePath
"eval" [] of
            Failure FilePath
e -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"eval: " forall a. Semigroup a => a -> a -> a
<> FilePath
e
            Success (Left ParseError
e) -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"eval: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show ParseError
e
            Success (Right Val
val) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
val
        Right [Markup]
_ -> 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 = 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 forall a. Show a => a -> FilePath
show 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 = forall a. a -> Maybe a
Just Markup
x
    match' Markup
_ = forall a. Maybe a
Nothing

pContent :: Monad m => MP m (Seq Content)
pContent :: forall (m :: * -> *). Monad m => MP m (Seq Content)
pContent = (forall (m :: * -> *). Monad m => MP m (Seq Content)
pTxt forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *). Monad m => MP m (Seq Content)
pElt) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *). Monad m => Seq Content -> MP m (Seq Content)
applyShowRules forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *). Monad m => Seq Content -> MP m (Seq Content)
addTextElement

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

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

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

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

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

pInnerContents :: Monad m => [Markup] -> MP m (Seq Content)
pInnerContents :: forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Markup]
ms = do
  [Markup]
oldInput <- forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
  SourcePos
oldPos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  [ShowRule]
oldShowRules <- forall (m :: * -> *). EvalState m -> [ShowRule]
evalShowRules forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
setInput [Markup]
ms
  Seq Content
result <- forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall (m :: * -> *). Monad m => MP m (Seq Content)
pContent forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)
  forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
setInput [Markup]
oldInput
  forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition SourcePos
oldPos
  forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \EvalState m
st -> EvalState m
st {evalShowRules :: [ShowRule]
evalShowRules = [ShowRule]
oldShowRules}
  forall (f :: * -> *) a. Applicative f => a -> f a
pure Seq Content
result

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

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

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

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

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

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

pListItem :: Monad m => MP m (Seq Content)
pListItem :: forall (m :: * -> *). Monad m => MP m (Seq Content)
pListItem = do
  Markup
tok <- forall (m :: * -> *). Monad m => (Markup -> Bool) -> MP m Markup
satisfyTok Markup -> Bool
isBulletListItem
  case Markup
tok of
    BulletListItem [Markup]
ms -> forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Markup]
ms forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (forall (m :: * -> *). Monad m => (Markup -> Bool) -> MP m Markup
satisfyTok Markup -> Bool
isBreak)
    Markup
_ -> 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 =
  forall a. a -> Seq a
Seq.singleton forall a b. (a -> b) -> a -> b
$
    Identifier -> Maybe SourcePos -> Map Identifier Val -> Content
Elt
      Identifier
"math.lr"
      forall a. Maybe a
Nothing
      [ ( Identifier
"body",
          Vector Val -> Val
VArray forall a b. (a -> b) -> a -> b
$
            forall a. [a] -> Vector a
V.fromList
              [Seq Content -> Val
VContent forall a b. (a -> b) -> a -> b
$ Text -> Content
Txt Text
op forall a. a -> Seq a -> Seq a
Seq.<| (Seq Content
cs 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 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 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
expr

evalExpr :: Monad m => Expr -> MP m Val
evalExpr :: forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
expr =
  case Expr
expr of
    Literal Literal
lit -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Literal -> Val
evalLiteral Literal
lit
    Group Expr
e -> forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
    Block (Content [Markup]
ms) -> Seq Content -> Val
VContent forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Markup]
ms
    Block (CodeBlock [Expr]
exprs) ->
      forall (m :: * -> *) a. Monad m => Scope -> MP m a -> MP m a
inBlock Scope
BlockScope forall a b. (a -> b) -> a -> b
$
        -- let, etc. inside block are isolated
        -- we concat the results inside the block
        forall a b. (a, b) -> a
fst
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val
result, Bool
finished)
                  else do
                    forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \EvalState m
st -> EvalState m
st {evalFlowDirective :: FlowDirective
evalFlowDirective = FlowDirective
FlowNormal}
                    Val
val <- forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
                    FlowDirective
flow <- forall (m :: * -> *). EvalState m -> FlowDirective
evalFlowDirective forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
                    case FlowDirective
flow of
                      FlowDirective
FlowNormal -> do
                        Val
combined <- forall (m :: * -> *). MonadFail m => Val -> Val -> m Val
joinVals Val
result Val
val
                        forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val
combined, Bool
False)
                      FlowDirective
FlowContinue -> do
                        Val
combined <- forall (m :: * -> *). MonadFail m => Val -> Val -> m Val
joinVals Val
result Val
val
                        forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val
combined, Bool
True)
                      FlowDirective
FlowBreak -> do
                        Val
combined <- forall (m :: * -> *). MonadFail m => Val -> Val -> m Val
joinVals Val
result Val
val
                        forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val
combined, Bool
True)
                      FlowReturn Bool
True -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val
val, Bool
True)
                      FlowReturn Bool
False -> do
                        Val
combined <- forall (m :: * -> *). MonadFail m => Val -> Val -> m Val
joinVals Val
result Val
val
                        forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val
combined, Bool
True)
            )
            (Val
VNone, Bool
False)
            [Expr]
exprs
    Array [Expr]
e -> Vector Val -> Val
VArray forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
V.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr [Expr]
e
    Dict [(Identifier, Expr)]
items ->
      OMap Identifier Val -> Val
VDict
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM
          ( \OMap Identifier Val
m (Identifier
k, Expr
e) -> do
              Val
val <- forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
              forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ OMap Identifier Val
m forall k v. Ord k => OMap k v -> (k, v) -> OMap k v
OM.|> (Identifier
k, Val
val)
          )
          forall k v. OMap k v
OM.empty
          [(Identifier, Expr)]
items
    Not Expr
e -> do
      Val
val <- forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
      case Val
val of
        VBoolean Bool
b -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean (Bool -> Bool
not Bool
b)
        Val
_ -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"Cannot apply 'not' to " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Val
val
    And Expr
e1 Expr
e2 -> do
      Val
val1 <- forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
      case Val
val1 of
        VBoolean Bool
False -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
False
        VBoolean Bool
True -> do
          Val
val2 <- forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e2
          case Val
val2 of
            VBoolean Bool
True -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
True
            VBoolean Bool
False -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
False
            Val
_ -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"Cannot apply 'and' to " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Val
val1
        Val
_ -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"Cannot apply 'and' to " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Val
val1
    Or Expr
e1 Expr
e2 -> do
      Val
val1 <- forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
      case Val
val1 of
        VBoolean Bool
True -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
True
        VBoolean Bool
False -> do
          Val
val2 <- forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e2
          case Val
val2 of
            VBoolean Bool
True -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
True
            VBoolean Bool
False -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
False
            Val
_ -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"Cannot apply 'or' to " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Val
val1
        Val
_ -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"Cannot apply 'or' to " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Val
val1
    Ident Identifier
ident -> forall (m :: * -> *). Monad m => Identifier -> MP m Val
lookupIdentifier Identifier
ident
    Let Bind
bind Expr
e -> do
      Val
val <- forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
      case Bind
bind of
        BasicBind (Just Identifier
ident) -> forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ()
addIdentifier Identifier
ident Val
val
        BasicBind Maybe Identifier
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        DestructuringBind [BindPart]
parts -> forall (m :: * -> *).
Monad m =>
(forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ())
-> [BindPart] -> Val -> MP m ()
destructuringBind forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ()
addIdentifier [BindPart]
parts Val
val
      forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
VNone
    LetFunc Identifier
name [Param]
params Expr
e -> do
      Val
val <- forall (m :: * -> *).
Monad m =>
Maybe Identifier -> [Param] -> Expr -> MP m Val
toFunction (forall a. a -> Maybe a
Just Identifier
name) [Param]
params Expr
e
      forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ()
addIdentifier Identifier
name Val
val
      forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
VNone
    FieldAccess (Ident (Identifier Text
fld)) Expr
e -> do
      Val
val <- forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
      forall (m :: * -> *).
MonadFail m =>
(forall (n :: * -> *). Monad n => Val -> MP n ())
-> Val -> Text -> m Val
getMethod (forall (m :: * -> *). Monad m => Expr -> Val -> MP m ()
updateExpression Expr
e) Val
val Text
fld
        forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> case Val
val of
          VSymbol (Symbol Text
_ Bool
accent [(Set Text, Text)]
variants) -> do
            let variants' :: [(Set Text, Text)]
variants' =
                  forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (forall a. Set a -> Int
Set.size forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$
                    forall a. (a -> Bool) -> [a] -> [a]
filter (\(Set Text
var, Text
_) -> Text
fld forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
var) [(Set Text, Text)]
variants
            case [(Set Text, Text)]
variants' of
              [] -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"Symbol does not have variant " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Text
fld
              ((Set Text
_, Text
s) : [(Set Text, Text)]
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Symbol -> Val
VSymbol 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 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
x
              Maybe Val
Nothing -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"Module does not contain " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Text
fld
          VFunction Maybe Identifier
_ Map Identifier Val
m Function
_ ->
            case 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
x
              Maybe Val
Nothing -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"Function scope does not contain " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Text
fld
          VDict OMap Identifier Val
m ->
            case 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
x
              Maybe Val
Nothing -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> FilePath
show (Text -> Identifier
Identifier Text
fld) forall a. Semigroup a => a -> a -> a
<> FilePath
" not found"
          Val
_ -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"FieldAccess requires a dictionary"
    FieldAccess Expr
_ Expr
_ -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"FieldAccess requires an identifier"
    FuncCall Expr
e [Arg]
args -> do
      forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \EvalState m
st -> EvalState m
st {evalFlowDirective :: FlowDirective
evalFlowDirective = FlowDirective
FlowNormal}
      Val
val <- forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
      Bool
mathMode <- forall (m :: * -> *). EvalState m -> Bool
evalMath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
      case Val
val of
        VFunction (Just Identifier
i) Map Identifier Val
_ (Function forall (m :: * -> *). Monad m => Arguments -> MP m Val
f) -> do
          Arguments
arguments <- forall (m :: * -> *). Monad m => [Arg] -> MP m Arguments
toArguments [Arg]
args
          forall (m :: * -> *).
Monad m =>
Identifier -> Function -> Arguments -> MP m Val
applyElementFunction Identifier
i ((forall (m :: * -> *). Monad m => Arguments -> MP m Val)
-> Function
Function forall (m :: * -> *). Monad m => Arguments -> MP m Val
f) Arguments
arguments
        VFunction Maybe Identifier
Nothing Map Identifier Val
_ (Function forall (m :: * -> *). Monad m => Arguments -> MP m Val
f) -> forall (m :: * -> *). Monad m => [Arg] -> MP m Arguments
toArguments [Arg]
args forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *). Monad m => Arguments -> MP m Val
f
        VSymbol (Symbol Text
_ Bool
True [(Set Text, Text)]
_) | Bool
mathMode ->
          do
            Val
val' <- forall (m :: * -> *). Monad m => Identifier -> MP m Val
lookupIdentifier Identifier
"accent"
            case Val
val' of
              VFunction Maybe Identifier
_ Map Identifier Val
_ (Function forall (m :: * -> *). Monad m => Arguments -> MP m Val
f) ->
                forall (m :: * -> *). Monad m => [Arg] -> MP m Arguments
toArguments [Arg]
args
                  forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *). Monad m => Arguments -> MP m Val
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Arguments
a -> Arguments
a {positional :: [Val]
positional = Arguments -> [Val]
positional Arguments
a forall a. [a] -> [a] -> [a]
++ [Val
val]})
              Val
_ -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"accent not defined"
        Val
_
          | Bool
mathMode -> do
              Arguments
args' <- forall (m :: * -> *). Monad m => [Arg] -> MP m Arguments
toArguments [Arg]
args
              forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
                Seq Content -> Val
VContent forall a b. (a -> b) -> a -> b
$
                  Val -> Seq Content
valToContent Val
val
                    forall a. Semigroup a => a -> a -> a
<> Content -> Seq Content
single Content
"("
                    forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat
                      ( forall a. a -> [a] -> [a]
intersperse
                          (Content -> Seq Content
single Content
",")
                          (forall a b. (a -> b) -> [a] -> [b]
map Val -> Seq Content
valToContent (Arguments -> [Val]
positional Arguments
args'))
                      )
                    forall a. Semigroup a => a -> a -> a
<> Content -> Seq Content
single Content
")"
          | Bool
otherwise -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Attempt to call a non-function"
    FuncExpr [Param]
params Expr
e -> forall (m :: * -> *).
Monad m =>
Maybe Identifier -> [Param] -> Expr -> MP m Val
toFunction forall a. Maybe a
Nothing [Param]
params Expr
e
    Equals Expr
e1 Expr
e2 -> do
      Val
v1 <- forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
      Val
v2 <- forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e2
      case forall a. Compare a => a -> a -> Maybe Ordering
comp Val
v1 Val
v2 of
        Just Ordering
EQ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
True
        Maybe Ordering
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
False
    LessThan Expr
e1 Expr
e2 -> do
      Val
v1 <- forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
      Val
v2 <- forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e2
      case forall a. Compare a => a -> a -> Maybe Ordering
comp Val
v1 Val
v2 of
        Maybe Ordering
Nothing -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"Can't compare " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Val
v1 forall a. Semigroup a => a -> a -> a
<> FilePath
" and " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Val
v2
        Just Ordering
LT -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
True
        Maybe Ordering
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
False
    GreaterThan Expr
e1 Expr
e2 -> do
      Val
v1 <- forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
      Val
v2 <- forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e2
      case forall a. Compare a => a -> a -> Maybe Ordering
comp Val
v1 Val
v2 of
        Maybe Ordering
Nothing -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"Can't compare " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Val
v1 forall a. Semigroup a => a -> a -> a
<> FilePath
" and " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Val
v2
        Just Ordering
GT -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
True
        Maybe Ordering
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
False
    LessThanOrEqual Expr
e1 Expr
e2 -> do
      Val
v1 <- forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
      Val
v2 <- forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e2
      case forall a. Compare a => a -> a -> Maybe Ordering
comp Val
v1 Val
v2 of
        Maybe Ordering
Nothing -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"Can't compare " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Expr
e1 forall a. Semigroup a => a -> a -> a
<> FilePath
" and " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Expr
e2
        Just Ordering
LT -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
True
        Just Ordering
EQ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
True
        Maybe Ordering
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
False
    GreaterThanOrEqual Expr
e1 Expr
e2 -> do
      Val
v1 <- forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
      Val
v2 <- forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e2
      case forall a. Compare a => a -> a -> Maybe Ordering
comp Val
v1 Val
v2 of
        Maybe Ordering
Nothing -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"Can't compare " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Val
v1 forall a. Semigroup a => a -> a -> a
<> FilePath
" and " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Val
v2
        Just Ordering
GT -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
True
        Just Ordering
EQ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
True
        Maybe Ordering
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
False
    InCollection Expr
e1 Expr
e2 -> do
      Val
v1 <- forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
      Val
v2 <- forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e2
      case Val
v2 of
        VString Text
t ->
          case Val
v1 of
            VString Text
t' -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean forall a b. (a -> b) -> a -> b
$ Text
t' Text -> Text -> Bool
`T.isInfixOf` Text
t
            VRegex RE
re -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean forall a b. (a -> b) -> a -> b
$ forall source target.
RegexContext Regex source target =>
RE -> source -> target
match RE
re Text
t
            Val
_ -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"Can't apply 'in' to " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Val
v1 forall a. Semigroup a => a -> a -> a
<> FilePath
" and string"
        VArray Vector Val
vec -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean forall a b. (a -> b) -> a -> b
$ 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean forall a b. (a -> b) -> a -> b
$ forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ forall k v. Ord k => k -> OMap k v -> Maybe v
OM.lookup (Text -> Identifier
Identifier Text
t) OMap Identifier Val
m
            Val
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> Val
VBoolean Bool
False
        Val
_ -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"Can't apply 'in' to " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Val
v2
    Negated Expr
e -> do
      Val
v <- forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
      case forall a. Negatable a => a -> Maybe a
maybeNegate Val
v of
        Maybe Val
Nothing -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"Can't negate " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Val
v
        Just Val
v' -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
v'
    ToPower Expr
e1 Expr
e2 -> do
      Val
e <- forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
      Val
b <- forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e2
      case (Val
b, Val
e) of
        (VInteger Integer
i, VInteger Integer
j) ->
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
            Integer -> Val
VInteger forall a b. (a -> b) -> a -> b
$
              forall a b. (RealFrac a, Integral b) => a -> b
floor ((forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i :: Double) forall a. Floating a => a -> a -> a
** (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
j :: Double))
        (VInteger Integer
i, VRatio Rational
j) ->
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
            Double -> Val
VFloat ((forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i :: Double) forall a. Floating a => a -> a -> a
** (forall a. Fractional a => Rational -> a
fromRational Rational
j :: Double))
        (VRatio Rational
i, VInteger Integer
j) ->
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
            Double -> Val
VFloat (forall a. Fractional a => Rational -> a
fromRational Rational
i forall a. Floating a => a -> a -> a
** (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
j :: Double))
        (VRatio Rational
i, VRatio Rational
j) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Double -> Val
VFloat (forall a. Fractional a => Rational -> a
fromRational Rational
i forall a. Floating a => a -> a -> a
** forall a. Fractional a => Rational -> a
fromRational Rational
j)
        (VFloat Double
i, VInteger Integer
j) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Double -> Val
VFloat (Double
i forall a. Floating a => a -> a -> a
** (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
j :: Double))
        (VFloat Double
i, VFloat Double
j) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Double -> Val
VFloat (Double
i forall a. Floating a => a -> a -> a
** Double
j)
        (VInteger Integer
i, VFloat Double
j) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Double -> Val
VFloat ((forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i :: Double) forall a. Floating a => a -> a -> a
** Double
j)
        (VFloat Double
i, VRatio Rational
j) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Double -> Val
VFloat (Double
i forall a. Floating a => a -> a -> a
** forall a. Fractional a => Rational -> a
fromRational Rational
j)
        (Val, Val)
_ -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"Can't exponentiate " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Val
b forall a. Semigroup a => a -> a -> a
<> FilePath
" to " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Val
e
    Plus Expr
e1 Expr
e2 -> do
      Val
v1 <- forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
      Val
v2 <- forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e2
      case (Val
v1, Val
v2) of
        (VAlignment Maybe Horiz
x1 Maybe Vert
y1, VAlignment Maybe Horiz
x2 Maybe Vert
y2) ->
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Maybe Horiz -> Maybe Vert -> Val
VAlignment (Maybe Horiz
x1 forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe Horiz
x2) (Maybe Vert
y1 forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe Vert
y2)
        (Val, Val)
_ -> case forall a. Summable a => a -> a -> Maybe a
maybePlus Val
v1 Val
v2 of
          Maybe Val
Nothing -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"Can't + " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Val
v1 forall a. Semigroup a => a -> a -> a
<> FilePath
" and " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Val
v2
          Just Val
v -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
v
    Minus Expr
e1 Expr
e2 -> do
      Val
v1 <- forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
      Val
v2 <- forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e2
      case forall a. Summable a => a -> a -> Maybe a
maybeMinus Val
v1 Val
v2 of
        Maybe Val
Nothing -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"Can't - " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Val
v1 forall a. Semigroup a => a -> a -> a
<> FilePath
" and " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Val
v2
        Just Val
v -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
v
    Times Expr
e1 Expr
e2 -> do
      Val
v1 <- forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
      Val
v2 <- forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e2
      case forall a. Multipliable a => a -> a -> Maybe a
maybeTimes Val
v1 Val
v2 of
        Maybe Val
Nothing -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"Can't * " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Val
v1 forall a. Semigroup a => a -> a -> a
<> FilePath
" and " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Val
v2
        Just Val
v -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
v
    Divided Expr
e1 Expr
e2 -> do
      Val
v1 <- forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
      Val
v2 <- forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e2
      case forall a. Multipliable a => a -> a -> Maybe a
maybeDividedBy Val
v1 Val
v2 of
        Maybe Val
Nothing -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"Can't / " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Val
v1 forall a. Semigroup a => a -> a -> a
<> FilePath
" and " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Val
v2
        Just Val
v -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
v
    Set Expr
e [Arg]
args -> do
      Val
v <- forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
      Arguments
as' <- forall (m :: * -> *). Monad m => [Arg] -> MP m Arguments
toArguments [Arg]
args
      case Val
v of
        VFunction (Just Identifier
name) Map Identifier Val
_ Function
_ ->
          forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \EvalState m
st ->
            EvalState m
st
              { evalStyles :: Map Identifier Arguments
evalStyles =
                  forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter
                    ( \case
                        Maybe Arguments
Nothing -> forall a. a -> Maybe a
Just Arguments
as'
                        Just Arguments
as'' -> forall a. a -> Maybe a
Just (Arguments
as'' forall a. Semigroup a => a -> a -> a
<> Arguments
as')
                    )
                    Identifier
name
                    forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). EvalState m -> Map Identifier Arguments
evalStyles EvalState m
st
              }
        Val
_ -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"Set expects an element name"
      forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
VNone
    Show Maybe Expr
mbSelExpr Expr
e -> do
      Val
renderVal <- forall (m :: * -> *) a. Monad m => Scope -> MP m a -> MP m a
inBlock Scope
FunctionScope forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
      case Maybe Expr
mbSelExpr of
        Maybe Expr
Nothing -> do
          Seq Content
rest <- forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall (m :: * -> *). Monad m => MP m (Seq Content)
pContent forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)
          case Val
renderVal of
            VFunction Maybe Identifier
_ Map Identifier Val
_ (Function forall (m :: * -> *). Monad m => Arguments -> MP m Val
f) ->
              Seq Content -> Val
VContent forall b c a. (b -> c) -> (a -> b) -> a -> c
. Val -> Seq Content
valToContent
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = forall k v. OMap k v
OM.empty}
            Val
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Seq Content -> Val
VContent forall a b. (a -> b) -> a -> b
$ Val -> Seq Content
valToContent Val
renderVal
        Just Expr
selExpr -> do
          Selector
selector <- forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
selExpr forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *). Monad m => Val -> MP m Selector
toSelector
          case Val
renderVal of
            VFunction Maybe Identifier
_ Map Identifier Val
_ (Function forall (m :: * -> *). Monad m => Arguments -> MP m Val
f) ->
              forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \EvalState m
st ->
                EvalState m
st
                  { evalShowRules :: [ShowRule]
evalShowRules =
                      Selector
-> (forall (m :: * -> *). Monad m => Content -> MP m (Seq Content))
-> ShowRule
ShowRule
                        Selector
selector
                        ( \Content
c ->
                            Val -> Seq Content
valToContent
                              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Monad m => Arguments -> MP m Val
f
                                Arguments
                                  { positional :: [Val]
positional = [Seq Content -> Val
VContent (forall a. a -> Seq a
Seq.singleton Content
c)],
                                    named :: OMap Identifier Val
named = forall k v. OMap k v
OM.empty
                                  }
                        )
                        forall a. a -> [a] -> [a]
: forall (m :: * -> *). EvalState m -> [ShowRule]
evalShowRules EvalState m
st
                  }
            Val
_ -> forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \EvalState m
st ->
              EvalState m
st
                { evalShowRules :: [ShowRule]
evalShowRules =
                    Selector
-> (forall (m :: * -> *). Monad m => Content -> MP m (Seq Content))
-> ShowRule
ShowRule
                      Selector
selector
                      ( \Content
c ->
                          case Expr
e of
                            -- ignore show set for now TODO
                            Set Expr
_ [Arg]
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Seq a
Seq.singleton Content
c
                            Expr
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Val -> Seq Content
valToContent Val
renderVal)
                      )
                      forall a. a -> [a] -> [a]
: forall (m :: * -> *). EvalState m -> [ShowRule]
evalShowRules EvalState m
st
                }
          forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
VNone
    Binding Bind
_ -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"Encountered binding out of proper context"
    Assign Expr
e1 Expr
e2 -> do
      Val
val <- forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e2
      case Expr
e1 of
        Binding (BasicBind (Just Identifier
ident)) -> forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ()
updateIdentifier Identifier
ident Val
val
        Binding (BasicBind Maybe Identifier
Nothing) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Binding (DestructuringBind [BindPart]
parts) ->
          forall (m :: * -> *).
Monad m =>
(forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ())
-> [BindPart] -> Val -> MP m ()
destructuringBind forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ()
updateIdentifier [BindPart]
parts Val
val
        Expr
x -> forall (m :: * -> *). Monad m => Expr -> Val -> MP m ()
updateExpression Expr
x Val
val
      forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
VNone
    If [(Expr, Expr)]
clauses -> do
      let go :: [(Expr, Expr)] -> ParsecT [Markup] (EvalState m) m Val
go [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
VNone
          go ((Expr
cond, Expr
e) : [(Expr, Expr)]
rest) = do
            Val
val <- forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
cond
            case Val
val of
              VBoolean Bool
True -> 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
_ -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"If requires a boolean condition"
      forall {m :: * -> *}.
Monad m =>
[(Expr, Expr)] -> ParsecT [Markup] (EvalState m) m Val
go [(Expr, Expr)]
clauses
    While Expr
e1 Expr
e2 -> do
      let go :: Val -> ParsecT [Markup] (EvalState m) m Val
go Val
result = do
            Val
condval <- forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
            case Val
condval of
              VBoolean Bool
True -> do
                Val
val <- forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e2
                Bool
hadBreak <- (forall a. Eq a => a -> a -> Bool
== FlowDirective
FlowBreak) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). EvalState m -> FlowDirective
evalFlowDirective forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
                forall (m :: * -> *). MonadFail m => Val -> Val -> m Val
joinVals Val
result Val
val forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= if Bool
hadBreak then forall (f :: * -> *) a. Applicative f => a -> f a
pure else Val -> ParsecT [Markup] (EvalState m) m Val
go
              VBoolean Bool
False -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
result
              Val
_ -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"While loop requires a boolean condition"
      forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \EvalState m
st -> EvalState m
st {evalFlowDirective :: FlowDirective
evalFlowDirective = FlowDirective
FlowNormal}
      forall {m :: * -> *}.
Monad m =>
Val -> ParsecT [Markup] (EvalState m) m Val
go Val
VNone
    For Bind
bind Expr
e1 Expr
e2 -> do
      let go :: [Val] -> Val -> ParsecT [Markup] (EvalState m) m Val
go [] Val
result = 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) -> forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ()
addIdentifier Identifier
ident Val
x
              BasicBind Maybe Identifier
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
              DestructuringBind [BindPart]
parts ->
                forall (m :: * -> *).
Monad m =>
(forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ())
-> [BindPart] -> Val -> MP m ()
destructuringBind forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ()
addIdentifier [BindPart]
parts Val
x
            Val
val <- forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e2
            Bool
hadBreak <- (forall a. Eq a => a -> a -> Bool
== FlowDirective
FlowBreak) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). EvalState m -> FlowDirective
evalFlowDirective forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
            forall (m :: * -> *). MonadFail m => Val -> Val -> m Val
joinVals Val
result Val
val forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= if Bool
hadBreak then forall (f :: * -> *) a. Applicative f => a -> f a
pure else [Val] -> Val -> ParsecT [Markup] (EvalState m) m Val
go [Val]
xs
      Val
source <- forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e1
      [Val]
items <- case Val
source of
        VString Text
t -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Text -> Val
VString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton) (Text -> FilePath
T.unpack Text
t)
        VArray Vector Val
v -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> [a]
V.toList Vector Val
v
        VDict OMap Identifier Val
m ->
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
            forall a b. (a -> b) -> [a] -> [b]
map
              ( \(Identifier Text
k, Val
v) ->
                  Vector Val -> Val
VArray (forall a. [a] -> Vector a
V.fromList [Text -> Val
VString Text
k, Val
v])
              )
              (forall k v. OMap k v -> [(k, v)]
OM.assocs OMap Identifier Val
m)
        Val
_ -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"For expression requires an Array or Dictionary"
      forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \EvalState m
st -> EvalState m
st {evalFlowDirective :: FlowDirective
evalFlowDirective = FlowDirective
FlowNormal}
      forall {m :: * -> *}.
Monad m =>
[Val] -> Val -> ParsecT [Markup] (EvalState m) m Val
go [Val]
items Val
VNone
    Return Maybe Expr
mbe -> do
      -- these flow directives are examined in CodeBlock
      forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState (\EvalState m
st -> EvalState m
st {evalFlowDirective :: FlowDirective
evalFlowDirective = Bool -> FlowDirective
FlowReturn (forall a. Maybe a -> Bool
isJust Maybe Expr
mbe)})
      forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
VNone) forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Maybe Expr
mbe
    Expr
Continue -> do
      forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState (\EvalState m
st -> EvalState m
st {evalFlowDirective :: FlowDirective
evalFlowDirective = FlowDirective
FlowContinue})
      forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
VNone
    Expr
Break -> do
      forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState (\EvalState m
st -> EvalState m
st {evalFlowDirective :: FlowDirective
evalFlowDirective = FlowDirective
FlowBreak})
      forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
VNone
    Label Text
t -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Val
VLabel Text
t
    Import Expr
e Imports
imports -> do
      Val
argval <- forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
      (Identifier
modid, Map Identifier Val
modmap) <-
        case Val
argval of
          VString Text
t -> forall (m :: * -> *).
Monad m =>
Text -> MP m (Identifier, Map Identifier Val)
loadModule Text
t
          VModule Identifier
i Map Identifier Val
m -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Identifier
i, Map Identifier Val
m)
          VFunction (Just Identifier
i) Map Identifier Val
m Function
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Identifier
i, Map Identifier Val
m)
          VFunction Maybe Identifier
Nothing Map Identifier Val
m Function
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Identifier
"anonymous", Map Identifier Val
m)
          Val
_ -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Import requires a path or module or function"
      case Imports
imports of
        Imports
AllIdentifiers -> forall (m :: * -> *). Monad m => Map Identifier Val -> MP m ()
importModule Map Identifier Val
modmap
        SomeIdentifiers [Identifier]
idents -> do
          let addFromModule :: Map Identifier Val -> Identifier -> m (Map Identifier Val)
addFromModule Map Identifier Val
m Identifier
ident =
                case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Identifier
ident Map Identifier Val
modmap of
                  Maybe Val
Nothing -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> FilePath
show Identifier
ident forall a. Semigroup a => a -> a -> a
<> FilePath
" not defined in module"
                  Just Val
v -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Identifier
ident Val
v Map Identifier Val
m
          forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall {m :: * -> *}.
MonadFail m =>
Map Identifier Val -> Identifier -> m (Map Identifier Val)
addFromModule forall a. Monoid a => a
mempty [Identifier]
idents forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *). Monad m => Map Identifier Val -> MP m ()
importModule
        Imports
NoIdentifiers -> forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ()
addIdentifier Identifier
modid (Identifier -> Map Identifier Val -> Val
VModule Identifier
modid Map Identifier Val
modmap)
      forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
VNone
    Include Expr
e -> do
      Val
argval <- forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
      case Val
argval of
        VString Text
t -> forall (m :: * -> *).
Monad m =>
Text -> MP m (Identifier, Map Identifier Val)
loadModule Text
t forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *). Monad m => Map Identifier Val -> MP m ()
importModule forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd
        Val
_ -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Include requires a path"
      forall (f :: * -> *) a. Applicative f => a -> f a
pure Val
VNone

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

loadModule :: Monad m => Text -> MP m (Identifier, M.Map Identifier Val)
loadModule :: forall (m :: * -> *).
Monad m =>
Text -> MP m (Identifier, Map Identifier Val)
loadModule Text
modname = do
  SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  let fp :: FilePath
fp = FilePath -> FilePath -> FilePath
replaceFileName (SourcePos -> FilePath
sourceName SourcePos
pos) (Text -> FilePath
T.unpack Text
modname)
  let modid :: Identifier
modid = Text -> Identifier
Identifier (FilePath -> Text
T.pack forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
takeBaseName FilePath
fp)
  Text
txt <- forall (m :: * -> *). Monad m => FilePath -> MP m Text
loadFileText FilePath
fp
  case FilePath -> Text -> Either ParseError [Markup]
parseTypst FilePath
fp Text
txt of
    Left ParseError
err -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> FilePath
show ParseError
err
    Right [Markup]
ms -> do
      FilePath -> m ByteString
loadBytes <- forall (m :: * -> *). EvalState m -> FilePath -> m ByteString
evalLoadBytes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
      Either ParseError (EvalState m)
res <-
        forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$
          forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> u -> FilePath -> s -> m (Either ParseError a)
runParserT
            ( forall (m :: * -> *) a. Monad m => Scope -> MP m a -> MP m a
inBlock Scope
BlockScope forall a b. (a -> b) -> a -> b
$ -- add new identifiers list
                forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall (m :: * -> *). Monad m => MP m (Seq Content)
pContent forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
            )
            forall (m :: * -> *). EvalState m
initialEvalState {evalLoadBytes :: FilePath -> m ByteString
evalLoadBytes = FilePath -> m ByteString
loadBytes}
            FilePath
fp
            [Markup]
ms
      case Either ParseError (EvalState m)
res of
        Left ParseError
err' -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> FilePath
show ParseError
err'
        Right EvalState m
st ->
          case forall (m :: * -> *). EvalState m -> [(Scope, Map Identifier Val)]
evalIdentifiers EvalState m
st of
            [] -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Empty evalIdentifiers in module!"
            ((Scope
_, Map Identifier Val
m) : [(Scope, Map Identifier Val)]
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (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 = forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \EvalState m
st ->
  EvalState m
st
    { evalIdentifiers :: [(Scope, Map Identifier Val)]
evalIdentifiers =
        case forall (m :: * -> *). EvalState m -> [(Scope, Map Identifier Val)]
evalIdentifiers EvalState m
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 forall a. Semigroup a => a -> a -> a
<> Map Identifier Val
i) 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 (forall a. Real a => a -> Rational
toRational Double
x forall a. Fractional a => a -> a -> a
/ Rational
100)
        Unit
Deg -> Double -> Val
VAngle Double
x
        Unit
Rad -> Double -> Val
VAngle (Double
x forall a. Num a => a -> a -> a
* (Double
180 forall a. Fractional a => a -> a -> a
/ 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 = forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall {m :: * -> *}.
Monad m =>
Arguments -> Arg -> ParsecT [Markup] (EvalState m) m Arguments
addArg ([Val] -> OMap Identifier Val -> Arguments
Arguments forall a. Monoid a => a
mempty forall k v. OMap k v
OM.empty)
  where
    addArg :: Arguments -> Arg -> ParsecT [Markup] (EvalState m) m Arguments
addArg Arguments
args (KeyValArg Identifier
ident Expr
e) = do
      Val
val <- forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Arguments
args {named :: OMap Identifier Val
named = Arguments -> OMap Identifier Val
named Arguments
args forall k v. Ord k => OMap k v -> (k, v) -> OMap k v
OM.|> (Identifier
ident, Val
val)}
    addArg Arguments
args (NormalArg Expr
e) = do
      Val
val <- forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Arguments
args {positional :: [Val]
positional = Arguments -> [Val]
positional Arguments
args forall a. [a] -> [a] -> [a]
++ [Val
val]}
    addArg Arguments
args (ArrayArg [[Markup]]
rows) = do
      let pRow :: [Markup] -> ParsecT [Markup] (EvalState m) m Val
pRow =
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Vector Val -> Val
VArray forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
V.fromList)
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Seq Content -> Val
VContent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
: []))
      [Val]
vals <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Markup] -> ParsecT [Markup] (EvalState m) m Val
pRow [[Markup]]
rows
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Arguments
args {positional :: [Val]
positional = Arguments -> [Val]
positional Arguments
args forall a. [a] -> [a] -> [a]
++ [Val]
vals}
    addArg Arguments
args (SpreadArg Expr
e) = do
      Val
val <- forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e
      case Val
val of
        Val
VNone -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
        VArguments Arguments
args' -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Arguments
args forall a. Semigroup a => a -> a -> a
<> Arguments
args'
        VDict OMap Identifier Val
m ->
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
            Arguments
args
              forall a. Semigroup a => a -> a -> a
<> Arguments {positional :: [Val]
positional = forall a. Monoid a => a
mempty, named :: OMap Identifier Val
named = OMap Identifier Val
m}
        VArray Vector Val
v ->
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
            Arguments
args
              forall a. Semigroup a => a -> a -> a
<> Arguments {positional :: [Val]
positional = forall a. Vector a -> [a]
V.toList Vector Val
v, named :: OMap Identifier Val
named = forall k v. OMap k v
OM.empty}
        Val
_ -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"spread requires an argument value, got " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Val
val
    addArg Arguments
args (BlockArg [Markup]
ms) = do
      Seq Content
val <- forall (m :: * -> *). Monad m => [Markup] -> MP m (Seq Content)
pInnerContents [Markup]
ms
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Arguments
args {positional :: [Val]
positional = Arguments -> [Val]
positional Arguments
args forall a. [a] -> [a] -> [a]
++ [Seq Content -> Val
VContent Seq Content
val]}

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

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

updateExpression :: Monad m => Expr -> Val -> MP m ()
updateExpression :: forall (m :: * -> *). Monad m => Expr -> Val -> MP m ()
updateExpression Expr
e Val
val =
  case Expr
e of
    Ident Identifier
i -> forall (m :: * -> *). Monad m => Identifier -> Val -> MP m ()
updateIdentifier Identifier
i Val
val
    FuncCall
      (FieldAccess (Ident (Identifier Text
"at")) Expr
e')
      [NormalArg (Literal (Int Integer
idx))] ->
        do
          Val
ival <- forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e'
          case Val
ival of
            VArray Vector Val
v ->
              forall (m :: * -> *). Monad m => Expr -> Val -> MP m ()
updateExpression Expr
e' forall a b. (a -> b) -> a -> b
$ Vector Val -> Val
VArray forall a b. (a -> b) -> a -> b
$ Vector Val
v forall a. Vector a -> [(Int, a)] -> Vector a
V.// [(forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
idx, Val
val)]
            Val
_ -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"Cannot update expression " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Expr
e
    FuncCall (FieldAccess (Ident (Identifier Text
"first")) Expr
e') [] ->
      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
    FuncCall (FieldAccess (Ident (Identifier Text
"last")) Expr
e') [] ->
      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
    FuncCall
      (FieldAccess (Ident (Identifier Text
"at")) Expr
e')
      [NormalArg (Literal (String Text
fld))] ->
        do
          Val
ival <- forall (m :: * -> *). Monad m => Expr -> MP m Val
evalExpr Expr
e'
          case Val
ival of
            VDict OMap Identifier Val
d ->
              forall (m :: * -> *). Monad m => Expr -> Val -> MP m ()
updateExpression Expr
e' forall a b. (a -> b) -> a -> b
$
                OMap Identifier Val -> Val
VDict forall a b. (a -> b) -> a -> b
$
                  forall k v.
Ord k =>
(Maybe v -> Maybe v) -> k -> OMap k v -> OMap k v
OM.alter
                    ( \case
                        Just Val
_ -> forall a. a -> Maybe a
Just Val
val
                        Maybe Val
Nothing -> forall a. a -> Maybe a
Just Val
val
                    )
                    (Text -> Identifier
Identifier Text
fld)
                    OMap Identifier Val
d
            Val
_ -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"Cannot update expression " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Expr
e
    FieldAccess (Ident (Identifier Text
fld)) Expr
e' ->
      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 (Text -> Literal
String Text
fld))]
        )
        Val
val
    Expr
_ -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"Cannot update expression " forall a. Semigroup a => a -> a -> a
<> 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) = forall (f :: * -> *) a. Applicative f => a -> f a
pure Selector
s
toSelector (VFunction (Just Identifier
name) Map Identifier Val
_ Function
_) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Identifier -> [(Identifier, Val)] -> Selector
SelectElement Identifier
name []
toSelector (VString Text
t) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Selector
SelectString Text
t
toSelector (VRegex RE
re) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ RE -> Selector
SelectRegex RE
re
toSelector (VLabel Text
t) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Selector
SelectLabel Text
t
toSelector (VSymbol (Symbol Text
t Bool
_ [(Set Text, Text)]
_)) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Selector
SelectString Text
t
toSelector Val
v = forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"could not convert " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Val
v forall a. Semigroup a => a -> a -> a
<> FilePath
" to selector"