{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

module Typst.Parse
  ( parseTypst,
  )
where

import Control.Applicative (some)
import Control.Monad (MonadPlus (mzero), guard, void, when)
import Control.Monad.Identity (Identity)
import Data.Char hiding (Space)
import Data.Maybe (isJust)
import Data.Text (Text)
import qualified Data.Text as T
import Text.Parsec hiding (string)
import qualified Text.Parsec as P
import Text.Parsec.Expr
import Text.Read (readMaybe)
import Typst.Syntax

-- import Debug.Trace

parseTypst :: FilePath -> Text -> Either ParseError [Markup]
parseTypst :: [Char] -> Text -> Either ParseError [Markup]
parseTypst [Char]
fp Text
inp =
  case forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> [Char] -> s -> Either ParseError a
runParser (forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many P Markup
pMarkup forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P ()
pEndOfContent) PState
initialState [Char]
fp Text
inp of
    Left ParseError
e -> forall a b. a -> Either a b
Left ParseError
e
    Right [Markup]
r -> forall a b. b -> Either a b
Right [Markup]
r

data PState = PState
  { PState -> [Int]
stIndent :: [Int],
    PState -> Int
stLineStartCol :: !Int,
    PState -> Int
stAllowNewlines :: !Int, -- allow newlines if > 0
    PState -> Maybe (SourcePos, Text)
stBeforeSpace :: Maybe (SourcePos, Text),
    PState -> Int
stContentBlockNesting :: Int
  }
  deriving (Int -> PState -> ShowS
[PState] -> ShowS
PState -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [PState] -> ShowS
$cshowList :: [PState] -> ShowS
show :: PState -> [Char]
$cshow :: PState -> [Char]
showsPrec :: Int -> PState -> ShowS
$cshowsPrec :: Int -> PState -> ShowS
Show)

initialState :: PState
initialState :: PState
initialState =
  PState
    { stIndent :: [Int]
stIndent = [],
      stLineStartCol :: Int
stLineStartCol = Int
1,
      stAllowNewlines :: Int
stAllowNewlines = Int
0,
      stBeforeSpace :: Maybe (SourcePos, Text)
stBeforeSpace = forall a. Maybe a
Nothing,
      stContentBlockNesting :: Int
stContentBlockNesting = Int
0
    }

type P = Parsec Text PState

string :: String -> P String
string :: [Char] -> P [Char]
string = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
P.string

ws :: P ()
ws :: P ()
ws = do
  SourcePos
p1 <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  Text
inp <- forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
  Int
allowNewlines <- PState -> Int
stAllowNewlines 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 isSp :: Char -> Bool
isSp Char
c
        | Int
allowNewlines forall a. Ord a => a -> a -> Bool
> Int
0 = Char
c forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'\t' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'\n' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'\r'
        | Bool
otherwise = Char
c forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'\t'
  ( forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skipMany1 (forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isSp) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (f :: * -> *) a. Functor f => f a -> f ()
void P Markup
pComment)
      forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState (\PState
st -> PState
st {stBeforeSpace :: Maybe (SourcePos, Text)
stBeforeSpace = forall a. a -> Maybe a
Just (SourcePos
p1, Text
inp)})
    )
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState (\PState
st -> PState
st {stBeforeSpace :: Maybe (SourcePos, Text)
stBeforeSpace = forall a. Maybe a
Nothing})

lexeme :: P a -> P a
lexeme :: forall a. P a -> P a
lexeme P a
pa = P a
pa forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P ()
ws

sym :: String -> P String
sym :: [Char] -> P [Char]
sym = forall a. P a -> P a
lexeme forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> P [Char]
string

op :: String -> P ()
op :: [Char] -> P ()
op [Char]
s = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall a. P a -> P a
lexeme forall a b. (a -> b) -> a -> b
$ do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ [Char] -> P [Char]
string [Char]
s
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
    ( [Char]
s forall a. Eq a => a -> a -> Bool
== [Char]
"+"
        Bool -> Bool -> Bool
|| [Char]
s forall a. Eq a => a -> a -> Bool
== [Char]
"-"
        Bool -> Bool -> Bool
|| [Char]
s forall a. Eq a => a -> a -> Bool
== [Char]
"*"
        Bool -> Bool -> Bool
|| [Char]
s forall a. Eq a => a -> a -> Bool
== [Char]
"/"
        Bool -> Bool -> Bool
|| [Char]
s forall a. Eq a => a -> a -> Bool
== [Char]
"="
        Bool -> Bool -> Bool
|| [Char]
s forall a. Eq a => a -> a -> Bool
== [Char]
"<"
        Bool -> Bool -> Bool
|| [Char]
s forall a. Eq a => a -> a -> Bool
== [Char]
">"
        Bool -> Bool -> Bool
|| [Char]
s forall a. Eq a => a -> a -> Bool
== [Char]
"!"
    )
    forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'=')
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Char]
s forall a. Eq a => a -> a -> Bool
== [Char]
"-") forall a b. (a -> b) -> a -> b
$
    forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'>') -- arrows
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Char]
s forall a. Eq a => a -> a -> Bool
== [Char]
"<") forall a b. (a -> b) -> a -> b
$
    forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-' forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'=') -- arrows
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Char]
s forall a. Eq a => a -> a -> Bool
== [Char]
"=") forall a b. (a -> b) -> a -> b
$
    forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'>' forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'=')

withNewlines :: P a -> P a
withNewlines :: forall a. P a -> P a
withNewlines P a
pa = do
  forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \PState
st -> PState
st {stAllowNewlines :: Int
stAllowNewlines = PState -> Int
stAllowNewlines PState
st forall a. Num a => a -> a -> a
+ Int
1}
  a
res <- P a
pa
  forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \PState
st -> PState
st {stAllowNewlines :: Int
stAllowNewlines = PState -> Int
stAllowNewlines PState
st forall a. Num a => a -> a -> a
- Int
1}
  forall (f :: * -> *) a. Applicative f => a -> f a
pure a
res

inParens :: P a -> P a
inParens :: forall a. P a -> P a
inParens P a
pa = forall a. P a -> P a
withNewlines (forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between ([Char] -> P [Char]
sym [Char]
"(") (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
')') P a
pa) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P ()
ws

inBraces :: P a -> P a
inBraces :: forall a. P a -> P a
inBraces P a
pa = forall a. P a -> P a
withNewlines (forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between ([Char] -> P [Char]
sym [Char]
"{") (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'}') P a
pa) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P ()
ws

pMarkup :: P Markup
pMarkup :: P Markup
pMarkup =
  P Markup
pSpace
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Markup
pHeading
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Markup
pComment
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Markup
pEol
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Markup
pHardbreak
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Markup
pStrong
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Markup
pEmph
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Markup
pEquation
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Markup
pListItem
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Markup
pUrl
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Markup
pText
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Markup
pRawBlock
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Markup
pRawInline
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Markup
pEscaped
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Markup
pNbsp
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Markup
pDash
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Markup
pEllipsis
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Markup
pQuote
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Markup
pLabelInContent
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Markup
pRef
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Markup
pHash
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Markup
pBracketed
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Markup
pSymbol

-- We need to group paired brackets or the closing bracketed may be
-- taken to close a pContent block:
pBracketed :: P Markup
pBracketed :: P Markup
pBracketed =
  [Markup] -> Markup
Bracketed 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
try (forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'[') (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']') (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many P Markup
pMarkup))

pSymbol :: P Markup
pSymbol :: P Markup
pSymbol = do
  Int
blockNesting <- PState -> Int
stContentBlockNesting 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 isSpecial' :: Char -> Bool
isSpecial' Char
c = Char -> Bool
isSpecial Char
c Bool -> Bool -> Bool
&& (Char
c forall a. Eq a => a -> a -> Bool
/= Char
']' Bool -> Bool -> Bool
|| Int
blockNesting forall a. Eq a => a -> a -> Bool
== Int
0)
  Text -> Markup
Text forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isSpecial'

-- equation ::= ('$' math* '$') | ('$ ' math* ' $')
pEquation :: P Markup
pEquation :: P Markup
pEquation = do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'$'
  forall a. P a -> P a
withNewlines forall a b. (a -> b) -> a -> b
$ do
    Bool
display <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Bool
False forall a b. (a -> b) -> a -> b
$ Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
    P ()
ws
    [Markup]
maths <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many P Markup
pMath
    forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'$'
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> [Markup] -> Markup
Equation Bool
display [Markup]
maths

mathOperatorTable :: [[Operator Text PState Identity Markup]]
mathOperatorTable :: [[Operator Text PState Identity Markup]]
mathOperatorTable =
  [ -- precedence 6
    [ forall s u (m :: * -> *) a.
ParsecT s u m (a -> a -> a) -> Assoc -> Operator s u m a
Infix (Markup -> Markup -> Markup
attachBottom forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P ()
op [Char]
"_") Assoc
AssocLeft,
      forall s u (m :: * -> *) a.
ParsecT s u m (a -> a -> a) -> Assoc -> Operator s u m a
Infix (Markup -> Markup -> Markup
attachTop forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P ()
op [Char]
"^") Assoc
AssocLeft
    ],
    -- precedence 5
    [ forall s u (m :: * -> *) a.
ParsecT s u m (a -> a) -> Operator s u m a
Postfix
        ( forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
            Maybe (SourcePos, Text)
mbBeforeSpace <- PState -> Maybe (SourcePos, Text)
stBeforeSpace forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
            -- NOTE: can't have space before () or [] arg in a
            -- function call! to prevent bugs with e.g. 'if 2<3 [...]'.
            forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Maybe (SourcePos, Text)
mbBeforeSpace forall a. Eq a => a -> a -> Bool
== forall a. Maybe a
Nothing
            Markup
args <- Char -> Char -> Bool -> P Markup
mGrouped Char
'(' Char
')' Bool
True
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ \Markup
expr -> Maybe Text -> Maybe Text -> [Markup] -> Markup
MGroup forall a. Maybe a
Nothing forall a. Maybe a
Nothing [Markup
expr, Markup
args]
        )
    ],
    -- precedence 3
    [ forall s u (m :: * -> *) a.
ParsecT s u m (a -> a -> a) -> Assoc -> Operator s u m a
Infix (Markup -> Markup -> Markup
makeFrac forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P ()
op [Char]
"/") Assoc
AssocLeft
    ]
  ]

attachBottom :: Markup -> Markup -> Markup
attachBottom :: Markup -> Markup -> Markup
attachBottom Markup
base Markup
x = Maybe Markup -> Maybe Markup -> Markup -> Markup
MAttach (forall a. a -> Maybe a
Just (Markup -> Markup
hideOuterParens Markup
x)) forall a. Maybe a
Nothing Markup
base

attachTop :: Markup -> Markup -> Markup
attachTop :: Markup -> Markup -> Markup
attachTop (MAttach Maybe Markup
x Maybe Markup
Nothing Markup
y) Markup
z = Maybe Markup -> Maybe Markup -> Markup -> Markup
MAttach Maybe Markup
x (forall a. a -> Maybe a
Just (Markup -> Markup
hideOuterParens Markup
z)) Markup
y
attachTop Markup
base Markup
x = Maybe Markup -> Maybe Markup -> Markup -> Markup
MAttach forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just (Markup -> Markup
hideOuterParens Markup
x)) Markup
base

makeFrac :: Markup -> Markup -> Markup
makeFrac :: Markup -> Markup -> Markup
makeFrac Markup
x Markup
y = Markup -> Markup -> Markup
MFrac Markup
x (Markup -> Markup
hideOuterParens Markup
y)

hideOuterParens :: Markup -> Markup
hideOuterParens :: Markup -> Markup
hideOuterParens (MGroup (Just Text
"(") (Just Text
")") [Markup]
x) = Maybe Text -> Maybe Text -> [Markup] -> Markup
MGroup forall a. Maybe a
Nothing forall a. Maybe a
Nothing [Markup]
x
hideOuterParens Markup
x = Markup
x

mathExpressionTable :: [[Operator Text PState Identity Expr]]
mathExpressionTable :: [[Operator Text PState Identity Expr]]
mathExpressionTable = forall a. Int -> [a] -> [a]
take Int
16 (forall a. [a] -> [a]
cycle [[Operator Text PState Identity Expr
fieldAccess], [Operator Text PState Identity Expr
mathFunctionCall]])

mathFunctionCall :: Operator Text PState Identity Expr
mathFunctionCall :: Operator Text PState Identity Expr
mathFunctionCall =
  forall s u (m :: * -> *) a.
ParsecT s u m (a -> a) -> Operator s u m a
Postfix
    ( do
        Maybe (SourcePos, Text)
mbBeforeSpace <- PState -> Maybe (SourcePos, Text)
stBeforeSpace forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
        -- NOTE: can't have space before () or [] arg in a
        -- function call! to prevent bugs with e.g. 'if 2<3 [...]'.
        forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Maybe (SourcePos, Text)
mbBeforeSpace forall a. Eq a => a -> a -> Bool
== forall a. Maybe a
Nothing
        [Arg]
args <- P [Arg]
mArgs
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ \Expr
expr -> Expr -> [Arg] -> Expr
FuncCall Expr
expr [Arg]
args
    )

mExpr :: P Markup
mExpr :: P Markup
mExpr = SourcePos -> Expr -> Markup
Code forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P Expr
pMathExpr

pMathExpr :: P Expr
pMathExpr :: P Expr
pMathExpr = forall s (m :: * -> *) t u a.
Stream s m t =>
OperatorTable s u m a -> ParsecT s u m a -> ParsecT s u m a
buildExpressionParser [[Operator Text PState Identity Expr]]
mathExpressionTable (P Expr
pMathIdent forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Expr
pLiteral)

pMathIdent :: P Expr
pMathIdent :: P Expr
pMathIdent =
  (Identifier -> Expr
Ident forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Identifier
pMathIdentifier)
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ( do
            forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'√'
            (Identifier -> Expr
Ident (Text -> Identifier
Identifier Text
"root") forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'('))
              forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ( do
                      Markup
x <- P Markup
pMath
                      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
                        Expr -> [Arg] -> Expr
FuncCall
                          (Identifier -> Expr
Ident (Text -> Identifier
Identifier Text
"root"))
                          [Expr -> Arg
NormalArg (Block -> Expr
Block ([Markup] -> Block
Content [Markup
x]))]
                  )
        )

pMathIdentifier :: P Identifier
pMathIdentifier :: P Identifier
pMathIdentifier = forall a. P a -> P a
lexeme forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  Char
c <- forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isIdentStart
  [Char]
cs <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isMathIdentContinue
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Identifier
Identifier forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack (Char
c forall a. a -> [a] -> [a]
: [Char]
cs)

isMathIdentContinue :: Char -> Bool
isMathIdentContinue :: Char -> Bool
isMathIdentContinue Char
c = Char -> Bool
isIdentContinue Char
c Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
'_' Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
'-'

pMath :: P Markup
pMath :: P Markup
pMath = forall s (m :: * -> *) t u a.
Stream s m t =>
OperatorTable s u m a -> ParsecT s u m a -> ParsecT s u m a
buildExpressionParser [[Operator Text PState Identity Markup]]
mathOperatorTable P Markup
pBaseMath
  where
    pBaseMath :: P Markup
pBaseMath =
      P Markup
mNumber
        forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Markup
mLiteral
        forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Markup
mEscaped
        forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Markup
mBreak
        forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Markup
mAlignPoint
        forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Markup
mExpr
        forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Markup
mGroup
        forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Markup
mCode
        forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Markup
mMid
        forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Markup
mSymbol

mGroup :: P Markup
mGroup :: P Markup
mGroup =
  Char -> Char -> Bool -> P Markup
mGrouped Char
'(' Char
')' Bool
False
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> Char -> Bool -> P Markup
mGrouped Char
'{' Char
'}' Bool
False
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> Char -> Bool -> P Markup
mGrouped Char
'[' Char
']' Bool
False
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> Char -> Bool -> P Markup
mGrouped Char
'|' Char
'|' Bool
True

mGrouped :: Char -> Char -> Bool -> P Markup
mGrouped :: Char -> Char -> Bool -> P Markup
mGrouped Char
op' Char
cl Bool
requireMatch = forall a. P a -> P a
withNewlines forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ [Char] -> P [Char]
sym [Char
op']
  [Markup]
res <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
cl) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P Markup
pMath)
  (Maybe Text -> Maybe Text -> [Markup] -> Markup
MGroup (forall a. a -> Maybe a
Just (Char -> Text
T.singleton Char
op')) (forall a. a -> Maybe a
Just (Char -> Text
T.singleton Char
cl)) [Markup]
res forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (f :: * -> *) a. Functor f => f a -> f ()
void ([Char] -> P [Char]
sym [Char
cl]))
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Maybe Text -> Maybe Text -> [Markup] -> Markup
MGroup (forall a. a -> Maybe a
Just (Char -> Text
T.singleton Char
op')) forall a. Maybe a
Nothing [Markup]
res forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not Bool
requireMatch))

mNumber :: P Markup
mNumber :: P Markup
mNumber = forall a. P a -> P a
lexeme forall a b. (a -> b) -> a -> b
$ do
  Text
ds <- [Char] -> Text
T.pack 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 s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
  Text
opt <-
    forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option
      forall a. Monoid a => a
mempty
      ( do
          Char
e <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.'
          [Char]
es <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack (Char
e forall a. a -> [a] -> [a]
: [Char]
es)
      )
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Markup
Text (Text
ds forall a. Semigroup a => a -> a -> a
<> Text
opt)

mLiteral :: P Markup
mLiteral :: P Markup
mLiteral = do
  Maybe (SourcePos, Text)
mbBeforeSpace <- PState -> Maybe (SourcePos, Text)
stBeforeSpace forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  String Text
t <- P Literal
pStr
  -- ensure space in e.g. x "is natural":
  Maybe (SourcePos, Text)
mbAfterSpace <- PState -> Maybe (SourcePos, Text)
stBeforeSpace 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 (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    Text -> Markup
Text forall a b. (a -> b) -> a -> b
$
      (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (forall a b. a -> b -> a
const Text
" ") Maybe (SourcePos, Text)
mbBeforeSpace)
        forall a. Semigroup a => a -> a -> a
<> Text
t
        forall a. Semigroup a => a -> a -> a
<> (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (forall a b. a -> b -> a
const Text
" ") Maybe (SourcePos, Text)
mbAfterSpace)

mEscaped :: P Markup
mEscaped :: P Markup
mEscaped = Text -> Markup
Text forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. P a -> P a
lexeme (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT Text PState Identity Char
pEsc)

mBreak :: P Markup
mBreak :: P Markup
mBreak = Markup
HardBreak forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall a. P a -> P a
lexeme (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Char -> Bool
isSpace)))

-- we don't need to check for following whitespace, because
-- anything else would have been parsed by mEsc.
-- but we do skip following whitespace, since \160 wouldn't be gobbled by lexeme...

mAlignPoint :: P Markup
mAlignPoint :: P Markup
mAlignPoint = Markup
MAlignPoint forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P [Char]
sym [Char]
"&"

-- Math args can't have a content block; they can use semicolons
-- to separate array args.
mArgs :: P [Arg]
mArgs :: P [Arg]
mArgs =
  forall a. P a -> P a
inParens forall a b. (a -> b) -> a -> b
$
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT Text PState Identity Arg
mKeyValArg forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text PState Identity Arg
mArrayArg forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text PState Identity Arg
mNormArg forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text PState Identity Arg
mMathArg)
  where
    sep :: P ()
sep = forall (f :: * -> *) a. Functor f => f a -> f ()
void ([Char] -> P [Char]
sym [Char]
",") forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
')'))
    mNormArg :: ParsecT Text PState Identity Arg
mNormArg =
      Expr -> Arg
NormalArg forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'#' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P Expr
pExpr forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P ()
sep)
    mKeyValArg :: ParsecT Text PState Identity Arg
mKeyValArg = do
      Identifier
ident <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ P Identifier
pIdentifier forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* [Char] -> P [Char]
sym [Char]
":"
      Identifier -> Expr -> Arg
KeyValArg Identifier
ident
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'#' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P Expr
pExpr forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P ()
sep)
                forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Block -> Expr
Block forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Markup] -> Block
Content forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState Identity [Markup]
mathContent
            )
    mathContent :: ParsecT Text PState Identity [Markup]
mathContent = do
      [Markup]
xs <- ParsecT Text PState Identity [Markup]
maths
      if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Markup]
xs
        then forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ [Char] -> P [Char]
sym [Char]
","
        else P ()
sep
      forall (f :: * -> *) a. Applicative f => a -> f a
pure [Markup]
xs
    mMathArg :: ParsecT Text PState Identity Arg
mMathArg = [Markup] -> Arg
BlockArg forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState Identity [Markup]
mathContent
    mArrayArg :: ParsecT Text PState Identity Arg
mArrayArg = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
      let pRow :: ParsecT Text PState Identity [Markup]
pRow = forall {s} {u} {m :: * -> *} {a} {a}.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m [a]
sepBy' ([Markup] -> Markup
toGroup forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState Identity [Markup]
maths) ([Char] -> P [Char]
sym [Char]
",")
      [[Markup]]
rows <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text PState Identity [Markup]
pRow forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* [Char] -> P [Char]
sym [Char]
";")
      -- parse any regular items and form a last row
      [Markup]
lastrow <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ([Markup] -> Markup
toGroup forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState Identity [Markup]
mathContent)
      let rows' :: [[Markup]]
rows' =
            if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Markup]
lastrow
              then [[Markup]]
rows
              else [[Markup]]
rows forall a. [a] -> [a] -> [a]
++ [[Markup]
lastrow]
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [[Markup]] -> Arg
ArrayArg [[Markup]]
rows'
    maths :: ParsecT Text PState Identity [Markup]
maths = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
",;)") forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT Text PState Identity Arg
mKeyValArg forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P Markup
pMath)
    toGroup :: [Markup] -> Markup
toGroup [Markup
m] = Markup
m
    toGroup [Markup]
ms = Maybe Text -> Maybe Text -> [Markup] -> Markup
MGroup forall a. Maybe a
Nothing forall a. Maybe a
Nothing [Markup]
ms
    -- special sepBy' with an added try:
    sepBy' :: ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m [a]
sepBy' ParsecT s u m a
p ParsecT s u m a
s = forall {s} {u} {m :: * -> *} {a} {a}.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m [a]
sepBy1' ParsecT s u m a
p ParsecT s u m a
s forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    sepBy1' :: ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m [a]
sepBy1' ParsecT s u m a
p ParsecT s u m a
s = do
      a
x <- ParsecT s u m a
p
      [a]
xs <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s u m a
s forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT s u m a
p))
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
x forall a. a -> [a] -> [a]
: [a]
xs)

mCode :: P Markup
mCode :: P Markup
mCode = forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'#' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (SourcePos -> Expr -> Markup
Code forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P Expr
pBasicExpr)

mMid :: P Markup
mMid :: P Markup
mMid = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  PState -> Maybe (SourcePos, Text)
stBeforeSpace 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 :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Maybe a -> Bool
isJust
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P ()
ws
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Maybe Text -> Maybe Text -> [Markup] -> Markup
MGroup forall a. Maybe a
Nothing forall a. Maybe a
Nothing [Markup
Nbsp, Text -> Markup
Text Text
"|", Markup
Nbsp]

mSymbol :: P Markup
mSymbol :: P Markup
mSymbol =
  Text -> Markup
Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. P a -> P a
lexeme
      ( (Text
"≠" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P [Char]
string [Char]
"!=")
          forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Text
"≥" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P [Char]
string [Char]
">=")
          forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Text
"≤" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P [Char]
string [Char]
"<=")
          forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Text
"←" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P [Char]
string [Char]
"<-")
          forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Text
"→" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P [Char]
string [Char]
"->")
          forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Text
"⇐" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P [Char]
string [Char]
"<=")
          forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Text
"⇒" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P [Char]
string [Char]
"=>")
          forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Text
"⟵" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P [Char]
string [Char]
"<--")
          forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Text
"⟶" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P [Char]
string [Char]
"-->")
          forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Text
"⟸" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P [Char]
string [Char]
"<==")
          forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Text
"⟹" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P [Char]
string [Char]
"==>")
          forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Text
"…" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P [Char]
string [Char]
"...")
          forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Text
"′" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\'')
          forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ( Char -> Text
T.singleton
                  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\Char
c -> Bool -> Bool
not (Char -> Bool
isSpace Char
c) Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
'$' Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
'\\')
              )
      )

withIndent :: Int -> P a -> P a
withIndent :: forall a. Int -> P a -> P a
withIndent Int
indent P a
pa = do
  [Int]
oldIndent <- PState -> [Int]
stIndent 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
$ \PState
st -> PState
st {stIndent :: [Int]
stIndent = Int
indent forall a. a -> [a] -> [a]
: [Int]
oldIndent}
  a
ms <- P a
pa
  forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \PState
st -> PState
st {stIndent :: [Int]
stIndent = [Int]
oldIndent}
  forall (f :: * -> *) a. Applicative f => a -> f a
pure a
ms

-- list ::= '-' space markup
-- enum ::= (digit+ '.' | '+') space markup
-- desc ::= '/' space markup ':' space markup
pListItem :: P Markup
pListItem :: P Markup
pListItem = do
  Int
col <- SourcePos -> Int
sourceColumn forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  Int
startLine <- PState -> Int
stLineStartCol 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 (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
col forall a. Eq a => a -> a -> Bool
== Int
startLine)
  forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try
    ( do
        forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-'
        forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' ') forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P ()
pBlankline
        [Markup] -> Markup
BulletListItem forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Int -> P a -> P a
withIndent Int
col (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many P Markup
pMarkup)
    )
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try
      ( do
          Maybe Int
start <- (forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'+') forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState Identity Int
enumListStart)
          forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' ') forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P ()
pBlankline
          Maybe Int -> [Markup] -> Markup
EnumListItem Maybe Int
start forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Int -> P a -> P a
withIndent Int
col (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many P Markup
pMarkup)
      )
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try
      ( do
          -- desc list
          forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'/')
          forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' '))
          [Markup]
term <- forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill P Markup
pMarkup (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':')
          forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Text PState Identity Char
spaceChar
          forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional P ()
pBlankline
          [Markup] -> [Markup] -> Markup
DescListItem [Markup]
term forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Int -> P a -> P a
withIndent Int
col (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many P Markup
pMarkup)
      )

enumListStart :: P Int
enumListStart :: ParsecT Text PState Identity Int
enumListStart = do
  [Char]
ds <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.'
  case forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
ds of
    Maybe Int
Nothing -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"could not read " forall a. Semigroup a => a -> a -> a
<> [Char]
ds forall a. Semigroup a => a -> a -> a
<> [Char]
" as digits"
    Just Int
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
x

-- line-comment = '//' (!unicode(Newline))*
-- block-comment = '/*' (. | block-comment)* '*/'
pComment :: P Markup
pComment :: P Markup
pComment = Markup
Comment forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (P ()
pLineComment forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P ()
pBlockComment)

pLineComment :: P ()
pLineComment :: P ()
pLineComment = do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ [Char] -> P [Char]
string [Char]
"//"
  forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\Char
c -> Char
c forall a. Eq a => a -> a -> Bool
/= Char
'\n' Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
'\r'))
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
endOfLine

pBlockComment :: P ()
pBlockComment :: P ()
pBlockComment = do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ [Char] -> P [Char]
string [Char]
"/*"
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$
    forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill
      ( P ()
pBlockComment
          forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P ()
pLineComment
          forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (f :: * -> *) a. Functor f => f a -> f ()
void forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
      )
      ([Char] -> P [Char]
string [Char]
"*/")

pSpace :: P Markup
pSpace :: P Markup
pSpace = Markup
Space forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\Char
c -> Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
'\r' Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
'\n'))

pEol :: P Markup
pEol :: P Markup
pEol = do
  P ()
pBaseEol
  (Markup
ParBreak forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 P ()
pBaseEol)
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Markup
ParBreak forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ P ()
pEndOfContent)
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure Markup
SoftBreak

pBaseEol :: P ()
pBaseEol :: P ()
pBaseEol = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
endOfLine
  -- fail if we can't indent enough
  [Int]
indents <- PState -> [Int]
stIndent 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 [Int]
indents of
    (Int
i : [Int]
_) -> forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
i (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' '))) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P ()
pBlankline
    [] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  P ()
eatPrefixSpaces

eatPrefixSpaces :: P ()
eatPrefixSpaces :: P ()
eatPrefixSpaces = do
  forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Text PState Identity Char
spaceChar
  Int
col <- SourcePos -> Int
sourceColumn forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \PState
st -> PState
st {stLineStartCol :: Int
stLineStartCol = Int
col}

spaceChar :: P Char
spaceChar :: ParsecT Text PState Identity Char
spaceChar = forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\Char
c -> Char
c forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'\t')

pHardbreak :: P Markup
pHardbreak :: P Markup
pHardbreak =
  Markup
HardBreak forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Text PState Identity Char
spaceChar forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P ()
pBaseEol) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Text PState Identity Char
spaceChar)

pBlankline :: P ()
pBlankline :: P ()
pBlankline = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Text PState Identity Char
spaceChar
  forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
endOfLine)) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P ()
pEndOfContent

pRawInline :: P Markup
pRawInline :: P Markup
pRawInline =
  Text -> Markup
RawInline forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'`' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar (forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'`') forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof))

pRawBlock :: P Markup
pRawBlock :: P Markup
pRawBlock = do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ [Char] -> P [Char]
string [Char]
"```"
  Int
numticks <- (forall a. Num a => a -> a -> a
+ Int
3) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length 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 s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'`')
  Text
lang <- [Char] -> Text
T.pack 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 s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' '))
  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' ') forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P Markup
pEol
  let nl :: ParsecT Text PState Identity Char
nl = forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P ()
optionalGobbleIndent
  Text
code <-
    [Char] -> Text
T.pack
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill
        (ParsecT Text PState Identity Char
nl forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar)
        ([Char] -> P [Char]
string (forall a. Int -> a -> [a]
replicate Int
numticks Char
'`'))
  forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'`')
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Text -> Markup
RawBlock Text
lang Text
code

optionalGobbleIndent :: P ()
optionalGobbleIndent :: P ()
optionalGobbleIndent = do
  [Int]
indents <- PState -> [Int]
stIndent 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 [Int]
indents of
    (Int
i : [Int]
_) -> Int -> P ()
gobble Int
i
    [] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  where
    gobble :: Int -> P ()
    gobble :: Int -> P ()
gobble Int
0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    gobble Int
n = (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' ' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> P ()
gobble (Int
n forall a. Num a => a -> a -> a
- Int
1)) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

pStrong :: P Markup
pStrong :: P Markup
pStrong = [Markup] -> Markup
Strong forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'*' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill P Markup
pMarkup (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'*'))

pEmph :: P Markup
pEmph :: P Markup
pEmph = [Markup] -> Markup
Emph forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill P Markup
pMarkup (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_'))

pHeading :: P Markup
pHeading :: P Markup
pHeading = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  Int
col <- SourcePos -> Int
sourceColumn forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  Int
lineStartCol <- PState -> Int
stLineStartCol 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 (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
col forall a. Eq a => a -> a -> Bool
== Int
lineStartCol)
  Int
lev <- forall (t :: * -> *) a. Foldable t => t a -> Int
length 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 s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'=')
  forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' ')) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
endOfLine)
  -- Note: == hi _foo
  -- bar_ is parsed as a heading with "hi emph(foobar)"
  [Markup]
ms <- forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill P Markup
pMarkup (    forall (f :: * -> *) a. Functor f => f a -> f ()
void P Markup
pEol
                          forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P ()
pEndOfContent
                          forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P Expr
pLabel)))
                          forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']')))
  forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Text PState Identity Char
spaceChar
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Int -> [Markup] -> Markup
Heading Int
lev [Markup]
ms

pUrl :: P Markup
pUrl :: P Markup
pUrl = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  Text
prot <- [Char] -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> P [Char]
string [Char]
"http://" forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [Char] -> P [Char]
string [Char]
"https://")
  Text
rest <- [Char] -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> Int -> P [Char]
pNonspaceWithBalancedBrackets Int
0 Int
0 Int
0
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Markup
Url forall a b. (a -> b) -> a -> b
$ Text
prot forall a. Semigroup a => a -> a -> a
<> Text
rest

pNonspaceWithBalancedBrackets :: Int -> Int -> Int -> P [Char]
pNonspaceWithBalancedBrackets :: Int -> Int -> Int -> P [Char]
pNonspaceWithBalancedBrackets Int
parens Int
brackets Int
braces =
  ((:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'(' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Int -> Int -> P [Char]
pNonspaceWithBalancedBrackets (Int
parens forall a. Num a => a -> a -> a
+ Int
1) Int
brackets Int
braces)
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ((:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
parens forall a. Ord a => a -> a -> Bool
> Int
0) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
')') forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Int -> Int -> P [Char]
pNonspaceWithBalancedBrackets (Int
parens forall a. Num a => a -> a -> a
- Int
1) Int
brackets Int
braces)
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ((:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'[' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Int -> Int -> P [Char]
pNonspaceWithBalancedBrackets Int
parens (Int
brackets forall a. Num a => a -> a -> a
+ Int
1) Int
braces)
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ((:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
brackets forall a. Ord a => a -> a -> Bool
> Int
0) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']') forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Int -> Int -> P [Char]
pNonspaceWithBalancedBrackets Int
parens (Int
brackets forall a. Num a => a -> a -> a
- Int
1) Int
braces)
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ((:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Int -> Int -> P [Char]
pNonspaceWithBalancedBrackets Int
parens Int
brackets (Int
braces forall a. Num a => a -> a -> a
+ Int
1))
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ((:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
braces forall a. Ord a => a -> a -> Bool
> Int
0) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'}') forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> Int -> Int -> P [Char]
pNonspaceWithBalancedBrackets Int
parens Int
brackets (Int
braces forall a. Num a => a -> a -> a
- Int
1))
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
" \t\r\n()[]{}" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Int -> Int -> P [Char]
pNonspaceWithBalancedBrackets Int
parens Int
brackets Int
braces
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure []

pText :: P Markup
pText :: P Markup
pText =
  Text -> Markup
Text forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
some
      ( forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\Char
c -> Bool -> Bool
not (Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char -> Bool
isSpecial Char
c))
          forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ((forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'*' forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_') forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum)
      )

pEscaped :: P Markup
pEscaped :: P Markup
pEscaped = Text -> Markup
Text forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState Identity Char
pEsc

pEsc :: P Char
pEsc :: ParsecT Text PState Identity Char
pEsc =
  forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ParsecT Text PState Identity Char
uniEsc forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace))

pStrEsc :: P Char
pStrEsc :: ParsecT Text PState Identity Char
pStrEsc =
  forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$
    forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\'
      forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ( ParsecT Text PState Identity Char
uniEsc
             forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isSpecial
             forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Char
'\n' forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'n')
             forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Char
'\t' forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
't')
             forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Char
'\r' forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'r')
         )

uniEsc :: P Char
uniEsc :: ParsecT Text PState Identity Char
uniEsc = Int -> Char
chr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'u' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text PState Identity Int
hexnum forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'}')
  where
    hexnum :: P Int
    hexnum :: ParsecT Text PState Identity Int
hexnum = do
      [Char]
ds <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit
      case forall a. Read a => [Char] -> Maybe a
readMaybe ([Char]
"0x" forall a. [a] -> [a] -> [a]
++ [Char]
ds) of
        Just Int
i
          | Int
i forall a. Ord a => a -> a -> Bool
<= Int
1114112 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
i
          | Bool
otherwise -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0xFFFD
        Maybe Int
Nothing -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"Could not read hex number " forall a. [a] -> [a] -> [a]
++ [Char]
ds

pNbsp :: P Markup
pNbsp :: P Markup
pNbsp = Markup
Nbsp forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'~'

pDash :: P Markup
pDash :: P Markup
pDash = do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-'
  (Markup
Shy forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'?')
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ((Markup
EmDash forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-') forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure Markup
EnDash))
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Markup
Text Text
"-")

pEllipsis :: P Markup
pEllipsis :: P Markup
pEllipsis = do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.'
  (Markup
Ellipsis forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P [Char]
string [Char]
"..") forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Markup
Text Text
".")

pQuote :: P Markup
pQuote :: P Markup
pQuote = Char -> Markup
Quote forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\'' forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'"')

pLabelInContent :: P Markup
pLabelInContent :: P Markup
pLabelInContent = SourcePos -> Expr -> Markup
Code forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P Expr
pLabel

pLabel :: P Expr
pLabel :: P Expr
pLabel =
  Text -> Expr
Label forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack
    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
try
      ( forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'<'
          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isIdentContinue forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_' forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.')
          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'>'
      )

pRef :: P Markup
pRef :: P Markup
pRef =
  Text -> Expr -> Markup
Ref
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'@' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([Char] -> Text
T.pack 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 s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isIdentContinue forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_')))
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option (Literal -> Expr
Literal Literal
Auto) (Block -> Expr
Block forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Block
pContent)

-- "If a character would continue the expression but should be interpreted as
-- text, the expression can forcibly be ended with a semicolon (;)."
-- "A few kinds of expressions are not compatible with the hashtag syntax
-- (e.g. binary operator expressions). To embed these into markup, you
-- can use parentheses, as in #(1 + 2)." Hence pBasicExpr not pExpr.
pHash :: P Markup
pHash :: P Markup
pHash = do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'#'
  Markup
res <- SourcePos -> Expr -> Markup
Code forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P Expr
pBasicExpr forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ([Char] -> P [Char]
sym [Char]
";")
  -- rewind if we gobbled space:
  Maybe (SourcePos, Text)
mbBeforeSpace <- PState -> Maybe (SourcePos, Text)
stBeforeSpace 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 Maybe (SourcePos, Text)
mbBeforeSpace of
    Maybe (SourcePos, Text)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just (SourcePos
pos, Text
inp) -> do
      forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition SourcePos
pos
      forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
setInput Text
inp
  forall (f :: * -> *) a. Applicative f => a -> f a
pure Markup
res

isSpecial :: Char -> Bool
isSpecial :: Char -> Bool
isSpecial Char
'\\' = Bool
True
isSpecial Char
'[' = Bool
True
isSpecial Char
']' = Bool
True
isSpecial Char
'#' = Bool
True
isSpecial Char
'-' = Bool
True
isSpecial Char
'.' = Bool
True
isSpecial Char
'"' = Bool
True
isSpecial Char
'\'' = Bool
True
isSpecial Char
'*' = Bool
True
isSpecial Char
'_' = Bool
True
isSpecial Char
'`' = Bool
True
isSpecial Char
'$' = Bool
True
isSpecial Char
'<' = Bool
True
isSpecial Char
'>' = Bool
True
isSpecial Char
'@' = Bool
True
isSpecial Char
'/' = Bool
True
isSpecial Char
':' = Bool
True
isSpecial Char
'~' = Bool
True
isSpecial Char
'=' = Bool
True
isSpecial Char
'(' = Bool
True -- so we don't gobble ( before URLs
isSpecial Char
_ = Bool
False

pIdentifier :: P Identifier
pIdentifier :: P Identifier
pIdentifier = forall a. P a -> P a
lexeme forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  Char
c <- forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isIdentStart
  [Char]
cs <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isIdentContinue
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Identifier
Identifier forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack (Char
c forall a. a -> [a] -> [a]
: [Char]
cs)

-- ident_start ::= unicode(XID_Start)
-- ID_Start characters are derived from the Unicode General_Category of
-- uppercase letters, lowercase letters, titlecase letters, modifier letters,
-- other letters, letter numbers, plus Other_ID_Start, minus Pattern_Syntax and
-- Pattern_White_Space code points.
isIdentStart :: Char -> Bool
isIdentStart :: Char -> Bool
isIdentStart Char
c =
  case Char -> GeneralCategory
generalCategory Char
c of
    GeneralCategory
UppercaseLetter -> Bool
True
    GeneralCategory
LowercaseLetter -> Bool
True
    GeneralCategory
TitlecaseLetter -> Bool
True
    GeneralCategory
ModifierLetter -> Bool
True
    GeneralCategory
OtherLetter -> Bool
True
    GeneralCategory
LetterNumber -> Bool
True
    GeneralCategory
_ -> Bool
False

-- ident_continue ::= unicode(XID_Continue) | '-'
-- ID_Continue characters include ID_Start characters, plus characters having
-- the Unicode General_Category of nonspacing marks, spacing combining marks,
-- decimal number, connector punctuation, plus Other_ID_Continue, minus
-- Pattern_Syntax and Pattern_White_Space code points.
isIdentContinue :: Char -> Bool
isIdentContinue :: Char -> Bool
isIdentContinue Char
c =
  Char -> Bool
isIdentStart Char
c
    Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'-'
    Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'_'
    Bool -> Bool -> Bool
|| case Char -> GeneralCategory
generalCategory Char
c of
      GeneralCategory
NonSpacingMark -> Bool
True
      GeneralCategory
SpacingCombiningMark -> Bool
True
      GeneralCategory
DecimalNumber -> Bool
True
      GeneralCategory
ConnectorPunctuation -> Bool
True
      GeneralCategory
_ -> Bool
False

pKeyword :: String -> P ()
pKeyword :: [Char] -> P ()
pKeyword [Char]
t = forall a. P a -> P a
lexeme forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ [Char] -> P [Char]
string [Char]
t forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isIdentContinue)

-- NOTE: there can be field access lookups that require identifiers like
-- 'not'.
-- keywords :: [Text]
-- keywords = ["none", "auto", "true", "false", "not", "and", "or", "let",
--             "set", "show", "wrap", "if", "else", "for", "in", "as", "while",
--             "break", "continue", "return", "import", "include", "from"]

pExpr :: P Expr
pExpr :: P Expr
pExpr = forall s (m :: * -> *) t u a.
Stream s m t =>
OperatorTable s u m a -> ParsecT s u m a -> ParsecT s u m a
buildExpressionParser [[Operator Text PState Identity Expr]]
operatorTable P Expr
pBasicExpr

-- A basic expression excludes the unary and binary operators outside of parens,
-- but includes field access and function application. Needed for pHash.
pBasicExpr :: P Expr
pBasicExpr :: P Expr
pBasicExpr = forall s (m :: * -> *) t u a.
Stream s m t =>
OperatorTable s u m a -> ParsecT s u m a -> ParsecT s u m a
buildExpressionParser [[Operator Text PState Identity Expr]]
basicOperatorTable P Expr
pBaseExpr

pQualifiedIdentifier :: P Expr
pQualifiedIdentifier :: P Expr
pQualifiedIdentifier =
  forall s (m :: * -> *) t u a.
Stream s m t =>
OperatorTable s u m a -> ParsecT s u m a -> ParsecT s u m a
buildExpressionParser (forall a. Int -> a -> [a]
replicate Int
4 [Operator Text PState Identity Expr
fieldAccess]) P Expr
pIdent

pBaseExpr :: P Expr
pBaseExpr :: P Expr
pBaseExpr =
  P Expr
pLiteral
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Expr
pKeywordExpr
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Expr
pFuncExpr
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Expr
pBindExpr
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Expr
pIdent
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Expr
pArrayExpr
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Expr
pDictExpr
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a. P a -> P a
inParens P Expr
pExpr
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Block -> Expr
Block forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Markup] -> Block
Content forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
: []) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Markup
pEquation)
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Expr
pLabel
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Expr
pBlock

pLiteral :: P Expr
pLiteral :: P Expr
pLiteral =
  Literal -> Expr
Literal
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( P Literal
pNone
            forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Literal
pAuto
            forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Literal
pBoolean
            forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Literal
pNumeric
            forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Literal
pStr
        )

fieldAccess :: Operator Text PState Identity Expr
fieldAccess :: Operator Text PState Identity Expr
fieldAccess = forall s u (m :: * -> *) a.
ParsecT s u m (a -> a) -> Operator s u m a
Postfix (Expr -> Expr -> Expr
FieldAccess 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
try ([Char] -> P [Char]
sym [Char]
"." forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P Expr
pIdent))

-- don't allow space after .
restrictedFieldAccess :: Operator Text PState Identity Expr
restrictedFieldAccess :: Operator Text PState Identity Expr
restrictedFieldAccess = forall s u (m :: * -> *) a.
ParsecT s u m (a -> a) -> Operator s u m a
Postfix (Expr -> Expr -> Expr
FieldAccess 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
try (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P Expr
pIdent))

functionCall :: Operator Text PState Identity Expr
functionCall :: Operator Text PState Identity Expr
functionCall =
  forall s u (m :: * -> *) a.
ParsecT s u m (a -> a) -> Operator s u m a
Postfix
    ( do
        Maybe (SourcePos, Text)
mbBeforeSpace <- PState -> Maybe (SourcePos, Text)
stBeforeSpace forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
        -- NOTE: can't have space before () or [] arg in a
        -- function call! to prevent bugs with e.g. 'if 2<3 [...]'.
        forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Maybe (SourcePos, Text)
mbBeforeSpace forall a. Eq a => a -> a -> Bool
== forall a. Maybe a
Nothing
        [Arg]
args <- P [Arg]
pArgs
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ \Expr
expr -> Expr -> [Arg] -> Expr
FuncCall Expr
expr [Arg]
args
    )

-- The reason we cycle field access and function call
-- is that a postfix operator will not
-- be repeatable at the same precedence level...see docs for
-- buildExpressionParser.
basicOperatorTable :: [[Operator Text PState Identity Expr]]
basicOperatorTable :: [[Operator Text PState Identity Expr]]
basicOperatorTable =
  forall a. Int -> [a] -> [a]
take Int
16 (forall a. [a] -> [a]
cycle [[Operator Text PState Identity Expr
restrictedFieldAccess], [Operator Text PState Identity Expr
functionCall]])

operatorTable :: [[Operator Text PState Identity Expr]]
operatorTable :: [[Operator Text PState Identity Expr]]
operatorTable =
  -- precedence 8 (real field access, perhaps  with space after .)
  forall a. Int -> [a] -> [a]
take Int
12 (forall a. [a] -> [a]
cycle [[Operator Text PState Identity Expr
fieldAccess], [Operator Text PState Identity Expr
functionCall]])
    forall a. [a] -> [a] -> [a]
++
    -- precedence 7 (repeated because of parsec's quirks with postfix, prefix)
    forall a. Int -> a -> [a]
replicate Int
6 [forall s u (m :: * -> *) a.
ParsecT s u m (a -> a) -> Operator s u m a
Postfix (Expr -> Expr -> Expr
ToPower 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
try (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'e' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P Expr
pExpr))]
    forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate Int
6 [forall s u (m :: * -> *) a.
ParsecT s u m (a -> a) -> Operator s u m a
Prefix (Expr -> Expr
Negated forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P ()
op [Char]
"-"), forall s u (m :: * -> *) a.
ParsecT s u m (a -> a) -> Operator s u m a
Prefix (forall a. a -> a
id forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P ()
op [Char]
"+")]
    forall a. [a] -> [a] -> [a]
++ [
         -- precedence 6
         [ forall s u (m :: * -> *) a.
ParsecT s u m (a -> a -> a) -> Assoc -> Operator s u m a
Infix (Expr -> Expr -> Expr
Times forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P ()
op [Char]
"*") Assoc
AssocLeft,
           forall s u (m :: * -> *) a.
ParsecT s u m (a -> a -> a) -> Assoc -> Operator s u m a
Infix (Expr -> Expr -> Expr
Divided forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P ()
op [Char]
"/") Assoc
AssocLeft
         ],
         -- precedence 5
         [ forall s u (m :: * -> *) a.
ParsecT s u m (a -> a -> a) -> Assoc -> Operator s u m a
Infix (Expr -> Expr -> Expr
Plus forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P ()
op [Char]
"+") Assoc
AssocLeft,
           forall s u (m :: * -> *) a.
ParsecT s u m (a -> a -> a) -> Assoc -> Operator s u m a
Infix (Expr -> Expr -> Expr
Minus forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P ()
op [Char]
"-") Assoc
AssocLeft
         ],
         -- precedence 4
         [ forall s u (m :: * -> *) a.
ParsecT s u m (a -> a -> a) -> Assoc -> Operator s u m a
Infix (Expr -> Expr -> Expr
Equals forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P ()
op [Char]
"==") Assoc
AssocLeft,
           forall s u (m :: * -> *) a.
ParsecT s u m (a -> a -> a) -> Assoc -> Operator s u m a
Infix ((\Expr
x Expr
y -> Expr -> Expr
Not (Expr -> Expr -> Expr
Equals Expr
x Expr
y)) forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P ()
op [Char]
"!=") Assoc
AssocLeft,
           forall s u (m :: * -> *) a.
ParsecT s u m (a -> a -> a) -> Assoc -> Operator s u m a
Infix (Expr -> Expr -> Expr
LessThan forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P ()
op [Char]
"<") Assoc
AssocLeft,
           forall s u (m :: * -> *) a.
ParsecT s u m (a -> a -> a) -> Assoc -> Operator s u m a
Infix (Expr -> Expr -> Expr
LessThanOrEqual forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P ()
op [Char]
"<=") Assoc
AssocLeft,
           forall s u (m :: * -> *) a.
ParsecT s u m (a -> a -> a) -> Assoc -> Operator s u m a
Infix (Expr -> Expr -> Expr
GreaterThan forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P ()
op [Char]
">") Assoc
AssocLeft,
           forall s u (m :: * -> *) a.
ParsecT s u m (a -> a -> a) -> Assoc -> Operator s u m a
Infix (Expr -> Expr -> Expr
GreaterThanOrEqual forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P ()
op [Char]
">=") Assoc
AssocLeft,
           forall s u (m :: * -> *) a.
ParsecT s u m (a -> a -> a) -> Assoc -> Operator s u m a
Infix (Expr -> Expr -> Expr
InCollection forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P ()
pKeyword [Char]
"in") Assoc
AssocLeft,
           forall s u (m :: * -> *) a.
ParsecT s u m (a -> a -> a) -> Assoc -> Operator s u m a
Infix
             ( (\Expr
x Expr
y -> Expr -> Expr
Not (Expr -> Expr -> Expr
InCollection Expr
x Expr
y))
                 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([Char] -> P ()
pKeyword [Char]
"not" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [Char] -> P ()
pKeyword [Char]
"in")
             )
             Assoc
AssocLeft
         ],
         -- precedence 3
         [ forall s u (m :: * -> *) a.
ParsecT s u m (a -> a) -> Operator s u m a
Prefix (Expr -> Expr
Not forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P ()
pKeyword [Char]
"not"),
           forall s u (m :: * -> *) a.
ParsecT s u m (a -> a -> a) -> Assoc -> Operator s u m a
Infix (Expr -> Expr -> Expr
And forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P ()
pKeyword [Char]
"and") Assoc
AssocLeft
         ],
         -- precedence 2
         [ forall s u (m :: * -> *) a.
ParsecT s u m (a -> a -> a) -> Assoc -> Operator s u m a
Infix (Expr -> Expr -> Expr
Or forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P ()
pKeyword [Char]
"or") Assoc
AssocLeft
         ],
         -- precedence 1
         [ forall s u (m :: * -> *) a.
ParsecT s u m (a -> a -> a) -> Assoc -> Operator s u m a
Infix (Expr -> Expr -> Expr
Assign forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P ()
op [Char]
"=") Assoc
AssocRight,
           forall s u (m :: * -> *) a.
ParsecT s u m (a -> a -> a) -> Assoc -> Operator s u m a
Infix ((\Expr
x Expr
y -> Expr -> Expr -> Expr
Assign Expr
x (Expr -> Expr -> Expr
Plus Expr
x Expr
y)) forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P ()
op [Char]
"+=") Assoc
AssocRight,
           forall s u (m :: * -> *) a.
ParsecT s u m (a -> a -> a) -> Assoc -> Operator s u m a
Infix ((\Expr
x Expr
y -> Expr -> Expr -> Expr
Assign Expr
x (Expr -> Expr -> Expr
Minus Expr
x Expr
y)) forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P ()
op [Char]
"-=") Assoc
AssocRight,
           forall s u (m :: * -> *) a.
ParsecT s u m (a -> a -> a) -> Assoc -> Operator s u m a
Infix ((\Expr
x Expr
y -> Expr -> Expr -> Expr
Assign Expr
x (Expr -> Expr -> Expr
Times Expr
x Expr
y)) forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P ()
op [Char]
"*=") Assoc
AssocRight,
           forall s u (m :: * -> *) a.
ParsecT s u m (a -> a -> a) -> Assoc -> Operator s u m a
Infix ((\Expr
x Expr
y -> Expr -> Expr -> Expr
Assign Expr
x (Expr -> Expr -> Expr
Divided Expr
x Expr
y)) forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P ()
op [Char]
"/=") Assoc
AssocRight
         ]
       ]

pNone :: P Literal
pNone :: P Literal
pNone = Literal
None forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P ()
pKeyword [Char]
"none"

pAuto :: P Literal
pAuto :: P Literal
pAuto = Literal
Auto forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P ()
pKeyword [Char]
"auto"

pBoolean :: P Literal
pBoolean :: P Literal
pBoolean =
  (Bool -> Literal
Boolean Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P ()
pKeyword [Char]
"true") forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Bool -> Literal
Boolean Bool
False forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P ()
pKeyword [Char]
"false")

pNumber :: P (Either Integer Double)
pNumber :: P (Either Integer Double)
pNumber = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  [Char]
pref <- [Char] -> P [Char]
string [Char]
"0b" forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [Char] -> P [Char]
string [Char]
"0x" forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [Char] -> P [Char]
string [Char]
"0o" forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure [Char]
""
  case [Char]
pref of
    [Char]
"0b" -> do
      [Integer]
nums <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ((Integer
1 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'1') forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Integer
0 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'0'))
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. Num a => a -> a -> a
(*) (forall a. [a] -> [a]
reverse [Integer]
nums) (forall a b. (a -> b) -> [a] -> [b]
map (Integer
2 forall a b. (Num a, Integral b) => a -> b -> a
^) [(Integer
0 :: Integer) ..])
    [Char]
"0x" -> do
      [Char]
num <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit
      case forall a. Read a => [Char] -> Maybe a
readMaybe ([Char]
"0x" forall a. [a] -> [a] -> [a]
++ [Char]
num) of
        Just (Integer
i :: Integer) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left Integer
i
        Maybe Integer
_ -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"could not read " forall a. Semigroup a => a -> a -> a
<> [Char]
num forall a. Semigroup a => a -> a -> a
<> [Char]
" as hex digits"
    [Char]
"0o" -> do
      [Char]
num <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
octDigit
      case forall a. Read a => [Char] -> Maybe a
readMaybe ([Char]
"0o" forall a. [a] -> [a] -> [a]
++ [Char]
num) of
        Just (Integer
i :: Integer) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left Integer
i
        Maybe Integer
_ -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"could not read " forall a. Semigroup a => a -> a -> a
<> [Char]
num forall a. Semigroup a => a -> a -> a
<> [Char]
" as octal digits"
    [Char]
_ -> do
      [Char]
as <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([Char]
"0" forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit)))
      [Char]
pe <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] forall a b. (a -> b) -> a -> b
$ [Char] -> P [Char]
string [Char]
"."
      [Char]
bs <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
      [Char]
es <-
        forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option
          [Char]
""
          ( do
              forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'e' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-')
              [Char]
minus <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
1 (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-')
              [Char]
ds <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
              forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char]
"e" forall a. [a] -> [a] -> [a]
++ [Char]
minus forall a. [a] -> [a] -> [a]
++ [Char]
ds)
          )
      let num :: [Char]
num = [Char]
pref forall a. [a] -> [a] -> [a]
++ [Char]
as forall a. [a] -> [a] -> [a]
++ [Char]
pe forall a. [a] -> [a] -> [a]
++ [Char]
bs forall a. [a] -> [a] -> [a]
++ [Char]
es
      case forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
num of
        Just (Integer
i :: Integer) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left Integer
i
        Maybe Integer
Nothing ->
          case forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
num of
            Just (Double
d :: Double) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Double
d
            Maybe Double
Nothing -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"could not read " forall a. Semigroup a => a -> a -> a
<> [Char]
num forall a. Semigroup a => a -> a -> a
<> [Char]
" as integer"

pNumeric :: P Literal
pNumeric :: P Literal
pNumeric = forall a. P a -> P a
lexeme forall a b. (a -> b) -> a -> b
$ do
  Either Integer Double
result <- P (Either Integer Double)
pNumber
  ( do
      Unit
unit <- P Unit
pUnit
      case Either Integer Double
result of
        Left Integer
i -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Double -> Unit -> Literal
Numeric (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i) Unit
unit
        Right Double
d -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Double -> Unit -> Literal
Numeric Double
d Unit
unit
    )
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> case Either Integer Double
result of
      Left Integer
i -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Integer -> Literal
Int Integer
i
      Right Double
d -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Double -> Literal
Float Double
d

pStr :: P Literal
pStr :: P Literal
pStr = forall a. P a -> P a
lexeme forall a b. (a -> b) -> a -> b
$ do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'"'
  Text -> Literal
String forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill (ParsecT Text PState Identity Char
pStrEsc forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"\"\r\n") (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'"')

pUnit :: P Unit
pUnit :: P Unit
pUnit =
  (Unit
Percent forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P [Char]
sym [Char]
"%")
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Unit
Pt forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P ()
pKeyword [Char]
"pt")
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Unit
Mm forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P ()
pKeyword [Char]
"mm")
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Unit
Cm forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P ()
pKeyword [Char]
"cm")
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Unit
In forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P ()
pKeyword [Char]
"in")
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Unit
Deg forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P ()
pKeyword [Char]
"deg")
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Unit
Rad forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P ()
pKeyword [Char]
"rad")
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Unit
Em forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P ()
pKeyword [Char]
"em")
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Unit
Fr forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P ()
pKeyword [Char]
"fr")

pIdent :: P Expr
pIdent :: P Expr
pIdent = Identifier -> Expr
Ident forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Identifier
pIdentifier

pBlock :: P Expr
pBlock :: P Expr
pBlock = Block -> Expr
Block forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (P Block
pCodeBlock forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Block
pContent)

pCodeBlock :: P Block
pCodeBlock :: P Block
pCodeBlock = [Expr] -> Block
CodeBlock forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. P a -> P a
inBraces P [Expr]
pCode

pCode :: P [Expr]
pCode :: P [Expr]
pCode = forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
sepEndBy P Expr
pExpr (forall (f :: * -> *) a. Functor f => f a -> f ()
void ([Char] -> P [Char]
sym [Char]
";") forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P ()
ws)

-- content-block ::= '[' markup ']'
pContent :: P Block
pContent :: P Block
pContent = do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'['
  Int
col <- SourcePos -> Int
sourceColumn forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  Int
oldLineStartCol <- PState -> Int
stLineStartCol 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
$ \PState
st ->
    PState
st
      { stLineStartCol :: Int
stLineStartCol = Int
col,
        stContentBlockNesting :: Int
stContentBlockNesting =
          PState -> Int
stContentBlockNesting PState
st forall a. Num a => a -> a -> a
+ Int
1
      }
  [Markup]
ms <- forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill P Markup
pMarkup (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']')
  P ()
ws
  forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \PState
st ->
    PState
st
      { stLineStartCol :: Int
stLineStartCol = Int
oldLineStartCol,
        stContentBlockNesting :: Int
stContentBlockNesting =
          PState -> Int
stContentBlockNesting PState
st forall a. Num a => a -> a -> a
- Int
1
      }
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [Markup] -> Block
Content [Markup]
ms

pEndOfContent :: P ()
pEndOfContent :: P ()
pEndOfContent =
  forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> do
    Int
blockNesting <- PState -> Int
stContentBlockNesting forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
    if Int
blockNesting forall a. Ord a => a -> a -> Bool
> Int
0
      then forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']'))
      else forall (m :: * -> *) a. MonadPlus m => m a
mzero

-- array-expr ::= '(' ((expr ',') | (expr (',' expr)+ ','?))? ')'
pArrayExpr :: P Expr
pArrayExpr :: P Expr
pArrayExpr =
  forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$
    forall a. P a -> P a
inParens forall a b. (a -> b) -> a -> b
$
      ( do
          Expr
v <- P Expr
pExpr
          [Expr]
vs <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ [Char] -> P [Char]
sym [Char]
"," forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P Expr
pExpr
          if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Expr]
vs
            then forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ [Char] -> P [Char]
sym [Char]
","
            else forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ [Char] -> P [Char]
sym [Char]
","
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [Expr] -> Expr
Array (Expr
v forall a. a -> [a] -> [a]
: [Expr]
vs)
      )
        forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([Expr] -> Expr
Array [] forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ [Char] -> P [Char]
sym [Char]
","))

-- dict-expr ::= '(' (':' | (pair (',' pair)* ','?)) ')'
-- pair ::= (ident | str) ':' expr
pDictExpr :: P Expr
pDictExpr :: P Expr
pDictExpr = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall a. P a -> P a
inParens (P Expr
pEmptyDict forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Expr
pNonemptyDict)
  where
    pEmptyDict :: P Expr
pEmptyDict = [(Identifier, Expr)] -> Expr
Dict forall a. Monoid a => a
mempty forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P [Char]
sym [Char]
":"
    pNonemptyDict :: P Expr
pNonemptyDict = [(Identifier, Expr)] -> Expr
Dict forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
sepEndBy1 ParsecT Text PState Identity (Identifier, Expr)
pPair ([Char] -> P [Char]
sym [Char]
",")
    pPair :: ParsecT Text PState Identity (Identifier, Expr)
pPair = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Identifier
pKey forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([Char] -> P [Char]
sym [Char]
":" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P Expr
pExpr)
    pKey :: P Identifier
pKey = P Identifier
pIdentifier forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Identifier
pStrKey
    pStrKey :: P Identifier
pStrKey = do
      String Text
t <- P Literal
pStr
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Identifier
Identifier Text
t

-- func-expr ::= (params | ident) '=>' expr
pFuncExpr :: P Expr
pFuncExpr :: P Expr
pFuncExpr = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ [Param] -> Expr -> Expr
FuncExpr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState Identity [Param]
pParamsOrIdent forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([Char] -> P [Char]
sym [Char]
"=>" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P Expr
pExpr)
  where
    pParamsOrIdent :: ParsecT Text PState Identity [Param]
pParamsOrIdent =
      ParsecT Text PState Identity [Param]
pParams
        forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ((\Identifier
i -> [Identifier -> Param
NormalParam Identifier
i]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Identifier
pIdentifier)
        forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([Param
SkipParam] forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P [Char]
sym [Char]
"_")

pKeywordExpr :: P Expr
pKeywordExpr :: P Expr
pKeywordExpr =
  P Expr
pLetExpr
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Expr
pSetExpr
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Expr
pShowExpr
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Expr
pIfExpr
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Expr
pWhileExpr
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Expr
pForExpr
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Expr
pImportExpr
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Expr
pIncludeExpr
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Expr
pBreakExpr
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Expr
pContinueExpr
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Expr
pReturnExpr

-- args ::= ('(' (arg (',' arg)* ','?)? ')' content-block*) | content-block+
pArgs :: P [Arg]
pArgs :: P [Arg]
pArgs = do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'(' forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'[')
  [Arg]
args <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] forall a b. (a -> b) -> a -> b
$ forall a. P a -> P a
inParens forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
sepEndBy ParsecT Text PState Identity Arg
pArg ([Char] -> P [Char]
sym [Char]
",")
  [[Markup]]
blocks <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall a b. (a -> b) -> a -> b
$ do
    -- make sure we haven't had a space
    Bool
skippedSpaces <- forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. PState -> Maybe (SourcePos, Text)
stBeforeSpace forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
    if Bool
skippedSpaces
      then forall (m :: * -> *) a. MonadPlus m => m a
mzero
      else do
        Content [Markup]
ms <- P Block
pContent
        forall (f :: * -> *) a. Applicative f => a -> f a
pure [Markup]
ms
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [Arg]
args forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map [Markup] -> Arg
BlockArg [[Markup]]
blocks

-- arg ::= (ident ':')? expr
pArg :: P Arg
pArg :: ParsecT Text PState Identity Arg
pArg = ParsecT Text PState Identity Arg
pKeyValArg forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text PState Identity Arg
pSpreadArg forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text PState Identity Arg
pNormalArg
  where
    pKeyValArg :: ParsecT Text PState Identity Arg
pKeyValArg = Identifier -> Expr -> Arg
KeyValArg 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
try (P Identifier
pIdentifier forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* [Char] -> P [Char]
sym [Char]
":") forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P Expr
pExpr
    pNormalArg :: ParsecT Text PState Identity Arg
pNormalArg =
      Expr -> Arg
NormalArg
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Block -> Expr
Block forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Markup] -> Block
Content forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
: []) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. P a -> P a
lexeme (P Markup
pRawBlock forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Markup
pRawInline)) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Expr
pExpr)
    pSpreadArg :: ParsecT Text PState Identity Arg
pSpreadArg = Expr -> Arg
SpreadArg 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
try ([Char] -> P [Char]
string [Char]
".." forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P Expr
pExpr)

-- params ::= '(' (param (',' param)* ','?)? ')'
pParams :: P [Param]
pParams :: ParsecT Text PState Identity [Param]
pParams = forall a. P a -> P a
inParens forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
sepEndBy P Param
pParam ([Char] -> P [Char]
sym [Char]
",")

-- param ::= ident (':' expr)?
pParam :: P Param
pParam :: P Param
pParam =
  P Param
pSinkParam forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Param
pDestructuringParam forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Param
pNormalOrDefaultParam forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Param
pSkipParam
  where
    pSinkParam :: P Param
pSinkParam =
      Maybe Identifier -> Param
SinkParam
        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
try
          ( [Char] -> P [Char]
sym [Char]
".."
              forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Identifier
pIdentifier)
          )
    pSkipParam :: P Param
pSkipParam = Param
SkipParam forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P [Char]
sym [Char]
"_"
    pNormalOrDefaultParam :: P Param
pNormalOrDefaultParam = do
      Identifier
i <- P Identifier
pIdentifier
      (Identifier -> Expr -> Param
DefaultParam Identifier
i forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> P [Char]
sym [Char]
":" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P Expr
pExpr)) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Identifier -> Param
NormalParam Identifier
i)
    pDestructuringParam :: P Param
pDestructuringParam = do
      DestructuringBind [BindPart]
parts <- P Bind
pDestructuringBind
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [BindPart] -> Param
DestructuringParam [BindPart]
parts

pBind :: P Bind
pBind :: P Bind
pBind = P Bind
pBasicBind forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Bind
pDestructuringBind

pBasicBind :: P Bind
pBasicBind :: P Bind
pBasicBind = Maybe Identifier -> Bind
BasicBind 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
try (ParsecT Text PState Identity (Maybe Identifier)
pBindIdentifier forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a. P a -> P a
inParens ParsecT Text PState Identity (Maybe Identifier)
pBindIdentifier)

pBindIdentifier :: P (Maybe Identifier)
pBindIdentifier :: ParsecT Text PState Identity (Maybe Identifier)
pBindIdentifier = (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Identifier
pIdentifier) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P [Char]
sym [Char]
"_")

pDestructuringBind :: P Bind
pDestructuringBind :: P Bind
pDestructuringBind =
  forall a. P a -> P a
inParens forall a b. (a -> b) -> a -> b
$
    [BindPart] -> Bind
DestructuringBind forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Text PState Identity BindPart
pBindPart forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
`sepEndBy` ([Char] -> P [Char]
sym [Char]
","))
  where
    pBindPart :: ParsecT Text PState Identity BindPart
pBindPart = do
      Bool
sink <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Bool
False forall a b. (a -> b) -> a -> b
$ Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P [Char]
string [Char]
".."
      if Bool
sink
        then do
          Maybe Identifier
ident <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option forall a. Maybe a
Nothing ParsecT Text PState Identity (Maybe Identifier)
pBindIdentifier -- ..
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Maybe Identifier -> BindPart
Sink Maybe Identifier
ident
        else do
          Maybe Identifier
ident <- ParsecT Text PState Identity (Maybe Identifier)
pBindIdentifier
          case Maybe Identifier
ident of
            Maybe Identifier
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Identifier -> BindPart
Simple Maybe Identifier
ident)
            Just Identifier
key ->
              (Identifier -> Maybe Identifier -> BindPart
WithKey Identifier
key forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> P [Char]
sym [Char]
":" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text PState Identity (Maybe Identifier)
pBindIdentifier))
                forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Identifier -> BindPart
Simple Maybe Identifier
ident)

-- let-expr ::= 'let' ident params? '=' expr
pLetExpr :: P Expr
pLetExpr :: P Expr
pLetExpr = do
  [Char] -> P ()
pKeyword [Char]
"let"
  Bind
bind <- P Bind
pBind
  case Bind
bind of
    BasicBind Maybe Identifier
mbname -> do
      Maybe [Param]
mbparams <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState Identity [Param]
pParams
      Maybe Expr
mbexpr <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> P [Char]
sym [Char]
"=" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P Expr
pExpr)
      case (Maybe [Param]
mbparams, Maybe Expr
mbexpr, Maybe Identifier
mbname) of
        (Maybe [Param]
Nothing, Maybe Expr
Nothing, Maybe Identifier
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bind -> Expr -> Expr
Let Bind
bind (Literal -> Expr
Literal Literal
None)
        (Maybe [Param]
Nothing, Just Expr
expr, Maybe Identifier
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bind -> Expr -> Expr
Let Bind
bind Expr
expr
        (Just [Param]
params, Just Expr
expr, Just Identifier
name) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Identifier -> [Param] -> Expr -> Expr
LetFunc Identifier
name [Param]
params Expr
expr
        (Just [Param]
_, Just Expr
_, Maybe Identifier
Nothing) -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"expected name for function"
        (Just [Param]
_, Maybe Expr
Nothing, Maybe Identifier
_) -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"expected expression for let binding"
    Bind
_ -> Bind -> Expr -> Expr
Let Bind
bind forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> P [Char]
sym [Char]
"=" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P Expr
pExpr)

-- set-expr ::= 'set' expr args
pSetExpr :: P Expr
pSetExpr :: P Expr
pSetExpr = do
  Expr
set <- [Char] -> P ()
pKeyword [Char]
"set" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Expr -> [Arg] -> Expr
Set forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Expr
pQualifiedIdentifier forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P [Arg]
pArgs)
  Expr -> Expr
addCondition <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ [Char] -> P ()
pKeyword [Char]
"if" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ((\Expr
c Expr
x -> [(Expr, Expr)] -> Expr
If [(Expr
c, Expr
x)]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Expr
pExpr)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Expr -> Expr
addCondition Expr
set

pShowExpr :: P Expr
pShowExpr :: P Expr
pShowExpr = do
  [Char] -> P ()
pKeyword [Char]
"show"
  Maybe Expr
from <- (forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P [Char]
sym [Char]
":") forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (P Expr
pBasicExpr forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* [Char] -> P [Char]
sym [Char]
":")
  Expr
to <- P Expr
pBasicExpr
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Maybe Expr -> Expr -> Expr
Show Maybe Expr
from Expr
to

-- if-expr ::= 'if' expr block ('else' 'if' expr block)* ('else' block)?
pIfExpr :: P Expr
pIfExpr :: P Expr
pIfExpr = do
  (Expr, Expr)
a <- ParsecT Text PState Identity (Expr, Expr)
pIf
  [(Expr, Expr)]
as <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([Char] -> P ()
pKeyword [Char]
"else" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text PState Identity (Expr, Expr)
pIf)
  [(Expr, Expr)]
finalElse <-
    forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] forall a b. (a -> b) -> a -> b
$
      -- we represent the final "else" as a conditional with expr True:
      (forall a. a -> [a] -> [a]
: []) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Literal -> Expr
Literal (Bool -> Literal
Boolean Bool
True),) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> P ()
pKeyword [Char]
"else" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P Expr
pBlock)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [(Expr, Expr)] -> Expr
If ((Expr, Expr)
a forall a. a -> [a] -> [a]
: [(Expr, Expr)]
as forall a. [a] -> [a] -> [a]
++ [(Expr, Expr)]
finalElse)
  where
    pIf :: ParsecT Text PState Identity (Expr, Expr)
pIf = [Char] -> P ()
pKeyword [Char]
"if" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Expr
pExpr forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P Expr
pBlock)

-- while-expr ::= 'while' expr block
pWhileExpr :: P Expr
pWhileExpr :: P Expr
pWhileExpr = [Char] -> P ()
pKeyword [Char]
"while" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Expr -> Expr -> Expr
While forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Expr
pExpr forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P Expr
pBlock)

-- for-expr ::= 'for' bind 'in' expr block
pForExpr :: P Expr
pForExpr :: P Expr
pForExpr =
  [Char] -> P ()
pKeyword [Char]
"for" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Bind -> Expr -> Expr -> Expr
For forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Bind
pBind forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([Char] -> P ()
pKeyword [Char]
"in" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P Expr
pExpr) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P Expr
pBlock)

pImportExpr :: P Expr
pImportExpr :: P Expr
pImportExpr = [Char] -> P ()
pKeyword [Char]
"import" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Expr -> Imports -> Expr
Import forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Expr
pExpr forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text PState Identity Imports
pImportItems)
  where
    pImportItems :: ParsecT Text PState Identity Imports
pImportItems =
      forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Imports
NoIdentifiers forall a b. (a -> b) -> a -> b
$
        [Char] -> P [Char]
sym [Char]
":"
          forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ( (Imports
AllIdentifiers forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P [Char]
sym [Char]
"*")
                 forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([Identifier] -> Imports
SomeIdentifiers forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
sepEndBy P Identifier
pIdentifier ([Char] -> P [Char]
sym [Char]
","))
             )

pBreakExpr :: P Expr
pBreakExpr :: P Expr
pBreakExpr = Expr
Break forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P ()
pKeyword [Char]
"break"

pContinueExpr :: P Expr
pContinueExpr :: P Expr
pContinueExpr = Expr
Continue forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P ()
pKeyword [Char]
"continue"

pReturnExpr :: P Expr
pReturnExpr :: P Expr
pReturnExpr = do
  SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  [Char] -> P ()
pKeyword [Char]
"return"
  SourcePos
pos' <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  if SourcePos -> Int
sourceLine SourcePos
pos' forall a. Ord a => a -> a -> Bool
> SourcePos -> Int
sourceLine SourcePos
pos
    then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Maybe Expr -> Expr
Return forall a. Maybe a
Nothing
    else Maybe Expr -> Expr
Return forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Expr
pExpr))

pIncludeExpr :: P Expr
pIncludeExpr :: P Expr
pIncludeExpr = Expr -> Expr
Include forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> P ()
pKeyword [Char]
"include" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P Expr
pExpr)

pBindExpr :: P Expr
pBindExpr :: P Expr
pBindExpr =
  Bind -> Expr
Binding 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
try (P Bind
pBind forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ([Char] -> P ()
op [Char]
"="))