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

-- | Parse text into a list of 'Markup' (or a Parsec @ParseError@).
parseTypst ::
  -- | Filepath to Typst source text, only used for error messages
  FilePath ->
  -- | The Typst source text 
  Text ->
  Either ParseError [Markup]
parseTypst :: [Char] -> Text -> Either ParseError [Markup]
parseTypst [Char]
fp Text
inp =
  case Parsec Text PState [Markup]
-> PState -> [Char] -> Text -> Either ParseError [Markup]
forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> [Char] -> s -> Either ParseError a
runParser (ParsecT Text PState Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT Text PState Identity ()
-> Parsec Text PState [Markup] -> Parsec Text PState [Markup]
forall a b.
ParsecT Text PState Identity a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text PState Identity Markup -> Parsec Text PState [Markup]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text PState Identity Markup
pMarkup Parsec Text PState [Markup]
-> ParsecT Text PState Identity () -> Parsec Text PState [Markup]
forall a b.
ParsecT Text PState Identity a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text PState Identity ()
pEndOfContent) PState
initialState [Char]
fp Text
inp of
    Left ParseError
e -> ParseError -> Either ParseError [Markup]
forall a b. a -> Either a b
Left ParseError
e
    Right [Markup]
r -> [Markup] -> Either ParseError [Markup]
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]
(Int -> PState -> ShowS)
-> (PState -> [Char]) -> ([PState] -> ShowS) -> Show PState
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PState -> ShowS
showsPrec :: Int -> PState -> ShowS
$cshow :: PState -> [Char]
show :: PState -> [Char]
$cshowList :: [PState] -> ShowS
showList :: [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 = Maybe (SourcePos, Text)
forall a. Maybe a
Nothing,
      stContentBlockNesting :: Int
stContentBlockNesting = Int
0
    }

type P = Parsec Text PState

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

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

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

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

op :: String -> P ()
op :: [Char] -> ParsecT Text PState Identity ()
op [Char]
s = ParsecT Text PState Identity () -> ParsecT Text PState Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text PState Identity ()
 -> ParsecT Text PState Identity ())
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity ()
forall a b. (a -> b) -> a -> b
$ ParsecT Text PState Identity () -> ParsecT Text PState Identity ()
forall a. P a -> P a
lexeme (ParsecT Text PState Identity ()
 -> ParsecT Text PState Identity ())
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity ()
forall a b. (a -> b) -> a -> b
$ do
  P [Char] -> ParsecT Text PState Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (P [Char] -> ParsecT Text PState Identity ())
-> P [Char] -> ParsecT Text PState Identity ()
forall a b. (a -> b) -> a -> b
$ [Char] -> P [Char]
string [Char]
s
  Bool
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
    ( [Char]
s [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"+"
        Bool -> Bool -> Bool
|| [Char]
s [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"-"
        Bool -> Bool -> Bool
|| [Char]
s [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"*"
        Bool -> Bool -> Bool
|| [Char]
s [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"/"
        Bool -> Bool -> Bool
|| [Char]
s [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"="
        Bool -> Bool -> Bool
|| [Char]
s [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"<"
        Bool -> Bool -> Bool
|| [Char]
s [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
">"
        Bool -> Bool -> Bool
|| [Char]
s [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"!"
    )
    (ParsecT Text PState Identity ()
 -> ParsecT Text PState Identity ())
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity ()
forall a b. (a -> b) -> a -> b
$ ParsecT Text PState Identity Char
-> ParsecT Text PState Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (Char -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'=')
  Bool
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Char]
s [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"-") (ParsecT Text PState Identity ()
 -> ParsecT Text PState Identity ())
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity ()
forall a b. (a -> b) -> a -> b
$
    ParsecT Text PState Identity Char
-> ParsecT Text PState Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (Char -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'>') -- arrows
  Bool
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Char]
s [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"<") (ParsecT Text PState Identity ()
 -> ParsecT Text PState Identity ())
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity ()
forall a b. (a -> b) -> a -> b
$
    ParsecT Text PState Identity Char
-> ParsecT Text PState Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (Char -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-' ParsecT Text PState Identity Char
-> ParsecT Text PState Identity Char
-> ParsecT Text PState Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'=') -- arrows
  Bool
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Char]
s [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"=") (ParsecT Text PState Identity ()
 -> ParsecT Text PState Identity ())
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity ()
forall a b. (a -> b) -> a -> b
$
    ParsecT Text PState Identity Char
-> ParsecT Text PState Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (Char -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'>' ParsecT Text PState Identity Char
-> ParsecT Text PState Identity Char
-> ParsecT Text PState Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT Text PState Identity Char
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
  (PState -> PState) -> ParsecT Text PState Identity ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((PState -> PState) -> ParsecT Text PState Identity ())
-> (PState -> PState) -> ParsecT Text PState Identity ()
forall a b. (a -> b) -> a -> b
$ \PState
st -> PState
st {stAllowNewlines = stAllowNewlines st + 1}
  a
res <- P a
pa
  (PState -> PState) -> ParsecT Text PState Identity ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((PState -> PState) -> ParsecT Text PState Identity ())
-> (PState -> PState) -> ParsecT Text PState Identity ()
forall a b. (a -> b) -> a -> b
$ \PState
st -> PState
st {stAllowNewlines = stAllowNewlines st - 1}
  a -> P a
forall a. a -> ParsecT Text PState Identity a
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 = P a -> P a
forall a. P a -> P a
withNewlines (P [Char] -> ParsecT Text PState Identity Char -> P a -> P a
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]
"(") (Char -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
')') P a
pa) P a -> ParsecT Text PState Identity () -> P a
forall a b.
ParsecT Text PState Identity a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text PState Identity ()
ws

inBraces :: P a -> P a
inBraces :: forall a. P a -> P a
inBraces P a
pa = P a -> P a
forall a. P a -> P a
withNewlines (P [Char] -> ParsecT Text PState Identity Char -> P a -> P a
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]
"{") (Char -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'}') P a
pa) P a -> ParsecT Text PState Identity () -> P a
forall a b.
ParsecT Text PState Identity a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text PState Identity ()
ws

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

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

pSymbol :: P Markup
pSymbol :: ParsecT Text PState Identity Markup
pSymbol = do
  Int
blockNesting <- PState -> Int
stContentBlockNesting (PState -> Int)
-> ParsecT Text PState Identity PState
-> ParsecT Text PState Identity Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState Identity PState
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 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
']' Bool -> Bool -> Bool
|| Int
blockNesting Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0)
  Text -> Markup
Text (Text -> Markup) -> (Char -> Text) -> Char -> Markup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton (Char -> Markup)
-> ParsecT Text PState Identity Char
-> ParsecT Text PState Identity Markup
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> ParsecT Text PState Identity Char
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 :: ParsecT Text PState Identity Markup
pEquation = do
  ParsecT Text PState Identity Char
-> ParsecT Text PState Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Text PState Identity Char
 -> ParsecT Text PState Identity ())
-> ParsecT Text PState Identity Char
-> ParsecT Text PState Identity ()
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'$'
  ParsecT Text PState Identity Markup
-> ParsecT Text PState Identity Markup
forall a. P a -> P a
withNewlines (ParsecT Text PState Identity Markup
 -> ParsecT Text PState Identity Markup)
-> ParsecT Text PState Identity Markup
-> ParsecT Text PState Identity Markup
forall a b. (a -> b) -> a -> b
$ do
    Bool
display <- Bool
-> ParsecT Text PState Identity Bool
-> ParsecT Text PState Identity Bool
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Bool
False (ParsecT Text PState Identity Bool
 -> ParsecT Text PState Identity Bool)
-> ParsecT Text PState Identity Bool
-> ParsecT Text PState Identity Bool
forall a b. (a -> b) -> a -> b
$ Bool
True Bool
-> ParsecT Text PState Identity Char
-> ParsecT Text PState Identity Bool
forall a b.
a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Text PState Identity Char
-> ParsecT Text PState Identity Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT Text PState Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
    ParsecT Text PState Identity ()
ws
    [Markup]
maths <- ParsecT Text PState Identity Markup -> Parsec Text PState [Markup]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text PState Identity Markup
pMath
    ParsecT Text PState Identity Char
-> ParsecT Text PState Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Text PState Identity Char
 -> ParsecT Text PState Identity ())
-> ParsecT Text PState Identity Char
-> ParsecT Text PState Identity ()
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'$'
    Markup -> ParsecT Text PState Identity Markup
forall a. a -> ParsecT Text PState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Markup -> ParsecT Text PState Identity Markup)
-> Markup -> ParsecT Text PState Identity Markup
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)
    [ ParsecT Text PState Identity (Markup -> Markup -> Markup)
-> Assoc -> Operator Text PState Identity Markup
forall s u (m :: * -> *) a.
ParsecT s u m (a -> a -> a) -> Assoc -> Operator s u m a
Infix (Markup -> Markup -> Markup
attachBottom (Markup -> Markup -> Markup)
-> ParsecT Text PState Identity Markup
-> ParsecT Text PState Identity (Markup -> Markup -> Markup)
forall a b.
a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (ParsecT Text PState Identity Markup
-> ParsecT Text PState Identity Markup
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([Char] -> ParsecT Text PState Identity ()
op [Char]
"_" ParsecT Text PState Identity ()
-> ParsecT Text PState Identity Markup
-> ParsecT Text PState Identity Markup
forall a b.
ParsecT Text PState Identity a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text PState Identity Markup
-> ParsecT Text PState Identity Markup
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT Text PState Identity Markup
mNumber))) Assoc
AssocLeft,
      ParsecT Text PState Identity (Markup -> Markup -> Markup)
-> Assoc -> Operator Text PState Identity Markup
forall s u (m :: * -> *) a.
ParsecT s u m (a -> a -> a) -> Assoc -> Operator s u m a
Infix (Markup -> Markup -> Markup
attachTop (Markup -> Markup -> Markup)
-> ParsecT Text PState Identity Markup
-> ParsecT Text PState Identity (Markup -> Markup -> Markup)
forall a b.
a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (ParsecT Text PState Identity Markup
-> ParsecT Text PState Identity Markup
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([Char] -> ParsecT Text PState Identity ()
op [Char]
"^" ParsecT Text PState Identity ()
-> ParsecT Text PState Identity Markup
-> ParsecT Text PState Identity Markup
forall a b.
ParsecT Text PState Identity a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text PState Identity Markup
-> ParsecT Text PState Identity Markup
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT Text PState Identity Markup
mNumber))) Assoc
AssocLeft
    ],
    -- precedence 6
    [ ParsecT Text PState Identity (Markup -> Markup)
-> Operator Text PState Identity Markup
forall s u (m :: * -> *) a.
ParsecT s u m (a -> a) -> Operator s u m a
Postfix
        ( ParsecT Text PState Identity (Markup -> Markup)
-> ParsecT Text PState Identity (Markup -> Markup)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text PState Identity (Markup -> Markup)
 -> ParsecT Text PState Identity (Markup -> Markup))
-> ParsecT Text PState Identity (Markup -> Markup)
-> ParsecT Text PState Identity (Markup -> Markup)
forall a b. (a -> b) -> a -> b
$ do
            Maybe (SourcePos, Text)
mbBeforeSpace <- PState -> Maybe (SourcePos, Text)
stBeforeSpace (PState -> Maybe (SourcePos, Text))
-> ParsecT Text PState Identity PState
-> ParsecT Text PState Identity (Maybe (SourcePos, Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState Identity PState
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 [...]'.
            Bool -> ParsecT Text PState Identity ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT Text PState Identity ())
-> Bool -> ParsecT Text PState Identity ()
forall a b. (a -> b) -> a -> b
$ Maybe (SourcePos, Text) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (SourcePos, Text)
mbBeforeSpace
            Markup
args <- Char -> Char -> Bool -> ParsecT Text PState Identity Markup
mGrouped Char
'(' Char
')' Bool
True
            (Markup -> Markup)
-> ParsecT Text PState Identity (Markup -> Markup)
forall a. a -> ParsecT Text PState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Markup -> Markup)
 -> ParsecT Text PState Identity (Markup -> Markup))
-> (Markup -> Markup)
-> ParsecT Text PState Identity (Markup -> Markup)
forall a b. (a -> b) -> a -> b
$ \Markup
expr -> Maybe Text -> Maybe Text -> [Markup] -> Markup
MGroup Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing [Markup
expr, Markup
args]
        )
    ],
    -- precedence 5 -- attachment with non-number, e.g. a_x
    [ ParsecT Text PState Identity (Markup -> Markup -> Markup)
-> Assoc -> Operator Text PState Identity Markup
forall s u (m :: * -> *) a.
ParsecT s u m (a -> a -> a) -> Assoc -> Operator s u m a
Infix (Markup -> Markup -> Markup
attachBottom (Markup -> Markup -> Markup)
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity (Markup -> Markup -> Markup)
forall a b.
a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> ParsecT Text PState Identity ()
op [Char]
"_") Assoc
AssocLeft,
      ParsecT Text PState Identity (Markup -> Markup -> Markup)
-> Assoc -> Operator Text PState Identity Markup
forall s u (m :: * -> *) a.
ParsecT s u m (a -> a -> a) -> Assoc -> Operator s u m a
Infix (Markup -> Markup -> Markup
attachTop (Markup -> Markup -> Markup)
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity (Markup -> Markup -> Markup)
forall a b.
a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> ParsecT Text PState Identity ()
op [Char]
"^") Assoc
AssocLeft
    ],
    -- precedence 4  -- factorial needs to take precedence over fraction
    [ ParsecT Text PState Identity (Markup -> Markup)
-> Operator Text PState Identity Markup
forall s u (m :: * -> *) a.
ParsecT s u m (a -> a) -> Operator s u m a
Postfix (ParsecT Text PState Identity (Markup -> Markup)
-> ParsecT Text PState Identity (Markup -> Markup)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text PState Identity (Markup -> Markup)
 -> ParsecT Text PState Identity (Markup -> Markup))
-> ParsecT Text PState Identity (Markup -> Markup)
-> ParsecT Text PState Identity (Markup -> Markup)
forall a b. (a -> b) -> a -> b
$ do
                  Maybe (SourcePos, Text)
mbBeforeSpace <- PState -> Maybe (SourcePos, Text)
stBeforeSpace (PState -> Maybe (SourcePos, Text))
-> ParsecT Text PState Identity PState
-> ParsecT Text PState Identity (Maybe (SourcePos, Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState Identity PState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
                  Bool -> ParsecT Text PState Identity ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT Text PState Identity ())
-> Bool -> ParsecT Text PState Identity ()
forall a b. (a -> b) -> a -> b
$ Maybe (SourcePos, Text) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (SourcePos, Text)
mbBeforeSpace
                  ParsecT Text PState Identity () -> ParsecT Text PState Identity ()
forall a. P a -> P a
lexeme (ParsecT Text PState Identity ()
 -> ParsecT Text PState Identity ())
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity ()
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'!' ParsecT Text PState Identity Char
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity ()
forall a b.
ParsecT Text PState Identity a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text PState Identity Char
-> ParsecT Text PState Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (Char -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'=')
                  (Markup -> Markup)
-> ParsecT Text PState Identity (Markup -> Markup)
forall a. a -> ParsecT Text PState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (\Markup
expr -> Maybe Text -> Maybe Text -> [Markup] -> Markup
MGroup Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing [Markup
expr, Text -> Markup
Text Text
"!"]))
    ],
    -- precedence 3
    [ ParsecT Text PState Identity (Markup -> Markup -> Markup)
-> Assoc -> Operator Text PState Identity Markup
forall s u (m :: * -> *) a.
ParsecT s u m (a -> a -> a) -> Assoc -> Operator s u m a
Infix (Markup -> Markup -> Markup
makeFrac (Markup -> Markup -> Markup)
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity (Markup -> Markup -> Markup)
forall a b.
a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> ParsecT Text PState Identity ()
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 (Markup -> Maybe Markup
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 (Markup -> Maybe Markup
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 (Markup -> Maybe Markup
forall a. a -> Maybe a
Just (Markup -> Markup
hideOuterParens Markup
x)) Maybe Markup
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 (Markup -> Maybe Markup
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 (Markup -> Maybe Markup
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 Maybe Markup
forall a. Maybe a
Nothing (Markup -> Maybe Markup
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 Maybe Text
forall a. Maybe a
Nothing Maybe Text
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 = Int
-> [[Operator Text PState Identity Expr]]
-> [[Operator Text PState Identity Expr]]
forall a. Int -> [a] -> [a]
take Int
16 ([[Operator Text PState Identity Expr]]
-> [[Operator Text PState Identity Expr]]
forall a. HasCallStack => [a] -> [a]
cycle [[Operator Text PState Identity Expr
mathFieldAccess], [Operator Text PState Identity Expr
mathFunctionCall]])

mathFieldAccess :: Operator Text PState Identity Expr
mathFieldAccess :: Operator Text PState Identity Expr
mathFieldAccess =
  ParsecT Text PState Identity (Expr -> Expr)
-> Operator Text PState Identity Expr
forall s u (m :: * -> *) a.
ParsecT s u m (a -> a) -> Operator s u m a
Postfix (Expr -> Expr -> Expr
FieldAccess (Expr -> Expr -> Expr)
-> ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity (Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity Expr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([Char] -> P [Char]
sym [Char]
"." P [Char]
-> ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity Expr
forall a b.
ParsecT Text PState Identity a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Identifier -> Expr
Ident (Identifier -> Expr)
-> ParsecT Text PState Identity Identifier
-> ParsecT Text PState Identity Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState Identity Identifier
pMathField)))
 where
  pMathField :: ParsecT Text PState Identity Identifier
pMathField = ParsecT Text PState Identity Identifier
-> ParsecT Text PState Identity Identifier
forall a. P a -> P a
lexeme (ParsecT Text PState Identity Identifier
 -> ParsecT Text PState Identity Identifier)
-> ParsecT Text PState Identity Identifier
-> ParsecT Text PState Identity Identifier
forall a b. (a -> b) -> a -> b
$ do
    Char
d <- (Char -> Bool) -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\Char
c -> Char -> Bool
isIdentStart Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'_')
    [Char]
ds <- ParsecT Text PState Identity Char -> P [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT Text PState Identity Char -> P [Char])
-> ParsecT Text PState Identity Char -> P [Char]
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\Char
c -> Char -> Bool
isIdentContinue Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'_' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'-')
    Identifier -> ParsecT Text PState Identity Identifier
forall a. a -> ParsecT Text PState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Identifier -> ParsecT Text PState Identity Identifier)
-> Identifier -> ParsecT Text PState Identity Identifier
forall a b. (a -> b) -> a -> b
$ Text -> Identifier
Identifier (Text -> Identifier) -> Text -> Identifier
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack (Char
d Char -> ShowS
forall a. a -> [a] -> [a]
: [Char]
ds)

mathFunctionCall :: Operator Text PState Identity Expr
mathFunctionCall :: Operator Text PState Identity Expr
mathFunctionCall =
  ParsecT Text PState Identity (Expr -> Expr)
-> Operator Text PState Identity Expr
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 (PState -> Maybe (SourcePos, Text))
-> ParsecT Text PState Identity PState
-> ParsecT Text PState Identity (Maybe (SourcePos, Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState Identity PState
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 [...]'.
        Bool -> ParsecT Text PState Identity ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT Text PState Identity ())
-> Bool -> ParsecT Text PState Identity ()
forall a b. (a -> b) -> a -> b
$ Maybe (SourcePos, Text) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (SourcePos, Text)
mbBeforeSpace
        [Arg]
args <- P [Arg]
mArgs
        (Expr -> Expr) -> ParsecT Text PState Identity (Expr -> Expr)
forall a. a -> ParsecT Text PState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Expr -> Expr) -> ParsecT Text PState Identity (Expr -> Expr))
-> (Expr -> Expr) -> ParsecT Text PState Identity (Expr -> Expr)
forall a b. (a -> b) -> a -> b
$ \Expr
expr -> Expr -> [Arg] -> Expr
FuncCall Expr
expr [Arg]
args
    )

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

pMathExpr :: P Expr
pMathExpr :: ParsecT Text PState Identity Expr
pMathExpr = [[Operator Text PState Identity Expr]]
-> ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity Expr
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
               (ParsecT Text PState Identity Expr
pMathIdent ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text PState Identity Expr
pMathLiteral)
 where
   pMathLiteral :: P Expr
   pMathLiteral :: ParsecT Text PState Identity Expr
pMathLiteral = Block -> Expr
Block (Block -> Expr) -> ([Markup] -> Block) -> [Markup] -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Markup] -> Block
Content
                    ([Markup] -> Expr)
-> Parsec Text PState [Markup] -> ParsecT Text PState Identity Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState Identity Markup -> Parsec Text PState [Markup]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT Text PState Identity Markup
mLiteral ParsecT Text PState Identity Markup
-> ParsecT Text PState Identity Markup
-> ParsecT Text PState Identity Markup
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text PState Identity Markup
mEscaped ParsecT Text PState Identity Markup
-> ParsecT Text PState Identity Markup
-> ParsecT Text PState Identity Markup
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text PState Identity Markup
mShorthand)

pMathIdent :: P Expr
pMathIdent :: ParsecT Text PState Identity Expr
pMathIdent =
  (Identifier -> Expr
Ident (Identifier -> Expr)
-> ParsecT Text PState Identity Identifier
-> ParsecT Text PState Identity Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState Identity Identifier
pMathIdentifier)
    ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ( do
            ParsecT Text PState Identity Char
-> ParsecT Text PState Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Text PState Identity Char
 -> ParsecT Text PState Identity ())
-> ParsecT Text PState Identity Char
-> ParsecT Text PState Identity ()
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'√'
            (Identifier -> Expr
Ident (Text -> Identifier
Identifier Text
"root") Expr
-> ParsecT Text PState Identity Char
-> ParsecT Text PState Identity Expr
forall a b.
a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Text PState Identity Char
-> ParsecT Text PState Identity Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (Char -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'('))
              ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ( do
                      Markup
x <- ParsecT Text PState Identity Markup
pMath
                      Expr -> ParsecT Text PState Identity Expr
forall a. a -> ParsecT Text PState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr -> ParsecT Text PState Identity Expr)
-> Expr -> ParsecT Text PState Identity Expr
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 :: ParsecT Text PState Identity Identifier
pMathIdentifier = ParsecT Text PState Identity Identifier
-> ParsecT Text PState Identity Identifier
forall a. P a -> P a
lexeme (ParsecT Text PState Identity Identifier
 -> ParsecT Text PState Identity Identifier)
-> ParsecT Text PState Identity Identifier
-> ParsecT Text PState Identity Identifier
forall a b. (a -> b) -> a -> b
$ ParsecT Text PState Identity Identifier
-> ParsecT Text PState Identity Identifier
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text PState Identity Identifier
 -> ParsecT Text PState Identity Identifier)
-> ParsecT Text PState Identity Identifier
-> ParsecT Text PState Identity Identifier
forall a b. (a -> b) -> a -> b
$ do
  Char
d <- (Char -> Bool) -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\Char
c -> Char -> Bool
isIdentStart Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'_')
  [Char]
ds <- ParsecT Text PState Identity Char -> P [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT Text PState Identity Char -> P [Char])
-> ParsecT Text PState Identity Char -> P [Char]
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\Char
c -> Char -> Bool
isIdentContinue Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'_' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'-')
  Identifier -> ParsecT Text PState Identity Identifier
forall a. a -> ParsecT Text PState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Identifier -> ParsecT Text PState Identity Identifier)
-> Identifier -> ParsecT Text PState Identity Identifier
forall a b. (a -> b) -> a -> b
$ Text -> Identifier
Identifier (Text -> Identifier) -> Text -> Identifier
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack (Char
d Char -> ShowS
forall a. a -> [a] -> [a]
: [Char]
ds)

pMath :: P Markup
pMath :: ParsecT Text PState Identity Markup
pMath = [[Operator Text PState Identity Markup]]
-> ParsecT Text PState Identity Markup
-> ParsecT Text PState Identity Markup
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 ParsecT Text PState Identity Markup
pBaseMath

pBaseMath :: P Markup
pBaseMath :: ParsecT Text PState Identity Markup
pBaseMath = ParsecT Text PState Identity Markup
mNumber
        ParsecT Text PState Identity Markup
-> ParsecT Text PState Identity Markup
-> ParsecT Text PState Identity Markup
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text PState Identity Markup
mLiteral
        ParsecT Text PState Identity Markup
-> ParsecT Text PState Identity Markup
-> ParsecT Text PState Identity Markup
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text PState Identity Markup
mEscaped
        ParsecT Text PState Identity Markup
-> ParsecT Text PState Identity Markup
-> ParsecT Text PState Identity Markup
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text PState Identity Markup
mShorthand
        ParsecT Text PState Identity Markup
-> ParsecT Text PState Identity Markup
-> ParsecT Text PState Identity Markup
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text PState Identity Markup
mBreak
        ParsecT Text PState Identity Markup
-> ParsecT Text PState Identity Markup
-> ParsecT Text PState Identity Markup
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text PState Identity Markup
mAlignPoint
        ParsecT Text PState Identity Markup
-> ParsecT Text PState Identity Markup
-> ParsecT Text PState Identity Markup
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text PState Identity Markup
mExpr
        ParsecT Text PState Identity Markup
-> ParsecT Text PState Identity Markup
-> ParsecT Text PState Identity Markup
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text PState Identity Markup
mGroup
        ParsecT Text PState Identity Markup
-> ParsecT Text PState Identity Markup
-> ParsecT Text PState Identity Markup
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text PState Identity Markup
mCode
        ParsecT Text PState Identity Markup
-> ParsecT Text PState Identity Markup
-> ParsecT Text PState Identity Markup
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text PState Identity Markup
mMid
        ParsecT Text PState Identity Markup
-> ParsecT Text PState Identity Markup
-> ParsecT Text PState Identity Markup
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text PState Identity Markup
mSymbol

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

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

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

mLiteral :: P Markup
mLiteral :: ParsecT Text PState Identity Markup
mLiteral = do
  Maybe (SourcePos, Text)
mbBeforeSpace <- PState -> Maybe (SourcePos, Text)
stBeforeSpace (PState -> Maybe (SourcePos, Text))
-> ParsecT Text PState Identity PState
-> ParsecT Text PState Identity (Maybe (SourcePos, Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState Identity PState
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 (PState -> Maybe (SourcePos, Text))
-> ParsecT Text PState Identity PState
-> ParsecT Text PState Identity (Maybe (SourcePos, Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState Identity PState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  Markup -> ParsecT Text PState Identity Markup
forall a. a -> ParsecT Text PState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Markup -> ParsecT Text PState Identity Markup)
-> Markup -> ParsecT Text PState Identity Markup
forall a b. (a -> b) -> a -> b
$
    Text -> Markup
Text (Text -> Markup) -> Text -> Markup
forall a b. (a -> b) -> a -> b
$
      (Text
-> ((SourcePos, Text) -> Text) -> Maybe (SourcePos, Text) -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Text -> (SourcePos, Text) -> Text
forall a b. a -> b -> a
const Text
" ") Maybe (SourcePos, Text)
mbBeforeSpace)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text
-> ((SourcePos, Text) -> Text) -> Maybe (SourcePos, Text) -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Text -> (SourcePos, Text) -> Text
forall a b. a -> b -> a
const Text
" ") Maybe (SourcePos, Text)
mbAfterSpace)

mEscaped :: P Markup
mEscaped :: ParsecT Text PState Identity Markup
mEscaped = Text -> Markup
Text (Text -> Markup) -> (Char -> Text) -> Char -> Markup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton (Char -> Markup)
-> ParsecT Text PState Identity Char
-> ParsecT Text PState Identity Markup
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState Identity Char
-> ParsecT Text PState Identity Char
forall a. P a -> P a
lexeme (ParsecT Text PState Identity Char
-> ParsecT Text PState Identity Char
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 :: ParsecT Text PState Identity Markup
mBreak = Markup
HardBreak Markup
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity Markup
forall a b.
a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Text PState Identity () -> ParsecT Text PState Identity ()
forall a. P a -> P a
lexeme (Char -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\' ParsecT Text PState Identity Char
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity ()
forall a b.
ParsecT Text PState Identity a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text PState Identity Char
-> ParsecT Text PState Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ((Char -> Bool) -> ParsecT Text PState Identity Char
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 :: ParsecT Text PState Identity Markup
mAlignPoint = Markup
MAlignPoint Markup -> P [Char] -> ParsecT Text PState Identity Markup
forall a b.
a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
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 =
  P [Arg] -> P [Arg]
forall a. P a -> P a
inParens (P [Arg] -> P [Arg]) -> P [Arg] -> P [Arg]
forall a b. (a -> b) -> a -> b
$
    ParsecT Text PState Identity Arg -> P [Arg]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT Text PState Identity Arg
mKeyValArg ParsecT Text PState Identity Arg
-> ParsecT Text PState Identity Arg
-> ParsecT Text PState Identity Arg
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 ParsecT Text PState Identity Arg
-> ParsecT Text PState Identity Arg
-> ParsecT Text PState Identity Arg
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 ParsecT Text PState Identity Arg
-> ParsecT Text PState Identity Arg
-> ParsecT Text PState Identity Arg
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 :: ParsecT Text PState Identity ()
sep = P [Char] -> ParsecT Text PState Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ([Char] -> P [Char]
sym [Char]
",") ParsecT Text PState Identity ()
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text PState Identity Char
-> ParsecT Text PState Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Text PState Identity Char
-> ParsecT Text PState Identity Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (Char -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
')'))
    mNormArg :: ParsecT Text PState Identity Arg
mNormArg = ParsecT Text PState Identity Arg
-> ParsecT Text PState Identity Arg
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text PState Identity Arg
 -> ParsecT Text PState Identity Arg)
-> ParsecT Text PState Identity Arg
-> ParsecT Text PState Identity Arg
forall a b. (a -> b) -> a -> b
$ Expr -> Arg
NormalArg (Expr -> Arg)
-> ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity Arg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'#' ParsecT Text PState Identity Char
-> ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity Expr
forall a b.
ParsecT Text PState Identity a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text PState Identity Expr
pExpr ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity Expr
forall a b.
ParsecT Text PState Identity a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text PState Identity ()
sep)
    mKeyValArg :: ParsecT Text PState Identity Arg
mKeyValArg = do
      Identifier
ident <- ParsecT Text PState Identity Identifier
-> ParsecT Text PState Identity Identifier
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text PState Identity Identifier
 -> ParsecT Text PState Identity Identifier)
-> ParsecT Text PState Identity Identifier
-> ParsecT Text PState Identity Identifier
forall a b. (a -> b) -> a -> b
$ ParsecT Text PState Identity Identifier
pIdentifier ParsecT Text PState Identity Identifier
-> P [Char] -> ParsecT Text PState Identity Identifier
forall a b.
ParsecT Text PState Identity a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* [Char] -> P [Char]
sym [Char]
":"
      Identifier -> Expr -> Arg
KeyValArg Identifier
ident
        (Expr -> Arg)
-> ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity Arg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( (Char -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'#' ParsecT Text PState Identity Char
-> ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity Expr
forall a b.
ParsecT Text PState Identity a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text PState Identity Expr
pExpr ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity Expr
forall a b.
ParsecT Text PState Identity a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text PState Identity ()
sep)
                ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Block -> Expr
Block (Block -> Expr) -> ([Markup] -> Block) -> [Markup] -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Markup] -> Block
Content ([Markup] -> Expr)
-> Parsec Text PState [Markup] -> ParsecT Text PState Identity Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec Text PState [Markup]
mathContent
            )
    mathContent :: Parsec Text PState [Markup]
mathContent = do
      [Markup]
xs <- Parsec Text PState [Markup]
maths
      if [Markup] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Markup]
xs
        then P [Char] -> ParsecT Text PState Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (P [Char] -> ParsecT Text PState Identity ())
-> P [Char] -> ParsecT Text PState Identity ()
forall a b. (a -> b) -> a -> b
$ [Char] -> P [Char]
sym [Char]
","
        else ParsecT Text PState Identity ()
sep
      [Markup] -> Parsec Text PState [Markup]
forall a. a -> ParsecT Text PState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Markup]
xs
    mMathArg :: ParsecT Text PState Identity Arg
mMathArg = [Markup] -> Arg
BlockArg ([Markup] -> Arg)
-> Parsec Text PState [Markup] -> ParsecT Text PState Identity Arg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec Text PState [Markup]
mathContent
    mArrayArg :: ParsecT Text PState Identity Arg
mArrayArg = ParsecT Text PState Identity Arg
-> ParsecT Text PState Identity Arg
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text PState Identity Arg
 -> ParsecT Text PState Identity Arg)
-> ParsecT Text PState Identity Arg
-> ParsecT Text PState Identity Arg
forall a b. (a -> b) -> a -> b
$ do
      let pRow :: Parsec Text PState [Markup]
pRow = ParsecT Text PState Identity Markup
-> P [Char] -> Parsec Text PState [Markup]
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 ([Markup] -> Markup)
-> Parsec Text PState [Markup]
-> ParsecT Text PState Identity Markup
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec Text PState [Markup]
maths) ([Char] -> P [Char]
sym [Char]
",")
      [[Markup]]
rows <- Parsec Text PState [Markup]
-> ParsecT Text PState Identity [[Markup]]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (Parsec Text PState [Markup]
 -> ParsecT Text PState Identity [[Markup]])
-> Parsec Text PState [Markup]
-> ParsecT Text PState Identity [[Markup]]
forall a b. (a -> b) -> a -> b
$ Parsec Text PState [Markup] -> Parsec Text PState [Markup]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parsec Text PState [Markup]
pRow Parsec Text PState [Markup]
-> P [Char] -> Parsec Text PState [Markup]
forall a b.
ParsecT Text PState Identity a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
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 <- ParsecT Text PState Identity Markup -> Parsec Text PState [Markup]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ([Markup] -> Markup
toGroup ([Markup] -> Markup)
-> Parsec Text PState [Markup]
-> ParsecT Text PState Identity Markup
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec Text PState [Markup]
mathContent)
      let rows' :: [[Markup]]
rows' =
            if [Markup] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Markup]
lastrow
              then [[Markup]]
rows
              else [[Markup]]
rows [[Markup]] -> [[Markup]] -> [[Markup]]
forall a. [a] -> [a] -> [a]
++ [[Markup]
lastrow]
      Arg -> ParsecT Text PState Identity Arg
forall a. a -> ParsecT Text PState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Arg -> ParsecT Text PState Identity Arg)
-> Arg -> ParsecT Text PState Identity Arg
forall a b. (a -> b) -> a -> b
$ [[Markup]] -> Arg
ArrayArg [[Markup]]
rows'
    maths :: Parsec Text PState [Markup]
maths = ParsecT Text PState Identity Markup -> Parsec Text PState [Markup]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT Text PState Identity Char
-> ParsecT Text PState Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ([Char] -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
",;)") ParsecT Text PState Identity ()
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity ()
forall a b.
ParsecT Text PState Identity a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text PState Identity Arg -> ParsecT Text PState Identity ()
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 ParsecT Text PState Identity ()
-> ParsecT Text PState Identity Markup
-> ParsecT Text PState Identity Markup
forall a b.
ParsecT Text PState Identity a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text PState Identity Markup
pMath)
    toGroup :: [Markup] -> Markup
toGroup [Markup
m] = Markup
m
    toGroup [Markup]
ms = Maybe Text -> Maybe Text -> [Markup] -> Markup
MGroup Maybe Text
forall a. Maybe a
Nothing Maybe Text
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 = ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m [a]
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 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 -> ParsecT s u m a
<|> [a] -> ParsecT s u m [a]
forall a. 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 <- 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]
many (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 (ParsecT s u m a
s ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT s u m a
p))
      [a] -> ParsecT s u m [a]
forall a. a -> ParsecT s u m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs)

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

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

mShorthand :: P Markup
mShorthand :: ParsecT Text PState Identity Markup
mShorthand =
  ParsecT Text PState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition ParsecT Text PState Identity SourcePos
-> (SourcePos -> ParsecT Text PState Identity Markup)
-> ParsecT Text PState Identity Markup
forall a b.
ParsecT Text PState Identity a
-> (a -> ParsecT Text PState Identity b)
-> ParsecT Text PState Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SourcePos
pos ->
   ParsecT Text PState Identity Markup
-> ParsecT Text PState Identity Markup
forall a. P a -> P a
lexeme (SourcePos -> Expr -> Markup
Code SourcePos
pos (Expr -> Markup)
-> ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity Markup
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ParsecT Text PState Identity Expr]
-> ParsecT Text PState Identity Expr
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice (((Text, Text) -> ParsecT Text PState Identity Expr)
-> [(Text, Text)] -> [ParsecT Text PState Identity Expr]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> ParsecT Text PState Identity Expr
toShorthandParser [(Text, Text)]
shorthands))
 where
  shorthands :: [(Text, Text)]
shorthands = [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a]
reverse (((Text, Text) -> Int) -> [(Text, Text)] -> [(Text, Text)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Text -> Int
T.length (Text -> Int) -> ((Text, Text) -> Text) -> (Text, Text) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text) -> Text
forall a b. (a, b) -> a
fst) [(Text, Text)]
mathSymbolShorthands)
  toShorthandParser :: (Text, Text) -> ParsecT Text PState Identity Expr
toShorthandParser (Text
short, Text
symname) =
    Text -> Expr
toSym Text
symname Expr -> P [Char] -> ParsecT Text PState Identity Expr
forall a b.
a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ P [Char] -> P [Char]
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 (Text -> Expr) -> [Text] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map (Identifier -> Expr
Ident (Identifier -> Expr) -> (Text -> Identifier) -> Text -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Identifier
Identifier) ([Text] -> [Expr]) -> [Text] -> [Expr]
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') Text
name of
      [] -> Literal -> Expr
Literal Literal
None
      [Expr
i] -> Expr
i
      (Expr
i:[Expr]
is) -> (Expr -> Expr -> Expr) -> Expr -> [Expr] -> Expr
forall a b. (a -> b -> b) -> b -> [a] -> b
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 :: ParsecT Text PState Identity Markup
mSymbol =
  ParsecT Text PState Identity Markup
-> ParsecT Text PState Identity Markup
forall a. P a -> P a
lexeme ( Text -> Markup
Text (Text -> Markup) -> (Char -> Text) -> Char -> Markup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton
            (Char -> Markup)
-> ParsecT Text PState Identity Char
-> ParsecT Text PState Identity Markup
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> ParsecT Text PState Identity Char
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 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'$' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
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 (PState -> [Int])
-> ParsecT Text PState Identity PState
-> ParsecT Text PState Identity [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState Identity PState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  (PState -> PState) -> ParsecT Text PState Identity ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((PState -> PState) -> ParsecT Text PState Identity ())
-> (PState -> PState) -> ParsecT Text PState Identity ()
forall a b. (a -> b) -> a -> b
$ \PState
st -> PState
st {stIndent = indent : oldIndent}
  a
ms <- P a
pa
  (PState -> PState) -> ParsecT Text PState Identity ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((PState -> PState) -> ParsecT Text PState Identity ())
-> (PState -> PState) -> ParsecT Text PState Identity ()
forall a b. (a -> b) -> a -> b
$ \PState
st -> PState
st {stIndent = oldIndent}
  a -> P a
forall a. a -> ParsecT Text PState Identity a
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 :: ParsecT Text PState Identity Markup
pListItem = do
  Int
col <- SourcePos -> Int
sourceColumn (SourcePos -> Int)
-> ParsecT Text PState Identity SourcePos
-> ParsecT Text PState Identity Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  Int
startLine <- PState -> Int
stLineStartCol (PState -> Int)
-> ParsecT Text PState Identity PState
-> ParsecT Text PState Identity Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState Identity PState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  Bool -> ParsecT Text PState Identity ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
col Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
startLine)
  ParsecT Text PState Identity Markup
-> ParsecT Text PState Identity Markup
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try
    ( do
        ParsecT Text PState Identity Char
-> ParsecT Text PState Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Text PState Identity Char
 -> ParsecT Text PState Identity ())
-> ParsecT Text PState Identity Char
-> ParsecT Text PState Identity ()
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-'
        ParsecT Text PState Identity Char
-> ParsecT Text PState Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Char -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' ') ParsecT Text PState Identity ()
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text PState Identity ()
pBlankline
        [Markup] -> Markup
BulletListItem ([Markup] -> Markup)
-> Parsec Text PState [Markup]
-> ParsecT Text PState Identity Markup
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parsec Text PState [Markup] -> Parsec Text PState [Markup]
forall a. Int -> P a -> P a
withIndent Int
col (ParsecT Text PState Identity Markup -> Parsec Text PState [Markup]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text PState Identity Markup
pMarkup)
    )
    ParsecT Text PState Identity Markup
-> ParsecT Text PState Identity Markup
-> ParsecT Text PState Identity Markup
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text PState Identity Markup
-> ParsecT Text PState Identity Markup
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try
      ( do
          Maybe Int
start <- (Maybe Int
forall a. Maybe a
Nothing Maybe Int
-> ParsecT Text PState Identity Char
-> ParsecT Text PState Identity (Maybe Int)
forall a b.
a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'+') ParsecT Text PState Identity (Maybe Int)
-> ParsecT Text PState Identity (Maybe Int)
-> ParsecT Text PState Identity (Maybe Int)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int)
-> ParsecT Text PState Identity Int
-> ParsecT Text PState Identity (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState Identity Int
enumListStart)
          ParsecT Text PState Identity Char
-> ParsecT Text PState Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Char -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' ') ParsecT Text PState Identity ()
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text PState Identity ()
pBlankline
          Maybe Int -> [Markup] -> Markup
EnumListItem Maybe Int
start ([Markup] -> Markup)
-> Parsec Text PState [Markup]
-> ParsecT Text PState Identity Markup
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parsec Text PState [Markup] -> Parsec Text PState [Markup]
forall a. Int -> P a -> P a
withIndent Int
col (ParsecT Text PState Identity Markup -> Parsec Text PState [Markup]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text PState Identity Markup
pMarkup)
      )
    ParsecT Text PState Identity Markup
-> ParsecT Text PState Identity Markup
-> ParsecT Text PState Identity Markup
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text PState Identity Markup
-> ParsecT Text PState Identity Markup
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try
      ( do
          -- desc list
          ParsecT Text PState Identity Char
-> ParsecT Text PState Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Char -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'/')
          P [Char] -> ParsecT Text PState Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Text PState Identity Char -> P [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (Char -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' '))
          [Markup]
term <- ParsecT Text PState Identity Markup
-> ParsecT Text PState Identity Char -> Parsec Text PState [Markup]
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 Markup
pMarkup (Char -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':')
          ParsecT Text PState Identity Char
-> ParsecT Text PState Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Text PState Identity Char
spaceChar
          ParsecT Text PState Identity () -> ParsecT Text PState Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT Text PState Identity ()
pBlankline
          [Markup] -> [Markup] -> Markup
DescListItem [Markup]
term ([Markup] -> Markup)
-> Parsec Text PState [Markup]
-> ParsecT Text PState Identity Markup
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parsec Text PState [Markup] -> Parsec Text PState [Markup]
forall a. Int -> P a -> P a
withIndent Int
col (ParsecT Text PState Identity Markup -> Parsec Text PState [Markup]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text PState Identity Markup
pMarkup)
      )

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

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

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

pBlockComment :: P ()
pBlockComment :: ParsecT Text PState Identity ()
pBlockComment = do
  P [Char] -> ParsecT Text PState Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (P [Char] -> ParsecT Text PState Identity ())
-> P [Char] -> ParsecT Text PState Identity ()
forall a b. (a -> b) -> a -> b
$ [Char] -> P [Char]
string [Char]
"/*"
  ParsecT Text PState Identity [()]
-> ParsecT Text PState Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Text PState Identity [()]
 -> ParsecT Text PState Identity ())
-> ParsecT Text PState Identity [()]
-> ParsecT Text PState Identity ()
forall a b. (a -> b) -> a -> b
$
    ParsecT Text PState Identity ()
-> P [Char] -> ParsecT Text PState Identity [()]
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 ()
pBlockComment
          ParsecT Text PState Identity ()
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text PState Identity ()
pLineComment
          ParsecT Text PState Identity ()
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text PState Identity Char
-> ParsecT Text PState Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Text PState Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
      )
      ([Char] -> P [Char]
string [Char]
"*/")

pSpace :: P Markup
pSpace :: ParsecT Text PState Identity Markup
pSpace = Markup
Space Markup -> P [Char] -> ParsecT Text PState Identity Markup
forall a b.
a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Text PState Identity Char -> P [Char]
forall a.
ParsecT Text PState Identity a -> ParsecT Text PState Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ((Char -> Bool) -> ParsecT Text PState Identity Char
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 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\r' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n'))

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

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

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

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

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

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

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

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

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

pStrong :: P Markup
pStrong :: ParsecT Text PState Identity Markup
pStrong = [Markup] -> Markup
Strong ([Markup] -> Markup)
-> Parsec Text PState [Markup]
-> ParsecT Text PState Identity Markup
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'*' ParsecT Text PState Identity Char
-> Parsec Text PState [Markup] -> Parsec Text PState [Markup]
forall a b.
ParsecT Text PState Identity a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text PState Identity Markup
-> ParsecT Text PState Identity Char -> Parsec Text PState [Markup]
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 Markup
pMarkup (Char -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'*'))

pEmph :: P Markup
pEmph :: ParsecT Text PState Identity Markup
pEmph = [Markup] -> Markup
Emph ([Markup] -> Markup)
-> Parsec Text PState [Markup]
-> ParsecT Text PState Identity Markup
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_' ParsecT Text PState Identity Char
-> Parsec Text PState [Markup] -> Parsec Text PState [Markup]
forall a b.
ParsecT Text PState Identity a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text PState Identity Markup
-> ParsecT Text PState Identity Char -> Parsec Text PState [Markup]
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 Markup
pMarkup (Char -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_'))

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

pUrl :: P Markup
pUrl :: ParsecT Text PState Identity Markup
pUrl = ParsecT Text PState Identity Markup
-> ParsecT Text PState Identity Markup
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text PState Identity Markup
 -> ParsecT Text PState Identity Markup)
-> ParsecT Text PState Identity Markup
-> ParsecT Text PState Identity Markup
forall a b. (a -> b) -> a -> b
$ do
  Text
prot <- [Char] -> Text
T.pack ([Char] -> Text) -> P [Char] -> ParsecT Text PState Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> P [Char]
string [Char]
"http://" P [Char] -> P [Char] -> P [Char]
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 ([Char] -> Text) -> P [Char] -> ParsecT Text PState Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> Int -> P [Char]
pNonspaceWithBalancedBrackets Int
0 Int
0 Int
0
  Markup -> ParsecT Text PState Identity Markup
forall a. a -> ParsecT Text PState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Markup -> ParsecT Text PState Identity Markup)
-> Markup -> ParsecT Text PState Identity Markup
forall a b. (a -> b) -> a -> b
$ Text -> Markup
Url (Text -> Markup) -> Text -> Markup
forall a b. (a -> b) -> a -> b
$ Text
prot Text -> Text -> Text
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 =
  ((:) (Char -> ShowS)
-> ParsecT Text PState Identity Char
-> ParsecT Text PState Identity ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'(' ParsecT Text PState Identity ShowS -> P [Char] -> P [Char]
forall a b.
ParsecT Text PState Identity (a -> b)
-> ParsecT Text PState Identity a -> ParsecT Text PState Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Int -> Int -> P [Char]
pNonspaceWithBalancedBrackets (Int
parens Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
brackets Int
braces)
    P [Char] -> P [Char] -> P [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ((:) (Char -> ShowS)
-> ParsecT Text PState Identity Char
-> ParsecT Text PState Identity ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool -> ParsecT Text PState Identity ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
parens Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) ParsecT Text PState Identity ()
-> ParsecT Text PState Identity Char
-> ParsecT Text PState Identity Char
forall a b.
ParsecT Text PState Identity a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
')') ParsecT Text PState Identity ShowS -> P [Char] -> P [Char]
forall a b.
ParsecT Text PState Identity (a -> b)
-> ParsecT Text PState Identity a -> ParsecT Text PState Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Int -> Int -> P [Char]
pNonspaceWithBalancedBrackets (Int
parens Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
brackets Int
braces)
    P [Char] -> P [Char] -> P [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ((:) (Char -> ShowS)
-> ParsecT Text PState Identity Char
-> ParsecT Text PState Identity ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'[' ParsecT Text PState Identity ShowS -> P [Char] -> P [Char]
forall a b.
ParsecT Text PState Identity (a -> b)
-> ParsecT Text PState Identity a -> ParsecT Text PState Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Int -> Int -> P [Char]
pNonspaceWithBalancedBrackets Int
parens (Int
brackets Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
braces)
    P [Char] -> P [Char] -> P [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ((:) (Char -> ShowS)
-> ParsecT Text PState Identity Char
-> ParsecT Text PState Identity ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool -> ParsecT Text PState Identity ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
brackets Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) ParsecT Text PState Identity ()
-> ParsecT Text PState Identity Char
-> ParsecT Text PState Identity Char
forall a b.
ParsecT Text PState Identity a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']') ParsecT Text PState Identity ShowS -> P [Char] -> P [Char]
forall a b.
ParsecT Text PState Identity (a -> b)
-> ParsecT Text PState Identity a -> ParsecT Text PState Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Int -> Int -> P [Char]
pNonspaceWithBalancedBrackets Int
parens (Int
brackets Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
braces)
    P [Char] -> P [Char] -> P [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ((:) (Char -> ShowS)
-> ParsecT Text PState Identity Char
-> ParsecT Text PState Identity ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{' ParsecT Text PState Identity ShowS -> P [Char] -> P [Char]
forall a b.
ParsecT Text PState Identity (a -> b)
-> ParsecT Text PState Identity a -> ParsecT Text PState Identity b
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
    P [Char] -> P [Char] -> P [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ((:) (Char -> ShowS)
-> ParsecT Text PState Identity Char
-> ParsecT Text PState Identity ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool -> ParsecT Text PState Identity ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
braces Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) ParsecT Text PState Identity ()
-> ParsecT Text PState Identity Char
-> ParsecT Text PState Identity Char
forall a b.
ParsecT Text PState Identity a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'}') ParsecT Text PState Identity ShowS -> P [Char] -> P [Char]
forall a b.
ParsecT Text PState Identity a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> Int -> Int -> P [Char]
pNonspaceWithBalancedBrackets Int
parens Int
brackets (Int
braces Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
    P [Char] -> P [Char] -> P [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (:) (Char -> ShowS)
-> ParsecT Text PState Identity Char
-> ParsecT Text PState Identity ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
" \t\r\n()[]{}" ParsecT Text PState Identity ShowS -> P [Char] -> P [Char]
forall a b.
ParsecT Text PState Identity (a -> b)
-> ParsecT Text PState Identity a -> ParsecT Text PState Identity b
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
    P [Char] -> P [Char] -> P [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [Char] -> P [Char]
forall a. a -> ParsecT Text PState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

pText :: P Markup
pText :: ParsecT Text PState Identity Markup
pText = Text -> Markup
Text (Text -> Markup) -> ([Text] -> Text) -> [Text] -> Markup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Markup)
-> ParsecT Text PState Identity [Text]
-> ParsecT Text PState Identity Markup
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState Identity Text
-> ParsecT Text PState Identity [Text]
forall a.
ParsecT Text PState Identity a -> ParsecT Text PState Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some
  ((do [Char]
xs <- ParsecT Text PState Identity Char -> P [Char]
forall a.
ParsecT Text PState Identity a -> ParsecT Text PState Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ParsecT Text PState Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum
       [Char] -> Text
T.pack ([Char] -> Text) -> ShowS -> [Char] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
xs [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<>) ([Char] -> Text) -> P [Char] -> ParsecT Text PState Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
             P [Char] -> P [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text PState Identity Char -> P [Char]
forall a.
ParsecT Text PState Identity a -> ParsecT Text PState Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (Char -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'*' ParsecT Text PState Identity Char
-> ParsecT Text PState Identity Char
-> ParsecT Text PState Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_') P [Char] -> ParsecT Text PState Identity Char -> P [Char]
forall a b.
ParsecT Text PState Identity a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text PState Identity Char
-> ParsecT Text PState Identity Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT Text PState Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum)
        ParsecT Text PState Identity Text
-> ParsecT Text PState Identity Text
-> ParsecT Text PState Identity Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Text -> ParsecT Text PState Identity Text
forall a. a -> ParsecT Text PState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char] -> Text
T.pack [Char]
xs))
 ParsecT Text PState Identity Text
-> ParsecT Text PState Identity Text
-> ParsecT Text PState Identity Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([Char] -> Text
T.pack ([Char] -> Text) -> P [Char] -> ParsecT Text PState Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState Identity Char -> P [Char]
forall a.
ParsecT Text PState Identity a -> ParsecT Text PState Identity [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ((Char -> Bool) -> ParsecT Text PState Identity Char
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 :: ParsecT Text PState Identity Markup
pEscaped = Text -> Markup
Text (Text -> Markup) -> (Char -> Text) -> Char -> Markup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton (Char -> Markup)
-> ParsecT Text PState Identity Char
-> ParsecT Text PState Identity Markup
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 =
  Char -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\' ParsecT Text PState Identity Char
-> ParsecT Text PState Identity Char
-> ParsecT Text PState Identity Char
forall a b.
ParsecT Text PState Identity a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ParsecT Text PState Identity Char
uniEsc ParsecT Text PState Identity Char
-> ParsecT Text PState Identity Char
-> ParsecT Text PState Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Char -> Bool) -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace))

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

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

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

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

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

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

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

pRef :: P Markup
pRef :: ParsecT Text PState Identity Markup
pRef =
  Text -> Expr -> Markup
Ref
    (Text -> Expr -> Markup)
-> ParsecT Text PState Identity Text
-> ParsecT Text PState Identity (Expr -> Markup)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'@' ParsecT Text PState Identity Char
-> ParsecT Text PState Identity Text
-> ParsecT Text PState Identity Text
forall a b.
ParsecT Text PState Identity a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([Char] -> Text
T.pack ([Char] -> Text) -> P [Char] -> ParsecT Text PState Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState Identity Char -> P [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ((Char -> Bool) -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isIdentContinue ParsecT Text PState Identity Char
-> ParsecT Text PState Identity Char
-> ParsecT Text PState Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_')))
    ParsecT Text PState Identity (Expr -> Markup)
-> ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity Markup
forall a b.
ParsecT Text PState Identity (a -> b)
-> ParsecT Text PState Identity a -> ParsecT Text PState Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr
-> ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity Expr
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 (Block -> Expr)
-> ParsecT Text PState Identity Block
-> ParsecT Text PState Identity Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState Identity 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 :: ParsecT Text PState Identity Markup
pHash = do
  ParsecT Text PState Identity Char
-> ParsecT Text PState Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Text PState Identity Char
 -> ParsecT Text PState Identity ())
-> ParsecT Text PState Identity Char
-> ParsecT Text PState Identity ()
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'#'
  Markup
res <- SourcePos -> Expr -> Markup
Code (SourcePos -> Expr -> Markup)
-> ParsecT Text PState Identity SourcePos
-> ParsecT Text PState Identity (Expr -> Markup)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition ParsecT Text PState Identity (Expr -> Markup)
-> ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity Markup
forall a b.
ParsecT Text PState Identity (a -> b)
-> ParsecT Text PState Identity a -> ParsecT Text PState Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text PState Identity Expr
pBasicExpr ParsecT Text PState Identity Markup
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity Markup
forall a b.
ParsecT Text PState Identity a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P [Char] -> ParsecT Text PState Identity ()
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 (PState -> Maybe (SourcePos, Text))
-> ParsecT Text PState Identity PState
-> ParsecT Text PState Identity (Maybe (SourcePos, Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState Identity PState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  case Maybe (SourcePos, Text)
mbBeforeSpace of
    Maybe (SourcePos, Text)
Nothing -> () -> ParsecT Text PState Identity ()
forall a. a -> ParsecT Text PState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just (SourcePos
pos, Text
inp) -> do
      SourcePos -> ParsecT Text PState Identity ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition SourcePos
pos
      Text -> ParsecT Text PState Identity ()
forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
setInput Text
inp
  Markup -> ParsecT Text PState Identity Markup
forall a. a -> ParsecT Text PState Identity a
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 :: ParsecT Text PState Identity Identifier
pIdentifier = ParsecT Text PState Identity Identifier
-> ParsecT Text PState Identity Identifier
forall a. P a -> P a
lexeme (ParsecT Text PState Identity Identifier
 -> ParsecT Text PState Identity Identifier)
-> ParsecT Text PState Identity Identifier
-> ParsecT Text PState Identity Identifier
forall a b. (a -> b) -> a -> b
$ ParsecT Text PState Identity Identifier
-> ParsecT Text PState Identity Identifier
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text PState Identity Identifier
 -> ParsecT Text PState Identity Identifier)
-> ParsecT Text PState Identity Identifier
-> ParsecT Text PState Identity Identifier
forall a b. (a -> b) -> a -> b
$ do
  Char
c <- (Char -> Bool) -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isIdentStart
  [Char]
cs <- ParsecT Text PState Identity Char -> P [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT Text PState Identity Char -> P [Char])
-> ParsecT Text PState Identity Char -> P [Char]
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isIdentContinue
  Identifier -> ParsecT Text PState Identity Identifier
forall a. a -> ParsecT Text PState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Identifier -> ParsecT Text PState Identity Identifier)
-> Identifier -> ParsecT Text PState Identity Identifier
forall a b. (a -> b) -> a -> b
$ Text -> Identifier
Identifier (Text -> Identifier) -> Text -> Identifier
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack (Char
c Char -> ShowS
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 Char -> Char -> Bool
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 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-'
    Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
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] -> ParsecT Text PState Identity ()
pKeyword [Char]
t = ParsecT Text PState Identity () -> ParsecT Text PState Identity ()
forall a. P a -> P a
lexeme (ParsecT Text PState Identity ()
 -> ParsecT Text PState Identity ())
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity ()
forall a b. (a -> b) -> a -> b
$ ParsecT Text PState Identity () -> ParsecT Text PState Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text PState Identity ()
 -> ParsecT Text PState Identity ())
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity ()
forall a b. (a -> b) -> a -> b
$ [Char] -> P [Char]
string [Char]
t P [Char]
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity ()
forall a b.
ParsecT Text PState Identity a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text PState Identity Char
-> ParsecT Text PState Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ((Char -> Bool) -> ParsecT Text PState Identity Char
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 :: ParsecT Text PState Identity Expr
pExpr = [[Operator Text PState Identity Expr]]
-> ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity Expr
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 ParsecT Text PState Identity 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 :: ParsecT Text PState Identity Expr
pBasicExpr = [[Operator Text PState Identity Expr]]
-> ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity Expr
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 ParsecT Text PState Identity Expr
pBaseExpr

pQualifiedIdentifier :: P Expr
pQualifiedIdentifier :: ParsecT Text PState Identity Expr
pQualifiedIdentifier =
  [[Operator Text PState Identity Expr]]
-> ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity Expr
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 (Int
-> [Operator Text PState Identity Expr]
-> [[Operator Text PState Identity Expr]]
forall a. Int -> a -> [a]
replicate Int
4 [Operator Text PState Identity Expr
fieldAccess]) ParsecT Text PState Identity Expr
pIdent

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

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

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

functionCall :: Operator Text PState Identity Expr
functionCall :: Operator Text PState Identity Expr
functionCall =
  ParsecT Text PState Identity (Expr -> Expr)
-> Operator Text PState Identity Expr
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 (PState -> Maybe (SourcePos, Text))
-> ParsecT Text PState Identity PState
-> ParsecT Text PState Identity (Maybe (SourcePos, Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState Identity PState
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 [...]'.
        Bool -> ParsecT Text PState Identity ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT Text PState Identity ())
-> Bool -> ParsecT Text PState Identity ()
forall a b. (a -> b) -> a -> b
$ Maybe (SourcePos, Text) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (SourcePos, Text)
mbBeforeSpace
        [Arg]
args <- P [Arg]
pArgs
        (Expr -> Expr) -> ParsecT Text PState Identity (Expr -> Expr)
forall a. a -> ParsecT Text PState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Expr -> Expr) -> ParsecT Text PState Identity (Expr -> Expr))
-> (Expr -> Expr) -> ParsecT Text PState Identity (Expr -> Expr)
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 =
  Int
-> [[Operator Text PState Identity Expr]]
-> [[Operator Text PState Identity Expr]]
forall a. Int -> [a] -> [a]
take Int
16 ([[Operator Text PState Identity Expr]]
-> [[Operator Text PState Identity Expr]]
forall a. HasCallStack => [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 .)
  Int
-> [[Operator Text PState Identity Expr]]
-> [[Operator Text PState Identity Expr]]
forall a. Int -> [a] -> [a]
take Int
12 ([[Operator Text PState Identity Expr]]
-> [[Operator Text PState Identity Expr]]
forall a. HasCallStack => [a] -> [a]
cycle [[Operator Text PState Identity Expr
fieldAccess], [Operator Text PState Identity Expr
functionCall]])
    [[Operator Text PState Identity Expr]]
-> [[Operator Text PState Identity Expr]]
-> [[Operator Text PState Identity Expr]]
forall a. [a] -> [a] -> [a]
++
    -- precedence 7 (repeated because of parsec's quirks with postfix, prefix)
    Int
-> [Operator Text PState Identity Expr]
-> [[Operator Text PState Identity Expr]]
forall a. Int -> a -> [a]
replicate Int
6 [ParsecT Text PState Identity (Expr -> Expr)
-> Operator Text PState Identity Expr
forall s u (m :: * -> *) a.
ParsecT s u m (a -> a) -> Operator s u m a
Postfix (Expr -> Expr -> Expr
ToPower (Expr -> Expr -> Expr)
-> ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity (Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity Expr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Char -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'e' ParsecT Text PState Identity Char
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity ()
forall a b.
ParsecT Text PState Identity a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text PState Identity Char
-> ParsecT Text PState Identity ()
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 Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter ParsecT Text PState Identity ()
-> ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity Expr
forall a b.
ParsecT Text PState Identity a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text PState Identity Expr
pExpr))]
    [[Operator Text PState Identity Expr]]
-> [[Operator Text PState Identity Expr]]
-> [[Operator Text PState Identity Expr]]
forall a. [a] -> [a] -> [a]
++ Int
-> [Operator Text PState Identity Expr]
-> [[Operator Text PState Identity Expr]]
forall a. Int -> a -> [a]
replicate Int
6 [ParsecT Text PState Identity (Expr -> Expr)
-> Operator Text PState Identity Expr
forall s u (m :: * -> *) a.
ParsecT s u m (a -> a) -> Operator s u m a
Prefix (Expr -> Expr
Negated (Expr -> Expr)
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity (Expr -> Expr)
forall a b.
a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> ParsecT Text PState Identity ()
op [Char]
"-"), ParsecT Text PState Identity (Expr -> Expr)
-> Operator Text PState Identity Expr
forall s u (m :: * -> *) a.
ParsecT s u m (a -> a) -> Operator s u m a
Prefix (Expr -> Expr
forall a. a -> a
id (Expr -> Expr)
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity (Expr -> Expr)
forall a b.
a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> ParsecT Text PState Identity ()
op [Char]
"+")]
    [[Operator Text PState Identity Expr]]
-> [[Operator Text PState Identity Expr]]
-> [[Operator Text PState Identity Expr]]
forall a. [a] -> [a] -> [a]
++ [
         -- precedence 6
         [ ParsecT Text PState Identity (Expr -> Expr -> Expr)
-> Assoc -> Operator Text PState Identity Expr
forall s u (m :: * -> *) a.
ParsecT s u m (a -> a -> a) -> Assoc -> Operator s u m a
Infix (Expr -> Expr -> Expr
Times (Expr -> Expr -> Expr)
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity (Expr -> Expr -> Expr)
forall a b.
a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> ParsecT Text PState Identity ()
op [Char]
"*") Assoc
AssocLeft,
           ParsecT Text PState Identity (Expr -> Expr -> Expr)
-> Assoc -> Operator Text PState Identity Expr
forall s u (m :: * -> *) a.
ParsecT s u m (a -> a -> a) -> Assoc -> Operator s u m a
Infix (Expr -> Expr -> Expr
Divided (Expr -> Expr -> Expr)
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity (Expr -> Expr -> Expr)
forall a b.
a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> ParsecT Text PState Identity ()
op [Char]
"/") Assoc
AssocLeft
         ],
         -- precedence 5
         [ ParsecT Text PState Identity (Expr -> Expr -> Expr)
-> Assoc -> Operator Text PState Identity Expr
forall s u (m :: * -> *) a.
ParsecT s u m (a -> a -> a) -> Assoc -> Operator s u m a
Infix (Expr -> Expr -> Expr
Plus (Expr -> Expr -> Expr)
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity (Expr -> Expr -> Expr)
forall a b.
a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> ParsecT Text PState Identity ()
op [Char]
"+") Assoc
AssocLeft,
           ParsecT Text PState Identity (Expr -> Expr -> Expr)
-> Assoc -> Operator Text PState Identity Expr
forall s u (m :: * -> *) a.
ParsecT s u m (a -> a -> a) -> Assoc -> Operator s u m a
Infix (Expr -> Expr -> Expr
Minus (Expr -> Expr -> Expr)
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity (Expr -> Expr -> Expr)
forall a b.
a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> ParsecT Text PState Identity ()
op [Char]
"-") Assoc
AssocLeft
         ],
         -- precedence 4
         [ ParsecT Text PState Identity (Expr -> Expr -> Expr)
-> Assoc -> Operator Text PState Identity Expr
forall s u (m :: * -> *) a.
ParsecT s u m (a -> a -> a) -> Assoc -> Operator s u m a
Infix (Expr -> Expr -> Expr
Equals (Expr -> Expr -> Expr)
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity (Expr -> Expr -> Expr)
forall a b.
a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> ParsecT Text PState Identity ()
op [Char]
"==") Assoc
AssocLeft,
           ParsecT Text PState Identity (Expr -> Expr -> Expr)
-> Assoc -> Operator Text PState Identity Expr
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)) (Expr -> Expr -> Expr)
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity (Expr -> Expr -> Expr)
forall a b.
a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> ParsecT Text PState Identity ()
op [Char]
"!=") Assoc
AssocLeft,
           ParsecT Text PState Identity (Expr -> Expr -> Expr)
-> Assoc -> Operator Text PState Identity Expr
forall s u (m :: * -> *) a.
ParsecT s u m (a -> a -> a) -> Assoc -> Operator s u m a
Infix (Expr -> Expr -> Expr
LessThan (Expr -> Expr -> Expr)
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity (Expr -> Expr -> Expr)
forall a b.
a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> ParsecT Text PState Identity ()
op [Char]
"<") Assoc
AssocLeft,
           ParsecT Text PState Identity (Expr -> Expr -> Expr)
-> Assoc -> Operator Text PState Identity Expr
forall s u (m :: * -> *) a.
ParsecT s u m (a -> a -> a) -> Assoc -> Operator s u m a
Infix (Expr -> Expr -> Expr
LessThanOrEqual (Expr -> Expr -> Expr)
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity (Expr -> Expr -> Expr)
forall a b.
a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> ParsecT Text PState Identity ()
op [Char]
"<=") Assoc
AssocLeft,
           ParsecT Text PState Identity (Expr -> Expr -> Expr)
-> Assoc -> Operator Text PState Identity Expr
forall s u (m :: * -> *) a.
ParsecT s u m (a -> a -> a) -> Assoc -> Operator s u m a
Infix (Expr -> Expr -> Expr
GreaterThan (Expr -> Expr -> Expr)
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity (Expr -> Expr -> Expr)
forall a b.
a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> ParsecT Text PState Identity ()
op [Char]
">") Assoc
AssocLeft,
           ParsecT Text PState Identity (Expr -> Expr -> Expr)
-> Assoc -> Operator Text PState Identity Expr
forall s u (m :: * -> *) a.
ParsecT s u m (a -> a -> a) -> Assoc -> Operator s u m a
Infix (Expr -> Expr -> Expr
GreaterThanOrEqual (Expr -> Expr -> Expr)
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity (Expr -> Expr -> Expr)
forall a b.
a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> ParsecT Text PState Identity ()
op [Char]
">=") Assoc
AssocLeft,
           ParsecT Text PState Identity (Expr -> Expr -> Expr)
-> Assoc -> Operator Text PState Identity Expr
forall s u (m :: * -> *) a.
ParsecT s u m (a -> a -> a) -> Assoc -> Operator s u m a
Infix (Expr -> Expr -> Expr
InCollection (Expr -> Expr -> Expr)
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity (Expr -> Expr -> Expr)
forall a b.
a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> ParsecT Text PState Identity ()
pKeyword [Char]
"in") Assoc
AssocLeft,
           ParsecT Text PState Identity (Expr -> Expr -> Expr)
-> Assoc -> Operator Text PState Identity Expr
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))
                 (Expr -> Expr -> Expr)
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity (Expr -> Expr -> Expr)
forall a b.
a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Text PState Identity () -> ParsecT Text PState Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([Char] -> ParsecT Text PState Identity ()
pKeyword [Char]
"not" ParsecT Text PState Identity ()
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity ()
forall a b.
ParsecT Text PState Identity a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [Char] -> ParsecT Text PState Identity ()
pKeyword [Char]
"in")
             )
             Assoc
AssocLeft
         ],
         -- precedence 3
         [ ParsecT Text PState Identity (Expr -> Expr)
-> Operator Text PState Identity Expr
forall s u (m :: * -> *) a.
ParsecT s u m (a -> a) -> Operator s u m a
Prefix (Expr -> Expr
Not (Expr -> Expr)
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity (Expr -> Expr)
forall a b.
a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> ParsecT Text PState Identity ()
pKeyword [Char]
"not"),
           ParsecT Text PState Identity (Expr -> Expr -> Expr)
-> Assoc -> Operator Text PState Identity Expr
forall s u (m :: * -> *) a.
ParsecT s u m (a -> a -> a) -> Assoc -> Operator s u m a
Infix (Expr -> Expr -> Expr
And (Expr -> Expr -> Expr)
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity (Expr -> Expr -> Expr)
forall a b.
a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> ParsecT Text PState Identity ()
pKeyword [Char]
"and") Assoc
AssocLeft
         ],
         -- precedence 2
         [ ParsecT Text PState Identity (Expr -> Expr -> Expr)
-> Assoc -> Operator Text PState Identity Expr
forall s u (m :: * -> *) a.
ParsecT s u m (a -> a -> a) -> Assoc -> Operator s u m a
Infix (Expr -> Expr -> Expr
Or (Expr -> Expr -> Expr)
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity (Expr -> Expr -> Expr)
forall a b.
a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> ParsecT Text PState Identity ()
pKeyword [Char]
"or") Assoc
AssocLeft
         ],
         -- precedence 1
         [ ParsecT Text PState Identity (Expr -> Expr -> Expr)
-> Assoc -> Operator Text PState Identity Expr
forall s u (m :: * -> *) a.
ParsecT s u m (a -> a -> a) -> Assoc -> Operator s u m a
Infix (Expr -> Expr -> Expr
Assign (Expr -> Expr -> Expr)
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity (Expr -> Expr -> Expr)
forall a b.
a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> ParsecT Text PState Identity ()
op [Char]
"=") Assoc
AssocRight,
           ParsecT Text PState Identity (Expr -> Expr -> Expr)
-> Assoc -> Operator Text PState Identity Expr
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)) (Expr -> Expr -> Expr)
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity (Expr -> Expr -> Expr)
forall a b.
a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> ParsecT Text PState Identity ()
op [Char]
"+=") Assoc
AssocRight,
           ParsecT Text PState Identity (Expr -> Expr -> Expr)
-> Assoc -> Operator Text PState Identity Expr
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)) (Expr -> Expr -> Expr)
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity (Expr -> Expr -> Expr)
forall a b.
a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> ParsecT Text PState Identity ()
op [Char]
"-=") Assoc
AssocRight,
           ParsecT Text PState Identity (Expr -> Expr -> Expr)
-> Assoc -> Operator Text PState Identity Expr
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)) (Expr -> Expr -> Expr)
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity (Expr -> Expr -> Expr)
forall a b.
a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> ParsecT Text PState Identity ()
op [Char]
"*=") Assoc
AssocRight,
           ParsecT Text PState Identity (Expr -> Expr -> Expr)
-> Assoc -> Operator Text PState Identity Expr
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)) (Expr -> Expr -> Expr)
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity (Expr -> Expr -> Expr)
forall a b.
a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> ParsecT Text PState Identity ()
op [Char]
"/=") Assoc
AssocRight
         ]
       ]

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

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

pBoolean :: P Literal
pBoolean :: P Literal
pBoolean =
  (Bool -> Literal
Boolean Bool
True Literal -> ParsecT Text PState Identity () -> P Literal
forall a b.
a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> ParsecT Text PState Identity ()
pKeyword [Char]
"true") P Literal -> P Literal -> P Literal
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 Literal -> ParsecT Text PState Identity () -> P Literal
forall a b.
a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> ParsecT Text PState Identity ()
pKeyword [Char]
"false")

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

pNumeric :: P Literal
pNumeric :: P Literal
pNumeric = P Literal -> P Literal
forall a. P a -> P a
lexeme (P Literal -> P Literal) -> P Literal -> P Literal
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 -> Literal -> P Literal
forall a. a -> ParsecT Text PState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Literal -> P Literal) -> Literal -> P Literal
forall a b. (a -> b) -> a -> b
$ Double -> Unit -> Literal
Numeric (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i) Unit
unit
        Right Double
d -> Literal -> P Literal
forall a. a -> ParsecT Text PState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Literal -> P Literal) -> Literal -> P Literal
forall a b. (a -> b) -> a -> b
$ Double -> Unit -> Literal
Numeric Double
d Unit
unit
    )
    P Literal -> P Literal -> P Literal
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 -> Literal -> P Literal
forall a. a -> ParsecT Text PState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Literal -> P Literal) -> Literal -> P Literal
forall a b. (a -> b) -> a -> b
$ Integer -> Literal
Int Integer
i
      Right Double
d -> Literal -> P Literal
forall a. a -> ParsecT Text PState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Literal -> P Literal) -> Literal -> P Literal
forall a b. (a -> b) -> a -> b
$ Double -> Literal
Float Double
d

pStr :: P Literal
pStr :: P Literal
pStr = P Literal -> P Literal
forall a. P a -> P a
lexeme (P Literal -> P Literal) -> P Literal -> P Literal
forall a b. (a -> b) -> a -> b
$ do
  ParsecT Text PState Identity Char
-> ParsecT Text PState Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Text PState Identity Char
 -> ParsecT Text PState Identity ())
-> ParsecT Text PState Identity Char
-> ParsecT Text PState Identity ()
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'"'
  Text -> Literal
String (Text -> Literal) -> ([Char] -> Text) -> [Char] -> Literal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack ([Char] -> Literal) -> P [Char] -> P Literal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState Identity Char
-> ParsecT Text PState Identity Char -> P [Char]
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 ParsecT Text PState Identity Char
-> ParsecT Text PState Identity Char
-> ParsecT Text PState Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Char -> Bool) -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'"')) (Char -> ParsecT Text PState Identity 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 Unit -> P [Char] -> P Unit
forall a b.
a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P [Char]
sym [Char]
"%")
    P Unit -> P Unit -> P Unit
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Unit
Pt Unit -> ParsecT Text PState Identity () -> P Unit
forall a b.
a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> ParsecT Text PState Identity ()
pKeyword [Char]
"pt")
    P Unit -> P Unit -> P Unit
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Unit
Mm Unit -> ParsecT Text PState Identity () -> P Unit
forall a b.
a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> ParsecT Text PState Identity ()
pKeyword [Char]
"mm")
    P Unit -> P Unit -> P Unit
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Unit
Cm Unit -> ParsecT Text PState Identity () -> P Unit
forall a b.
a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> ParsecT Text PState Identity ()
pKeyword [Char]
"cm")
    P Unit -> P Unit -> P Unit
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Unit
In Unit -> ParsecT Text PState Identity () -> P Unit
forall a b.
a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> ParsecT Text PState Identity ()
pKeyword [Char]
"in")
    P Unit -> P Unit -> P Unit
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Unit
Deg Unit -> ParsecT Text PState Identity () -> P Unit
forall a b.
a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> ParsecT Text PState Identity ()
pKeyword [Char]
"deg")
    P Unit -> P Unit -> P Unit
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Unit
Rad Unit -> ParsecT Text PState Identity () -> P Unit
forall a b.
a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> ParsecT Text PState Identity ()
pKeyword [Char]
"rad")
    P Unit -> P Unit -> P Unit
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Unit
Em Unit -> ParsecT Text PState Identity () -> P Unit
forall a b.
a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> ParsecT Text PState Identity ()
pKeyword [Char]
"em")
    P Unit -> P Unit -> P Unit
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Unit
Fr Unit -> ParsecT Text PState Identity () -> P Unit
forall a b.
a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> ParsecT Text PState Identity ()
pKeyword [Char]
"fr")

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

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

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

pCode :: P [Expr]
pCode :: ParsecT Text PState Identity [Expr]
pCode = ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity [Expr]
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 Expr
pExpr (P [Char] -> ParsecT Text PState Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ([Char] -> P [Char]
sym [Char]
";") ParsecT Text PState Identity ()
-> ParsecT Text PState Identity ()
-> ParsecT Text PState Identity ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text PState Identity ()
ws)

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

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

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

-- dict-expr ::= '(' (':' | ':'? (pair (',' pair)* ','?)) ')'
-- pair ::= (ident | str) ':' expr
pDictExpr :: P Expr
pDictExpr :: ParsecT Text PState Identity Expr
pDictExpr = ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity Expr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text PState Identity Expr
 -> ParsecT Text PState Identity Expr)
-> ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity Expr
forall a b. (a -> b) -> a -> b
$ ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity Expr
forall a. P a -> P a
inParens ([Char] -> P [Char]
sym [Char]
":" P [Char]
-> ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity Expr
forall a b.
ParsecT Text PState Identity a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ParsecT Text PState Identity Expr
pNonemptyDict ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Expr -> ParsecT Text PState Identity Expr
forall a. a -> ParsecT Text PState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Spreadable (Expr, Expr)] -> Expr
Dict [Spreadable (Expr, Expr)]
forall a. Monoid a => a
mempty)) ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text PState Identity Expr
pNonemptyDict)
  where
    pNonemptyDict :: ParsecT Text PState Identity Expr
pNonemptyDict = [Spreadable (Expr, Expr)] -> Expr
Dict ([Spreadable (Expr, Expr)] -> Expr)
-> ParsecT Text PState Identity [Spreadable (Expr, Expr)]
-> ParsecT Text PState Identity Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState Identity (Spreadable (Expr, Expr))
-> P [Char]
-> ParsecT Text PState Identity [Spreadable (Expr, Expr)]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
sepEndBy1 (ParsecT Text PState Identity (Spreadable (Expr, Expr))
forall a. P (Spreadable a)
pSpread ParsecT Text PState Identity (Spreadable (Expr, Expr))
-> ParsecT Text PState Identity (Spreadable (Expr, Expr))
-> ParsecT Text PState Identity (Spreadable (Expr, Expr))
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 = (Expr, Expr) -> Spreadable (Expr, Expr)
forall a. a -> Spreadable a
Reg ((Expr, Expr) -> Spreadable (Expr, Expr))
-> ParsecT Text PState Identity (Expr, Expr)
-> ParsecT Text PState Identity (Spreadable (Expr, Expr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((,) (Expr -> Expr -> (Expr, Expr))
-> ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity (Expr -> (Expr, Expr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState Identity Expr
pExpr ParsecT Text PState Identity (Expr -> (Expr, Expr))
-> ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity (Expr, Expr)
forall a b.
ParsecT Text PState Identity (a -> b)
-> ParsecT Text PState Identity a -> ParsecT Text PState Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity Expr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([Char] -> P [Char]
sym [Char]
":" P [Char]
-> ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity Expr
forall a b.
ParsecT Text PState Identity a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text PState Identity Expr
pExpr))

pSpread :: P (Spreadable a)
pSpread :: forall a. P (Spreadable a)
pSpread = ParsecT Text PState Identity (Spreadable a)
-> ParsecT Text PState Identity (Spreadable a)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text PState Identity (Spreadable a)
 -> ParsecT Text PState Identity (Spreadable a))
-> ParsecT Text PState Identity (Spreadable a)
-> ParsecT Text PState Identity (Spreadable a)
forall a b. (a -> b) -> a -> b
$ [Char] -> P [Char]
string [Char]
".." P [Char]
-> ParsecT Text PState Identity (Spreadable a)
-> ParsecT Text PState Identity (Spreadable a)
forall a b.
ParsecT Text PState Identity a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Expr -> Spreadable a
forall a. Expr -> Spreadable a
Spr (Expr -> Spreadable a)
-> ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity (Spreadable a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState Identity Expr
pExpr)

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

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

-- args ::= ('(' (arg (',' arg)* ','?)? ')' content-block*) | content-block+
pArgs :: P [Arg]
pArgs :: P [Arg]
pArgs = do
  ParsecT Text PState Identity Char
-> ParsecT Text PState Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Text PState Identity Char
 -> ParsecT Text PState Identity ())
-> ParsecT Text PState Identity Char
-> ParsecT Text PState Identity ()
forall a b. (a -> b) -> a -> b
$ ParsecT Text PState Identity Char
-> ParsecT Text PState Identity Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (Char -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'(' ParsecT Text PState Identity Char
-> ParsecT Text PState Identity Char
-> ParsecT Text PState Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT Text PState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'[')
  [Arg]
args <- [Arg] -> P [Arg] -> P [Arg]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] (P [Arg] -> P [Arg]) -> P [Arg] -> P [Arg]
forall a b. (a -> b) -> a -> b
$ P [Arg] -> P [Arg]
forall a. P a -> P a
inParens (P [Arg] -> P [Arg]) -> P [Arg] -> P [Arg]
forall a b. (a -> b) -> a -> b
$ ParsecT Text PState Identity Arg -> P [Char] -> P [Arg]
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 <- Parsec Text PState [Markup]
-> ParsecT Text PState Identity [[Markup]]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (Parsec Text PState [Markup]
 -> ParsecT Text PState Identity [[Markup]])
-> Parsec Text PState [Markup]
-> ParsecT Text PState Identity [[Markup]]
forall a b. (a -> b) -> a -> b
$ do
    -- make sure we haven't had a space
    Bool
skippedSpaces <- Maybe (SourcePos, Text) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (SourcePos, Text) -> Bool)
-> (PState -> Maybe (SourcePos, Text)) -> PState -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PState -> Maybe (SourcePos, Text)
stBeforeSpace (PState -> Bool)
-> ParsecT Text PState Identity PState
-> ParsecT Text PState Identity Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState Identity PState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
    if Bool
skippedSpaces
      then Parsec Text PState [Markup]
forall a. ParsecT Text PState Identity a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
      else do
        Content [Markup]
ms <- ParsecT Text PState Identity Block
pContent
        [Markup] -> Parsec Text PState [Markup]
forall a. a -> ParsecT Text PState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Markup]
ms
  [Arg] -> P [Arg]
forall a. a -> ParsecT Text PState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Arg] -> P [Arg]) -> [Arg] -> P [Arg]
forall a b. (a -> b) -> a -> b
$ [Arg]
args [Arg] -> [Arg] -> [Arg]
forall a. [a] -> [a] -> [a]
++ ([Markup] -> Arg) -> [[Markup]] -> [Arg]
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 ParsecT Text PState Identity Arg
-> ParsecT Text PState Identity Arg
-> ParsecT Text PState Identity Arg
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 ParsecT Text PState Identity Arg
-> ParsecT Text PState Identity Arg
-> ParsecT Text PState Identity Arg
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 (Identifier -> Expr -> Arg)
-> ParsecT Text PState Identity Identifier
-> ParsecT Text PState Identity (Expr -> Arg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState Identity Identifier
-> ParsecT Text PState Identity Identifier
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text PState Identity Identifier
pIdentifier ParsecT Text PState Identity Identifier
-> P [Char] -> ParsecT Text PState Identity Identifier
forall a b.
ParsecT Text PState Identity a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* [Char] -> P [Char]
sym [Char]
":") ParsecT Text PState Identity (Expr -> Arg)
-> ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity Arg
forall a b.
ParsecT Text PState Identity (a -> b)
-> ParsecT Text PState Identity a -> ParsecT Text PState Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text PState Identity Expr
pExpr
    pNormalArg :: ParsecT Text PState Identity Arg
pNormalArg = Expr -> Arg
NormalArg (Expr -> Arg)
-> ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity Arg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState Identity Expr
pExpr
    pSpreadArg :: ParsecT Text PState Identity Arg
pSpreadArg = Expr -> Arg
SpreadArg (Expr -> Arg)
-> ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity Arg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity Expr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([Char] -> P [Char]
string [Char]
".." P [Char]
-> ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity Expr
forall a b.
ParsecT Text PState Identity a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text PState Identity Expr
pExpr)

-- params ::= '(' (param (',' param)* ','?)? ')'
pParams :: P [Param]
pParams :: ParsecT Text PState Identity [Param]
pParams = ParsecT Text PState Identity [Param]
-> ParsecT Text PState Identity [Param]
forall a. P a -> P a
inParens (ParsecT Text PState Identity [Param]
 -> ParsecT Text PState Identity [Param])
-> ParsecT Text PState Identity [Param]
-> ParsecT Text PState Identity [Param]
forall a b. (a -> b) -> a -> b
$ ParsecT Text PState Identity Param
-> P [Char] -> ParsecT Text PState Identity [Param]
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 Param
pParam ([Char] -> P [Char]
sym [Char]
",")

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

pBind :: P Bind
pBind :: P Bind
pBind = P Bind
pBasicBind P Bind -> P Bind -> P Bind
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 (Maybe Identifier -> Bind)
-> ParsecT Text PState Identity (Maybe Identifier) -> P Bind
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState Identity (Maybe Identifier)
-> ParsecT Text PState Identity (Maybe Identifier)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text PState Identity (Maybe Identifier)
pBindIdentifier ParsecT Text PState Identity (Maybe Identifier)
-> ParsecT Text PState Identity (Maybe Identifier)
-> ParsecT Text PState Identity (Maybe Identifier)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text PState Identity (Maybe Identifier)
-> ParsecT Text PState Identity (Maybe Identifier)
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 <- ParsecT Text PState Identity Identifier
pIdentifier
  if Identifier
ident Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
"_"
     then Maybe Identifier -> ParsecT Text PState Identity (Maybe Identifier)
forall a. a -> ParsecT Text PState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Identifier
forall a. Maybe a
Nothing
     else Maybe Identifier -> ParsecT Text PState Identity (Maybe Identifier)
forall a. a -> ParsecT Text PState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Identifier
 -> ParsecT Text PState Identity (Maybe Identifier))
-> Maybe Identifier
-> ParsecT Text PState Identity (Maybe Identifier)
forall a b. (a -> b) -> a -> b
$ Identifier -> Maybe Identifier
forall a. a -> Maybe a
Just Identifier
ident

pDestructuringBind :: P Bind
pDestructuringBind :: P Bind
pDestructuringBind =
  P Bind -> P Bind
forall a. P a -> P a
inParens (P Bind -> P Bind) -> P Bind -> P Bind
forall a b. (a -> b) -> a -> b
$
    [BindPart] -> Bind
DestructuringBind ([BindPart] -> Bind)
-> ParsecT Text PState Identity [BindPart] -> P Bind
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Text PState Identity BindPart
pBindPart ParsecT Text PState Identity BindPart
-> P [Char] -> ParsecT Text PState Identity [BindPart]
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 <- Bool
-> ParsecT Text PState Identity Bool
-> ParsecT Text PState Identity Bool
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Bool
False (ParsecT Text PState Identity Bool
 -> ParsecT Text PState Identity Bool)
-> ParsecT Text PState Identity Bool
-> ParsecT Text PState Identity Bool
forall a b. (a -> b) -> a -> b
$ Bool
True Bool -> P [Char] -> ParsecT Text PState Identity Bool
forall a b.
a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P [Char]
string [Char]
".."
      if Bool
sink
        then do
          Maybe Identifier
ident <- Maybe Identifier
-> ParsecT Text PState Identity (Maybe Identifier)
-> ParsecT Text PState Identity (Maybe Identifier)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Maybe Identifier
forall a. Maybe a
Nothing ParsecT Text PState Identity (Maybe Identifier)
pBindIdentifier -- ..
          BindPart -> ParsecT Text PState Identity BindPart
forall a. a -> ParsecT Text PState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BindPart -> ParsecT Text PState Identity BindPart)
-> BindPart -> ParsecT Text PState Identity BindPart
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 -> BindPart -> ParsecT Text PState Identity BindPart
forall a. a -> ParsecT Text PState Identity a
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 (Maybe Identifier -> BindPart)
-> ParsecT Text PState Identity (Maybe Identifier)
-> ParsecT Text PState Identity BindPart
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> P [Char]
sym [Char]
":" P [Char]
-> ParsecT Text PState Identity (Maybe Identifier)
-> ParsecT Text PState Identity (Maybe Identifier)
forall a b.
ParsecT Text PState Identity a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text PState Identity (Maybe Identifier)
pBindIdentifier))
                ParsecT Text PState Identity BindPart
-> ParsecT Text PState Identity BindPart
-> ParsecT Text PState Identity BindPart
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> BindPart -> ParsecT Text PState Identity BindPart
forall a. a -> ParsecT Text PState Identity 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 :: ParsecT Text PState Identity Expr
pLetExpr = do
  [Char] -> ParsecT Text PState Identity ()
pKeyword [Char]
"let"
  Bind
bind <- P Bind
pBind
  case Bind
bind of
    BasicBind Maybe Identifier
mbname -> do
      Maybe [Param]
mbparams <- Maybe [Param]
-> ParsecT Text PState Identity (Maybe [Param])
-> ParsecT Text PState Identity (Maybe [Param])
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Maybe [Param]
forall a. Maybe a
Nothing (ParsecT Text PState Identity (Maybe [Param])
 -> ParsecT Text PState Identity (Maybe [Param]))
-> ParsecT Text PState Identity (Maybe [Param])
-> ParsecT Text PState Identity (Maybe [Param])
forall a b. (a -> b) -> a -> b
$ [Param] -> Maybe [Param]
forall a. a -> Maybe a
Just ([Param] -> Maybe [Param])
-> ParsecT Text PState Identity [Param]
-> ParsecT Text PState Identity (Maybe [Param])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState Identity [Param]
pParams
      Maybe Expr
mbexpr <- Maybe Expr
-> ParsecT Text PState Identity (Maybe Expr)
-> ParsecT Text PState Identity (Maybe Expr)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Maybe Expr
forall a. Maybe a
Nothing (ParsecT Text PState Identity (Maybe Expr)
 -> ParsecT Text PState Identity (Maybe Expr))
-> ParsecT Text PState Identity (Maybe Expr)
-> ParsecT Text PState Identity (Maybe Expr)
forall a b. (a -> b) -> a -> b
$ Expr -> Maybe Expr
forall a. a -> Maybe a
Just (Expr -> Maybe Expr)
-> ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity (Maybe Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> P [Char]
sym [Char]
"=" P [Char]
-> ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity Expr
forall a b.
ParsecT Text PState Identity a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text PState Identity Expr
pExpr)
      case (Maybe [Param]
mbparams, Maybe Expr
mbexpr, Maybe Identifier
mbname) of
        (Maybe [Param]
Nothing, Maybe Expr
Nothing, Maybe Identifier
_) -> Expr -> ParsecT Text PState Identity Expr
forall a. a -> ParsecT Text PState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr -> ParsecT Text PState Identity Expr)
-> Expr -> ParsecT Text PState Identity Expr
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
_) -> Expr -> ParsecT Text PState Identity Expr
forall a. a -> ParsecT Text PState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr -> ParsecT Text PState Identity Expr)
-> Expr -> ParsecT Text PState Identity Expr
forall a b. (a -> b) -> a -> b
$ Bind -> Expr -> Expr
Let Bind
bind Expr
expr
        (Just [Param]
params, Just Expr
expr, Just Identifier
name) -> Expr -> ParsecT Text PState Identity Expr
forall a. a -> ParsecT Text PState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr -> ParsecT Text PState Identity Expr)
-> Expr -> ParsecT Text PState Identity Expr
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) -> [Char] -> ParsecT Text PState Identity Expr
forall a. [Char] -> ParsecT Text PState Identity a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"expected name for function"
        (Just [Param]
_, Maybe Expr
Nothing, Maybe Identifier
_) -> [Char] -> ParsecT Text PState Identity Expr
forall a. [Char] -> ParsecT Text PState Identity a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"expected expression for let binding"
    Bind
_ -> Bind -> Expr -> Expr
Let Bind
bind (Expr -> Expr)
-> ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> P [Char]
sym [Char]
"=" P [Char]
-> ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity Expr
forall a b.
ParsecT Text PState Identity a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text PState Identity Expr
pExpr)

-- set-expr ::= 'set' expr args
pSetExpr :: P Expr
pSetExpr :: ParsecT Text PState Identity Expr
pSetExpr = do
  Int
oldAllowNewlines <- PState -> Int
stAllowNewlines (PState -> Int)
-> ParsecT Text PState Identity PState
-> ParsecT Text PState Identity Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState Identity PState
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
  (PState -> PState) -> ParsecT Text PState Identity ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((PState -> PState) -> ParsecT Text PState Identity ())
-> (PState -> PState) -> ParsecT Text PState Identity ()
forall a b. (a -> b) -> a -> b
$ \PState
st -> PState
st {stAllowNewlines = 0}
  Expr
set <- [Char] -> ParsecT Text PState Identity ()
pKeyword [Char]
"set" ParsecT Text PState Identity ()
-> ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity Expr
forall a b.
ParsecT Text PState Identity a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Expr -> [Arg] -> Expr
Set (Expr -> [Arg] -> Expr)
-> ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity ([Arg] -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState Identity Expr
pQualifiedIdentifier ParsecT Text PState Identity ([Arg] -> Expr)
-> P [Arg] -> ParsecT Text PState Identity Expr
forall a b.
ParsecT Text PState Identity (a -> b)
-> ParsecT Text PState Identity a -> ParsecT Text PState Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P [Arg]
pArgs)
  (PState -> PState) -> ParsecT Text PState Identity ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((PState -> PState) -> ParsecT Text PState Identity ())
-> (PState -> PState) -> ParsecT Text PState Identity ()
forall a b. (a -> b) -> a -> b
$ \PState
st -> PState
st {stAllowNewlines = oldAllowNewlines}
  Expr -> Expr
addCondition <- (Expr -> Expr)
-> ParsecT Text PState Identity (Expr -> Expr)
-> ParsecT Text PState Identity (Expr -> Expr)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Expr -> Expr
forall a. a -> a
id (ParsecT Text PState Identity (Expr -> Expr)
 -> ParsecT Text PState Identity (Expr -> Expr))
-> ParsecT Text PState Identity (Expr -> Expr)
-> ParsecT Text PState Identity (Expr -> Expr)
forall a b. (a -> b) -> a -> b
$ [Char] -> ParsecT Text PState Identity ()
pKeyword [Char]
"if" ParsecT Text PState Identity ()
-> ParsecT Text PState Identity (Expr -> Expr)
-> ParsecT Text PState Identity (Expr -> Expr)
forall a b.
ParsecT Text PState Identity a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ((\Expr
c Expr
x -> [(Expr, Expr)] -> Expr
If [(Expr
c, Expr
x)]) (Expr -> Expr -> Expr)
-> ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity (Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState Identity Expr
pExpr)
  Expr -> ParsecT Text PState Identity Expr
forall a. a -> ParsecT Text PState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr -> ParsecT Text PState Identity Expr)
-> Expr -> ParsecT Text PState Identity Expr
forall a b. (a -> b) -> a -> b
$ Expr -> Expr
addCondition Expr
set

pShowExpr :: P Expr
pShowExpr :: ParsecT Text PState Identity Expr
pShowExpr = do
  [Char] -> ParsecT Text PState Identity ()
pKeyword [Char]
"show"
  Maybe Expr
from <- (Maybe Expr
forall a. Maybe a
Nothing Maybe Expr -> P [Char] -> ParsecT Text PState Identity (Maybe Expr)
forall a b.
a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P [Char]
sym [Char]
":") ParsecT Text PState Identity (Maybe Expr)
-> ParsecT Text PState Identity (Maybe Expr)
-> ParsecT Text PState Identity (Maybe Expr)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Expr -> Maybe Expr
forall a. a -> Maybe a
Just (Expr -> Maybe Expr)
-> ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity (Maybe Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Text PState Identity Expr
pBasicExpr ParsecT Text PState Identity Expr
-> P [Char] -> ParsecT Text PState Identity Expr
forall a b.
ParsecT Text PState Identity a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* [Char] -> P [Char]
sym [Char]
":")
  Expr
to <- ParsecT Text PState Identity Expr
pBasicExpr
  Expr -> ParsecT Text PState Identity Expr
forall a. a -> ParsecT Text PState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr -> ParsecT Text PState Identity Expr)
-> Expr -> ParsecT Text PState Identity Expr
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 :: ParsecT Text PState Identity Expr
pIfExpr = do
  (Expr, Expr)
a <- ParsecT Text PState Identity (Expr, Expr)
pIf
  [(Expr, Expr)]
as <- ParsecT Text PState Identity (Expr, Expr)
-> ParsecT Text PState Identity [(Expr, Expr)]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT Text PState Identity (Expr, Expr)
 -> ParsecT Text PState Identity [(Expr, Expr)])
-> ParsecT Text PState Identity (Expr, Expr)
-> ParsecT Text PState Identity [(Expr, Expr)]
forall a b. (a -> b) -> a -> b
$ ParsecT Text PState Identity (Expr, Expr)
-> ParsecT Text PState Identity (Expr, Expr)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([Char] -> ParsecT Text PState Identity ()
pKeyword [Char]
"else" ParsecT Text PState Identity ()
-> ParsecT Text PState Identity (Expr, Expr)
-> ParsecT Text PState Identity (Expr, Expr)
forall a b.
ParsecT Text PState Identity a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text PState Identity (Expr, Expr)
pIf)
  [(Expr, Expr)]
finalElse <-
    [(Expr, Expr)]
-> ParsecT Text PState Identity [(Expr, Expr)]
-> ParsecT Text PState Identity [(Expr, Expr)]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] (ParsecT Text PState Identity [(Expr, Expr)]
 -> ParsecT Text PState Identity [(Expr, Expr)])
-> ParsecT Text PState Identity [(Expr, Expr)]
-> ParsecT Text PState Identity [(Expr, Expr)]
forall a b. (a -> b) -> a -> b
$
      -- we represent the final "else" as a conditional with expr True:
      ((Expr, Expr) -> [(Expr, Expr)] -> [(Expr, Expr)]
forall a. a -> [a] -> [a]
: []) ((Expr, Expr) -> [(Expr, Expr)])
-> (Expr -> (Expr, Expr)) -> Expr -> [(Expr, Expr)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Literal -> Expr
Literal (Bool -> Literal
Boolean Bool
True),) (Expr -> [(Expr, Expr)])
-> ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity [(Expr, Expr)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> ParsecT Text PState Identity ()
pKeyword [Char]
"else" ParsecT Text PState Identity ()
-> ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity Expr
forall a b.
ParsecT Text PState Identity a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text PState Identity Expr
pBlock)
  Expr -> ParsecT Text PState Identity Expr
forall a. a -> ParsecT Text PState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> ParsecT Text PState Identity Expr)
-> Expr -> ParsecT Text PState Identity Expr
forall a b. (a -> b) -> a -> b
$ [(Expr, Expr)] -> Expr
If ((Expr, Expr)
a (Expr, Expr) -> [(Expr, Expr)] -> [(Expr, Expr)]
forall a. a -> [a] -> [a]
: [(Expr, Expr)]
as [(Expr, Expr)] -> [(Expr, Expr)] -> [(Expr, Expr)]
forall a. [a] -> [a] -> [a]
++ [(Expr, Expr)]
finalElse)
  where
    pIf :: ParsecT Text PState Identity (Expr, Expr)
pIf = [Char] -> ParsecT Text PState Identity ()
pKeyword [Char]
"if" ParsecT Text PState Identity ()
-> ParsecT Text PState Identity (Expr, Expr)
-> ParsecT Text PState Identity (Expr, Expr)
forall a b.
ParsecT Text PState Identity a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ((,) (Expr -> Expr -> (Expr, Expr))
-> ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity (Expr -> (Expr, Expr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState Identity Expr
pExpr ParsecT Text PState Identity (Expr -> (Expr, Expr))
-> ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity (Expr, Expr)
forall a b.
ParsecT Text PState Identity (a -> b)
-> ParsecT Text PState Identity a -> ParsecT Text PState Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text PState Identity Expr
pBlock)

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

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

pImportExpr :: P Expr
pImportExpr :: ParsecT Text PState Identity Expr
pImportExpr = [Char] -> ParsecT Text PState Identity ()
pKeyword [Char]
"import" ParsecT Text PState Identity ()
-> ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity Expr
forall a b.
ParsecT Text PState Identity a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Expr -> Imports -> Expr
Import (Expr -> Imports -> Expr)
-> ParsecT Text PState Identity Expr
-> ParsecT Text PState Identity (Imports -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState Identity Expr
pExpr ParsecT Text PState Identity (Imports -> Expr)
-> ParsecT Text PState Identity Imports
-> ParsecT Text PState Identity Expr
forall a b.
ParsecT Text PState Identity (a -> b)
-> ParsecT Text PState Identity a -> ParsecT Text PState Identity b
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]
":"
          P [Char]
-> ParsecT Text PState Identity Imports
-> ParsecT Text PState Identity Imports
forall a b.
ParsecT Text PState Identity a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ( (Imports
AllIdentifiers Imports -> P [Char] -> ParsecT Text PState Identity Imports
forall a b.
a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> P [Char]
sym [Char]
"*")
                 ParsecT Text PState Identity Imports
-> ParsecT Text PState Identity Imports
-> ParsecT Text PState Identity Imports
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
                       ([(Identifier, Maybe Identifier)] -> Imports)
-> ParsecT Text PState Identity [(Identifier, Maybe Identifier)]
-> ParsecT Text PState Identity Imports
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text PState Identity (Identifier, Maybe Identifier)
-> P [Char]
-> ParsecT Text PState Identity [(Identifier, Maybe Identifier)]
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]
","))
             )
        ) ParsecT Text PState Identity Imports
-> ParsecT Text PState Identity Imports
-> ParsecT Text PState Identity Imports
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Maybe Identifier -> Imports
NoIdentifiers (Maybe Identifier -> Imports)
-> ParsecT Text PState Identity (Maybe Identifier)
-> ParsecT Text PState Identity Imports
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 <- ParsecT Text PState Identity Identifier
pIdentifier
      Maybe Identifier
mbAs <- ParsecT Text PState Identity (Maybe Identifier)
pAs
      (Identifier, Maybe Identifier)
-> ParsecT Text PState Identity (Identifier, Maybe Identifier)
forall a. a -> ParsecT Text PState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Identifier
ident, Maybe Identifier
mbAs)
    pAs :: ParsecT Text PState Identity (Maybe Identifier)
pAs = Maybe Identifier
-> ParsecT Text PState Identity (Maybe Identifier)
-> ParsecT Text PState Identity (Maybe Identifier)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Maybe Identifier
forall a. Maybe a
Nothing (ParsecT Text PState Identity (Maybe Identifier)
 -> ParsecT Text PState Identity (Maybe Identifier))
-> ParsecT Text PState Identity (Maybe Identifier)
-> ParsecT Text PState Identity (Maybe Identifier)
forall a b. (a -> b) -> a -> b
$ Identifier -> Maybe Identifier
forall a. a -> Maybe a
Just (Identifier -> Maybe Identifier)
-> ParsecT Text PState Identity Identifier
-> ParsecT Text PState Identity (Maybe Identifier)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> ParsecT Text PState Identity ()
pKeyword [Char]
"as" ParsecT Text PState Identity ()
-> ParsecT Text PState Identity Identifier
-> ParsecT Text PState Identity Identifier
forall a b.
ParsecT Text PState Identity a
-> ParsecT Text PState Identity b -> ParsecT Text PState Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text PState Identity Identifier
pIdentifier)

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

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

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

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