{-# 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)

-- import Debug.Trace

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

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

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

type P = Parsec Text PState

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

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

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

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

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

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

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

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

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

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

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

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

mathOperatorTable :: [[Operator Text PState Identity Markup]]
mathOperatorTable :: [[Operator Text PState Identity Markup]]
mathOperatorTable =
  [ -- precedence 7 -- attachment with number, e.g. a_1 (see #17)
    [ 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
    ],
    -- precedence 6
    [ forall s u (m :: * -> *) a.
ParsecT s u m (a -> a) -> Operator s u m a
Postfix
        ( forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
            Maybe (SourcePos, Text)
mbBeforeSpace <- PState -> Maybe (SourcePos, Text)
stBeforeSpace forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
            -- NOTE: can't have space before () or [] arg in a
            -- function call! to prevent bugs with e.g. 'if 2<3 [...]'.
            forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ 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]
        )
    ],
    -- precedence 5 -- attachment with non-number, e.g. a_x
    [ forall s u (m :: * -> *) a.
ParsecT s u m (a -> a -> a) -> Assoc -> Operator s u m a
Infix (Markup -> Markup -> Markup
attachBottom forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P ()
op [Char]
"_") Assoc
AssocLeft,
      forall s u (m :: * -> *) a.
ParsecT s u m (a -> a -> a) -> Assoc -> Operator s u m a
Infix (Markup -> Markup -> Markup
attachTop forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P ()
op [Char]
"^") Assoc
AssocLeft
    ],
    -- precedence 4  -- factorial needs to take precedence over fraction
    [ 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
"!"]))
    ],
    -- precedence 3
    [ forall s u (m :: * -> *) a.
ParsecT s u m (a -> a -> a) -> Assoc -> Operator s u m a
Infix (Markup -> Markup -> Markup
makeFrac forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P ()
op [Char]
"/") Assoc
AssocLeft
    ]
  ]


 -- MAttach (Maybe bottom) (Maybe top) base

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
        -- NOTE: can't have space before () or [] arg in a
        -- function call! to prevent bugs with e.g. 'if 2<3 [...]'.
        forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ 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
  -- ensure space in e.g. x "is natural":
  Maybe (SourcePos, Text)
mbAfterSpace <- PState -> Maybe (SourcePos, Text)
stBeforeSpace forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    Text -> Markup
Text forall a b. (a -> b) -> a -> b
$
      (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (forall a b. a -> b -> a
const Text
" ") Maybe (SourcePos, Text)
mbBeforeSpace)
        forall a. Semigroup a => a -> a -> a
<> Text
t
        forall a. Semigroup a => a -> a -> a
<> (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (forall a b. a -> b -> a
const Text
" ") Maybe (SourcePos, Text)
mbAfterSpace)

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

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

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

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

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

mCode :: P Markup
mCode :: P Markup
mCode = forall 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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

pText :: P Markup
pText :: P Markup
pText = Text -> Markup
Text forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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)

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

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

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

-- ident_start ::= unicode(XID_Start)
-- ID_Start characters are derived from the Unicode General_Category of
-- uppercase letters, lowercase letters, titlecase letters, modifier letters,
-- other letters, letter numbers, plus Other_ID_Start, minus Pattern_Syntax and
-- Pattern_White_Space code points.
isIdentStart :: Char -> Bool
isIdentStart :: Char -> Bool
isIdentStart Char
c = 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

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

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

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

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

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

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

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

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

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

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

functionCall :: Operator Text PState Identity Expr
functionCall :: Operator Text PState Identity Expr
functionCall =
  forall s u (m :: * -> *) a.
ParsecT s u m (a -> a) -> Operator s u m a
Postfix
    ( do
        Maybe (SourcePos, Text)
mbBeforeSpace <- PState -> Maybe (SourcePos, Text)
stBeforeSpace forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
        -- NOTE: can't have space before () or [] arg in a
        -- function call! to prevent bugs with e.g. 'if 2<3 [...]'.
        forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ 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
    )

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

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

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

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

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

pNumber :: P (Either Integer Double)
pNumber :: P (Either Integer Double)
pNumber = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  [Char]
pref <- [Char] -> P [Char]
string [Char]
"0b" forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [Char] -> P [Char]
string [Char]
"0x" forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [Char] -> P [Char]
string [Char]
"0o" forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure [Char]
""
  case [Char]
pref of
    [Char]
"0b" -> do
      [Integer]
nums <- forall s 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)

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

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

-- array-expr ::= '(' ((expr ',') | (expr (',' expr)+ ','?))? ')'
pArrayExpr :: P Expr
pArrayExpr :: P Expr
pArrayExpr =
  forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$
    forall a. P a -> P a
inParens forall a b. (a -> b) -> a -> b
$
      ( do
          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]
","))

-- dict-expr ::= '(' (':' | (pair (',' pair)* ','?)) ')'
-- pair ::= (ident | str) ':' expr
pDictExpr :: P Expr
pDictExpr :: P Expr
pDictExpr = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall a. P a -> P a
inParens (P Expr
pEmptyDict forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P Expr
pNonemptyDict)
  where
    pEmptyDict :: P Expr
pEmptyDict = [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)

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

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

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

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

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

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

pBasicBind :: P Bind
pBasicBind :: P Bind
pBasicBind = Maybe Identifier -> Bind
BasicBind forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text PState Identity (Maybe Identifier)
pBindIdentifier forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall a. P a -> P a
inParens ParsecT Text PState Identity (Maybe Identifier)
pBindIdentifier)

pBindIdentifier :: P (Maybe Identifier)
pBindIdentifier :: ParsecT Text PState Identity (Maybe Identifier)
pBindIdentifier = 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)

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

-- set-expr ::= 'set' expr args
pSetExpr :: P Expr
pSetExpr :: P Expr
pSetExpr = do
  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
  -- see #23 -- 'set' doesn't go with 'if' unless it's on the same line
  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

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

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

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

pImportExpr :: P Expr
pImportExpr :: P Expr
pImportExpr = [Char] -> P ()
pKeyword [Char]
"import" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Expr -> Imports -> Expr
Import forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P Expr
pExpr forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text PState Identity Imports
pImportItems)
  where
    pImportItems :: ParsecT Text PState Identity Imports
pImportItems =
        ([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]
"="))