{-# 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)
stSpaceBefore :: Maybe (SourcePos, Text),
    PState -> Maybe (SourcePos, Markup)
stLastMathTok :: Maybe (SourcePos, Markup),
    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,
      stSpaceBefore :: Maybe (SourcePos, Text)
stSpaceBefore = Maybe (SourcePos, Text)
forall a. Maybe a
Nothing,
      stLastMathTok :: Maybe (SourcePos, Markup)
stLastMathTok = Maybe (SourcePos, Markup)
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
  p1 <- ParsecT Text PState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  inp <- getInput
  allowNewlines <- stAllowNewlines <$> getState
  let 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'
  ( skipMany1 (void (satisfy isSp) <|> void pComment)
      *> updateState (\PState
st -> PState
st {stSpaceBefore = Just (p1, inp)})
    )
    <|> updateState (\PState
st -> PState
st {stSpaceBefore = 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}
  res <- P a
pa
  updateState $ \PState
st -> PState
st {stAllowNewlines = stAllowNewlines st - 1}
  pure 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
  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
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 . T.singleton <$> satisfy 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
    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
    ws
    maths <- many pMath
    void $ char '$'
    pure $ Equation display maths

mathOperatorTable :: [[Operator Text PState Identity Markup]]
mathOperatorTable :: [[Operator Text PState Identity Markup]]
mathOperatorTable =
  [ -- precedence 7 -- attachment with number, e.g. a_1 (#17), or (..) group
    [ 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 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))))
        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 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))))
        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
            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
isNothing (Maybe (SourcePos, Text) -> Bool)
-> (PState -> Maybe (SourcePos, Text)) -> PState -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PState -> Maybe (SourcePos, Text)
stSpaceBefore
            -- NOTE: can't have space before () or [] arg in a
            -- function call! to prevent bugs with e.g. 'if 2<3 [...]'.
            pos <- ParsecT Text PState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
            lastMathTok <- stLastMathTok <$> getState
            -- 1(a) is not a function
            -- !(a) is not a function
            -- f(a) is a function
            -- "alpha"(a) is a function
            -- alpha(a) is a function
            -- see #55
            -- but we still don't match typst for "!"(a), which typst DOES consider
            -- a function
            guard $ case lastMathTok of
                      Just (SourcePos
pos', MGroup Maybe Text
_ (Just Text
t) [Markup]
_)
                        | SourcePos
pos SourcePos -> SourcePos -> Bool
forall a. Eq a => a -> a -> Bool
== SourcePos
pos' -> (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isLetter Text
t
                      Just (SourcePos
pos', Text Text
t)
                        | SourcePos
pos SourcePos -> SourcePos -> Bool
forall a. Eq a => a -> a -> Bool
== SourcePos
pos'
                        -> case Text -> Maybe (Text, Char)
T.unsnoc Text
t of
                                  Maybe (Text, Char)
Nothing -> Bool
True
                                  Just (Text
_,Char
c) -> Char -> Bool
isLetter Char
c
                      Maybe (SourcePos, Markup)
_ -> Bool
True
            args <- mGrouped '(' ')' True
            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, Markup
args]
        )
    ],
    -- precedence 5  -- 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
                  mbBeforeSpace <- PState -> Maybe (SourcePos, Text)
stSpaceBefore (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
                  guard $ isNothing mbBeforeSpace
                  lexeme $ char '!' *> notFollowedBy (char '=')
                  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 4 -- 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 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
    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
'_')
    ds <- many $ 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
'-')
    pure $ Identifier $ T.pack (d : 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
        mbBeforeSpace <- PState -> Maybe (SourcePos, Text)
stSpaceBefore (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 [...]'.
        guard $ isNothing mbBeforeSpace
        args <- mArgs
        pure $ \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 u (m :: * -> *) a. 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
                      x <- ParsecT Text PState Identity Markup
pMath
                      pure $
                        FuncCall
                          (Ident (Identifier "root"))
                          [NormalArg (Block (Content [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
  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
'_')
  ds <- many1 $ 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
'-')
  pure $ Identifier $ T.pack (d : 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 = do
  tok <-    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
  pos <- getPosition
  updateState $ \PState
s -> PState
s{ stLastMathTok = Just (pos, tok) }
  pure tok

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']
  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)
  (MGroup (Just (T.singleton op')) (Just (T.singleton cl)) res <$ void (sym [cl]))
    <|> (MGroup (Just (T.singleton op')) Nothing res <$ guard (not 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
  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 u (m :: * -> *) a. 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
  opt <-
    option
      mempty
      ( do
          e <- char '.'
          es <- many digit
          pure $ T.pack (e : es)
      )
  pure $ Text (ds <> opt)

mLiteral :: P Markup
mLiteral :: ParsecT Text PState Identity Markup
mLiteral = do
  mbBeforeSpace <- PState -> Maybe (SourcePos, Text)
stSpaceBefore (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 t <- pStr
  -- ensure space in e.g. x "is natural":
  mbAfterSpace <- stSpaceBefore <$> getState
  pure $
    Text $
      (maybe "" (const " ") mbBeforeSpace)
        <> t
        <> (maybe "" (const " ") 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
      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]
":"
      KeyValArg ident
        <$> ( (char '#' *> pExpr <* sep)
                <|> Block . Content <$> (ws *> mathContent)
            )
    mathContent :: Parsec Text PState [Markup]
mathContent = do
      xs <- Parsec Text PState [Markup]
maths
      if null xs
        then void $ sym ","
        else sep
      pure 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]
",")
      rows <- Parsec Text PState [Markup]
-> ParsecT Text PState Identity [[Markup]]
forall s u (m :: * -> *) a. 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
      lastrow <- many (toGroup <$> mathContent)
      let 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]
      pure $ ArrayArg 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
      x <- ParsecT s u m a
p
      xs <- many (try (s *> p))
      pure (x : 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)
stSpaceBefore
  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
  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
  updateState $ \PState
st -> PState
st {stIndent = indent : oldIndent}
  ms <- pa
  updateState $ \PState
st -> PState
st {stIndent = oldIndent}
  pure ms

-- list ::= '-' space markup
-- enum ::= (digit+ '.' | '+') space markup
-- desc ::= '/' space markup ':' space markup
pListItem :: P Markup
pListItem :: ParsecT Text PState Identity Markup
pListItem = do
  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
  startLine <- stLineStartCol <$> getState
  guard (col == startLine)
  try
    ( do
        void $ char '-'
        void (char ' ') <|> pBlankline
        BulletListItem <$> withIndent col (many pMarkup)
    )
    <|> try
      ( do
          start <- (Nothing <$ char '+') <|> (Just <$> enumListStart)
          void (char ' ') <|> pBlankline
          EnumListItem start <$> withIndent col (many pMarkup)
      )
    <|> try
      ( do
          -- desc list
          void (char '/')
          void (many1 (char ' '))
          term <- manyTill pMarkup (char ':')
          skipMany spaceChar
          optional pBlankline
          DescListItem term <$> withIndent col (many pMarkup)
      )

enumListStart :: P Int
enumListStart :: ParsecT Text PState Identity Int
enumListStart = do
  ds <- ParsecT Text PState Identity Char -> P [Char]
forall s u (m :: * -> *) a. 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
  void $ char '.'
  case readMaybe 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 u (m :: * -> *) a. 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
  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 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 ()
  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
  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
  updateState $ \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]
"```"
  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
'`')
  lang <- T.pack <$> (many alphaNum <* optional (char ' '))
  optional $ try $ skipMany (char ' ') *> pEol
  let 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
  code <-
    T.pack
      <$> manyTill
        (nl <|> anyChar)
        (string (replicate numticks '`'))
  skipMany (char '`')
  pure $ RawBlock lang code

optionalGobbleIndent :: P ()
optionalGobbleIndent :: ParsecT Text PState Identity ()
optionalGobbleIndent = do
  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 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
  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
  lineStartCol <- stLineStartCol <$> getState
  guard (col == lineStartCol)
  lev <- length <$> many1 (char '=')
  void (many1 (char ' ')) <|> void (lookAhead endOfLine)
  -- Note: == hi _foo
  -- bar_ is parsed as a heading with "hi emph(foobar)"
  ms <- manyTill pMarkup (    void pEol
                          <|> pEndOfContent
                          <|> void (lookAhead (try (spaces *> pLabel)))
                          <|> void (lookAhead (char ']')))
  skipMany spaceChar
  pure $ Heading lev 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
  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://")
  rest <- T.pack <$> pNonspaceWithBalancedBrackets 0 0 0
  pure $ Url $ prot <> 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 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
       T.pack . (xs <>) <$>
             try (some (char '*' <|> char '_') <* lookAhead (satisfy nonCJKAlphaNum))
        <|> pure (T.pack 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))))
  )

nonCJKAlphaNum :: Char -> Bool
nonCJKAlphaNum :: Char -> Bool
nonCJKAlphaNum Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isCJK Char
c)

isCJK :: Char -> Bool
isCJK :: Char -> Bool
isCJK Char
c | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< Char
'\x2e80' = Bool
False
isCJK Char
c =
          (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x2e80' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x2eff') -- CJK Radicals Supplement
       Bool -> Bool -> Bool
|| (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x2f00' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x2fdf') -- Kangxi Radicals
       Bool -> Bool -> Bool
|| (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x2ff0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x2fff') -- Ideographic Description Characters
       Bool -> Bool -> Bool
|| (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x3000' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x303f') -- JK Symbols and Punctuation
       Bool -> Bool -> Bool
|| (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x3040' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x309f') -- Hiragana
       Bool -> Bool -> Bool
|| (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x30a0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x30ff') -- Katakana
       Bool -> Bool -> Bool
|| (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x3100' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x312f') -- Bopomofo
       Bool -> Bool -> Bool
|| (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x3130' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x318f') -- Kanbun
       Bool -> Bool -> Bool
|| (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x3190' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x319f') -- Kanbun
       Bool -> Bool -> Bool
|| (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x31c0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x31ef') -- CJK Strokes
       Bool -> Bool -> Bool
|| (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x31f0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x31ff') -- Katakana Phonetic Extensions
       Bool -> Bool -> Bool
|| (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x3200' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x32ff') -- Enclosed CJK Letters & Months
       Bool -> Bool -> Bool
|| (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x3300' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x33ff') -- CJK Compatibility
       Bool -> Bool -> Bool
|| (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x3400' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x4dbf') -- CJK Unified Ideographs Extension A
       Bool -> Bool -> Bool
|| (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x4e00' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x9fff') -- CJK Unified Ideographs
       Bool -> Bool -> Bool
|| (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xa000' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xa48f') -- Yi Syllables
       Bool -> Bool -> Bool
|| (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xa490' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xa4cf') -- Yi Radicals
       Bool -> Bool -> Bool
|| (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xf900' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xfaff') -- CJK Compatibility Ideographs
       Bool -> Bool -> Bool
|| (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xfe10' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xfe1f') -- Vertical forms
       Bool -> Bool -> Bool
|| (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xfe30' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xfe4f') -- CJK Compatibility Forms
       Bool -> Bool -> Bool
|| (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xFE50' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xFE6F') -- Small Form Variants
       Bool -> Bool -> Bool
|| (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xFF00' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xFFEE') -- Halfwidth and Fullwidth Forms
       Bool -> Bool -> Bool
|| (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x1B000' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x1B0FF') -- Kana Supplement
       Bool -> Bool -> Bool
|| (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x1B100' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x1B12F') -- Kana Extended-A
       Bool -> Bool -> Bool
|| (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x1B130' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x1B16F') -- Small Kana Extension
       Bool -> Bool -> Bool
|| (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x20000' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x2A6DF') -- CJK Unified Ideographs Extension B
       Bool -> Bool -> Bool
|| (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x2A700' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x2B73F') -- CJK Unified Ideographs Extension C
       Bool -> Bool -> Bool
|| (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x2B740' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x2B81F') -- CJK Unified Ideographs Extension D
       Bool -> Bool -> Bool
|| (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x2B820' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x2CEAF') -- CJK Unified Ideographs Extension E
       Bool -> Bool -> Bool
|| (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x2CEB0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x2EBEF') -- CJK Unified Ideographs Extension F
       Bool -> Bool -> Bool
|| (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x2F800' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x2FA1F') -- CJK Compatibility Ideographs Supp
       Bool -> Bool -> Bool
|| (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x30000' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x3134F') -- CJK Unified Ideographs Exten

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
      ds <- ParsecT Text PState Identity Char -> P [Char]
forall s u (m :: * -> *) a. 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 readMaybe ("0x" ++ 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 a. P a -> P a
lexeme (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 u (m :: * -> *) a. 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 u (m :: * -> *) a. 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
'#'
  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:
  mbBeforeSpace <- stSpaceBefore <$> getState
  case 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
  pure 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
  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
  cs <- many $ satisfy isIdentContinue
  pure $ Identifier $ T.pack (c : 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
        mbBeforeSpace <- PState -> Maybe (SourcePos, Text)
stSpaceBefore (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 [...]'.
        guard $ isNothing mbBeforeSpace
        args <- pArgs
        pure $ \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
  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 pref of
    [Char]
"0b" -> do
      nums <- 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]
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'))
      pure $ Left $ sum $ zipWith (*) (reverse nums) (map (2 ^) [(0 :: Integer) ..])
    [Char]
"0x" -> do
      num <- ParsecT Text PState Identity Char -> P [Char]
forall s u (m :: * -> *) a. 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 readMaybe ("0x" ++ 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
      num <- ParsecT Text PState Identity Char -> P [Char]
forall s u (m :: * -> *) a. 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 readMaybe ("0o" ++ 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
      as <- ParsecT Text PState Identity Char -> P [Char]
forall s u (m :: * -> *) a. 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)))
      pe <- option [] $ string "."
      bs <- many digit
      es <-
        option
          ""
          ( do
              void $ try $ char 'e' *> lookAhead (digit <|> char '-')
              minus <- option [] $ count 1 (char '-')
              ds <- many1 digit
              pure ("e" ++ minus ++ ds)
          )
      let 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 readMaybe 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
  result <- P (Either Integer Double)
pNumber
  ( do
      unit <- pUnit
      case 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
    )
    <|> case 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
'['
  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
  oldLineStartCol <- stLineStartCol <$> getState
  oldIndent <- stIndent <$> getState
  updateState $ \PState
st ->
    PState
st
      { stLineStartCol = col,
        stContentBlockNesting =
          stContentBlockNesting st + 1,
        stIndent = []
      }
  ms <- manyTill pMarkup (char ']')
  ws
  updateState $ \PState
st ->
    PState
st
      { stLineStartCol = oldLineStartCol,
        stContentBlockNesting =
          stContentBlockNesting st - 1,
        stIndent = oldIndent
      }
  pure $ Content 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
    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 blockNesting > 0
      then void (lookAhead (char ']'))
      else 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
          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)
          vs <- many $ try $ sym "," *> (pSpread <|> (Reg <$> pExpr))
          if null vs
            then void $ sym ","
            else optional $ void $ sym ","
          pure $ Array (v : 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 i <- ParsecT Text PState Identity Identifier
pIdentifier
                if i == "_"
                   then pure [SkipParam]
                   else pure [NormalParam 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
    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
pContextExpr

-- 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
'[')
  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]
",")
  blocks <- many $ do
    -- make sure we haven't had a space
    skippedSpaces <- isJust . stSpaceBefore <$> getState
    if skippedSpaces
      then mzero
      else do
        Content ms <- pContent
        pure ms
  pure $ args ++ map BlockArg 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
      i <- ParsecT Text PState Identity Identifier
pIdentifier
      (DefaultParam i <$> (sym ":" *> pExpr)) <|> pure (NormalParam i)
    pDestructuringParam :: ParsecT Text PState Identity Param
pDestructuringParam = do
      DestructuringBind parts <- P Bind
pDestructuringBind
      pure $ DestructuringParam 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
  ident <- ParsecT Text PState Identity Identifier
pIdentifier
  if ident == "_"
     then pure Nothing
     else pure $ Just 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
      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 sink
        then do
          ident <- option Nothing pBindIdentifier -- ..
          pure $ Sink ident
        else do
          ident <- pBindIdentifier
          case 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 <- P Bind
pBind
  case bind of
    BasicBind Maybe Identifier
mbname -> do
      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
      mbexpr <- option Nothing $ Just <$> (sym "=" *> pExpr)
      case (mbparams, mbexpr, 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
  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
  updateState $ \PState
st -> PState
st {stAllowNewlines = 0}
  set <- pKeyword "set" *> (Set <$> pQualifiedIdentifier <*> pArgs)
  updateState $ \PState
st -> PState
st {stAllowNewlines = oldAllowNewlines}
  addCondition <- option id $ pKeyword "if" *> ((\Expr
c Expr
x -> [(Expr, Expr)] -> Expr
If [(Expr
c, Expr
x)]) <$> pExpr)
  pure $ addCondition set

pShowExpr :: P Expr
pShowExpr :: ParsecT Text PState Identity Expr
pShowExpr = do
  [Char] -> ParsecT Text PState Identity ()
pKeyword [Char]
"show"
  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]
":")
  to <- pBasicExpr
  pure $ Show from to

-- if-expr ::= 'if' expr block ('else' 'if' expr block)* ('else' block)?
pIfExpr :: P Expr
pIfExpr :: ParsecT Text PState Identity Expr
pIfExpr = do
  a <- ParsecT Text PState Identity (Expr, Expr)
pIf
  as <- many $ try (pKeyword "else" *> pIf)
  finalElse <-
    option [] $
      -- we represent the final "else" as a conditional with expr True:
      (: []) . (Literal (Boolean True),) <$> (pKeyword "else" *> pBlock)
  return $ If (a : as ++ 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
<|> ParsecT Text PState Identity Imports
-> ParsecT Text PState Identity Imports
forall a. P a -> P a
inParens ParsecT Text PState Identity Imports
pIdentifierList
                 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
<|> ParsecT Text PState Identity Imports
pIdentifierList
             )
        ) 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)
    pIdentifierList :: ParsecT Text PState Identity Imports
pIdentifierList = [(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]
",")
    pIdentifierAs :: ParsecT Text PState Identity (Identifier, Maybe Identifier)
pIdentifierAs = do
      ident <- ParsecT Text PState Identity Identifier
pIdentifier
      mbAs <- pAs
      pure (ident, 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
  pos <- ParsecT Text PState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  pKeyword "return"
  pos' <- getPosition
  if sourceLine pos' > sourceLine pos
    then pure $ Return Nothing
    else Return <$> (option Nothing (Just <$> pExpr))

pContextExpr :: P Expr
pContextExpr :: ParsecT Text PState Identity Expr
pContextExpr = Expr -> Expr
Context (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]
"context" 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)

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)