{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
module Typst.Parse
( parseTypst,
)
where
import Data.List (sortOn)
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, isNothing)
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 Typst.Shorthands (mathSymbolShorthands)
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,
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
'>')
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
'=')
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
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'
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 =
[
[ 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
<$ (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([Char] -> P ()
op [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
lookAhead P Markup
mNumber))) 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
<$ (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([Char] -> P ()
op [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
lookAhead P Markup
mNumber))) Assoc
AssocLeft
],
[ 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
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ forall a. Maybe a -> Bool
isNothing Maybe (SourcePos, Text)
mbBeforeSpace
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]
)
],
[ 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
],
[ 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
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ forall a. Maybe a -> Bool
isNothing Maybe (SourcePos, Text)
mbBeforeSpace
forall a. P a -> P a
lexeme 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 :: * -> *) 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 :: * -> *) a. Applicative f => a -> f a
pure (\Markup
expr -> Maybe Text -> Maybe Text -> [Markup] -> Markup
MGroup forall a. Maybe a
Nothing forall a. Maybe a
Nothing [Markup
expr, Text -> Markup
Text Text
"!"]))
],
[ 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 (MAttach Maybe Markup
Nothing Maybe Markup
y Markup
x) Markup
z = Maybe Markup -> Maybe Markup -> Markup -> Markup
MAttach (forall a. a -> Maybe a
Just (Markup -> Markup
hideOuterParens Markup
z)) Maybe Markup
y Markup
x
attachBottom Markup
z (MAttach Maybe Markup
Nothing Maybe Markup
y Markup
x) = Maybe Markup -> Maybe Markup -> Markup -> Markup
MAttach (forall a. a -> Maybe a
Just (Markup -> Markup
hideOuterParens Markup
x)) Maybe Markup
y Markup
z
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
z (MAttach Maybe Markup
x Maybe Markup
Nothing Markup
y) = Maybe Markup -> Maybe Markup -> Markup -> Markup
MAttach Maybe Markup
x (forall a. a -> Maybe a
Just (Markup -> Markup
hideOuterParens Markup
y)) Markup
z
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
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ forall a. Maybe a -> Bool
isNothing Maybe (SourcePos, Text)
mbBeforeSpace
[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
pMathLiteral)
where
pMathLiteral :: P Expr
pMathLiteral :: P Expr
pMathLiteral = 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
<$> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 (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
mShorthand)
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 u (m :: * -> *) a. 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
pBaseMath :: P Markup
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
mShorthand
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
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 u (m :: * -> *) a. 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 u (m :: * -> *) a. 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
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)))
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]
"&"
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 = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ 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 u (m :: * -> *) a. 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]
";")
[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
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 a. P a -> P a
lexeme 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
*> (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
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 b c a. (b -> c) -> (a -> b) -> a -> c
. PState -> Maybe (SourcePos, Text)
stBeforeSpace
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]
mShorthand :: P Markup
mShorthand :: P Markup
mShorthand =
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SourcePos
pos ->
forall a. P a -> P a
lexeme (SourcePos -> Expr -> Markup
Code SourcePos
pos 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
choice (forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> P Expr
toShorthandParser [(Text, Text)]
shorthands))
where
shorthands :: [(Text, Text)]
shorthands = forall a. [a] -> [a]
reverse (forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Text -> Int
T.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Text, Text)]
mathSymbolShorthands)
toShorthandParser :: (Text, Text) -> P Expr
toShorthandParser (Text
short, Text
symname) =
Text -> Expr
toSym Text
symname 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 [Char]
string (Text -> [Char]
T.unpack Text
short))
toSym :: Text -> Expr
toSym Text
name =
case forall a b. (a -> b) -> [a] -> [b]
map (Identifier -> Expr
Ident forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Identifier
Identifier) forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> [Text]
T.split (forall a. Eq a => a -> a -> Bool
== Char
'.') Text
name of
[] -> Literal -> Expr
Literal Literal
None
[Expr
i] -> Expr
i
(Expr
i:[Expr]
is) -> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Expr -> Expr -> Expr
FieldAccess Expr
i [Expr]
is
mSymbol :: P Markup
mSymbol :: P Markup
mSymbol =
forall a. P a -> P a
lexeme ( 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
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
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
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 u (m :: * -> *) a. 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 u (m :: * -> *) a. 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
pComment :: P Markup
= 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 ()
= 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 ()
= 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 u (m :: * -> *) a. 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
[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 u (m :: * -> *) a. 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 u (m :: * -> *) a. 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)
[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
. forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
some
((do [Char]
xs <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
some forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum
[Char] -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
xs forall a. Semigroup a => a -> a -> a
<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (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)
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] -> Text
T.pack [Char]
xs))
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([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))))
)
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
<|> (Char
'\\' 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
'"' 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
'\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 u (m :: * -> *) a. 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 u (m :: * -> *) a. 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 u (m :: * -> *) a. 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)
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]
";")
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
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)
isIdentStart :: Char -> Bool
isIdentStart :: Char -> Bool
isIdentStart Char
c = Char
c forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
||
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
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)
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
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))
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
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ forall a. Maybe a -> Bool
isNothing Maybe (SourcePos, Text)
mbBeforeSpace
[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
)
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 =
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]
++
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]
++ [
[ 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
],
[ 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
],
[ 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
],
[ 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
],
[ 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
],
[ 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 u (m :: * -> *) a. 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 u (m :: * -> *) a. 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 u (m :: * -> *) a. 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 u (m :: * -> *) a. 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 u (m :: * -> *) a. 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 -> Bool) -> ParsecT s u m Char
satisfy (forall a. Eq a => a -> a -> Bool
/= Char
'"')) (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)
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
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
Spreadable Expr
v <- forall a. P (Spreadable a)
pSpread forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (forall a. a -> Spreadable a
Reg forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Expr
pExpr)
[Spreadable 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
*> (forall a. P (Spreadable a)
pSpread forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (forall a. a -> Spreadable a
Reg forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Expr
pExpr))
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Spreadable 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
$ [Spreadable Expr] -> Expr
Array (Spreadable Expr
v forall a. a -> [a] -> [a]
: [Spreadable Expr]
vs)
)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([Spreadable 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]
","))
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 = [Spreadable (Expr, 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 = [Spreadable (Expr, 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 (forall a. P (Spreadable a)
pSpread forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text PState Identity (Spreadable (Expr, Expr))
pPair) ([Char] -> P [Char]
sym [Char]
",")
pPair :: ParsecT Text PState Identity (Spreadable (Expr, Expr))
pPair = forall a. a -> Spreadable a
Reg forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> 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
<*> 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))
pSpread :: P (Spreadable a)
pSpread :: forall a. P (Spreadable a)
pSpread = 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]
".." forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (forall a. Expr -> Spreadable a
Spr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Expr
pExpr)
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
<|> (do Identifier
i <- P Identifier
pIdentifier
if Identifier
i forall a. Eq a => a -> a -> Bool
== Identifier
"_"
then forall (f :: * -> *) a. Applicative f => a -> f a
pure [Param
SkipParam]
else forall (f :: * -> *) a. Applicative f => a -> f a
pure [Identifier -> Param
NormalParam Identifier
i])
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
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
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
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)
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]
",")
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 = do
Identifier
ident <- P Identifier
pIdentifier
if Identifier
ident forall a. Eq a => a -> a -> Bool
== Identifier
"_"
then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
else forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Identifier
ident
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)
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)
pSetExpr :: P Expr
pSetExpr :: P Expr
pSetExpr = do
Int
oldAllowNewlines <- 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
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 = Int
0}
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)
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 = Int
oldAllowNewlines}
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
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
$
(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)
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)
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 =
([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, Maybe 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 ParsecT Text PState Identity (Identifier, Maybe Identifier)
pIdentifierAs ([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
<|> (Maybe Identifier -> Imports
NoIdentifiers forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState Identity (Maybe Identifier)
pAs)
pIdentifierAs :: ParsecT Text PState Identity (Identifier, Maybe Identifier)
pIdentifierAs = do
Identifier
ident <- P Identifier
pIdentifier
Maybe Identifier
mbAs <- ParsecT Text PState Identity (Maybe Identifier)
pAs
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Identifier
ident, Maybe Identifier
mbAs)
pAs :: ParsecT Text PState Identity (Maybe Identifier)
pAs = 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 ()
pKeyword [Char]
"as" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P Identifier
pIdentifier)
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]
"="))