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

module Typst.Parse
  ( parseTypst,
  )
where

import Data.List (sortOn, intercalate, dropWhileEnd)
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 fp inp =
  case runParser (spaces *> many pMarkup <* pEndOfContent) initialState fp inp of
    Left e -> Left e
    Right r -> Right r

data PState = PState
  { stAtStart :: !Bool,
    stAllowNewlines :: !Int, -- allow newlines if > 0
    stSpaceBefore :: Maybe (SourcePos, Text),
    stLastMathTok :: Maybe (SourcePos, Markup),
    stContentBlockNesting :: Int,
    stBracketNesting :: Int
  }
  deriving (Show)

initialState :: PState
initialState =
  PState
    { stAtStart = True,
      stAllowNewlines = 0,
      stSpaceBefore = Nothing,
      stLastMathTok = Nothing,
      stContentBlockNesting = 0,
      stBracketNesting = 0
    }

type P = Parsec Text PState

string :: String -> P String
string = try . P.string

ws :: P ()
ws = do
  p1 <- getPosition
  inp <- getInput
  allowNewlines <- stAllowNewlines <$> getState
  let isSp c
        | allowNewlines > 0 = isSpace c
        | otherwise = isSpace c && c /= '\r' && c /= '\n'
  ( skipMany1 (void (satisfy isSp) <|> void pComment)
      *> updateState (\st -> st {stSpaceBefore = Just (p1, inp)})
    )
    <|> updateState (\st -> st {stSpaceBefore = Nothing})

lexeme :: P a -> P a
lexeme pa = pa <* ws

sym :: String -> P String
sym = lexeme . string

op :: String -> P ()
op s = try $ lexeme $ do
  void $ string s
  when
    ( s == "+"
        || s == "-"
        || s == "*"
        || s == "/"
        || s == "="
        || s == "<"
        || s == ">"
        || s == "!"
    )
    $ notFollowedBy (char '=')
  when (s == "-") $
    notFollowedBy (char '>') -- arrows
  when (s == "<") $
    notFollowedBy (char '-' <|> char '=') -- arrows
  when (s == "=") $
    notFollowedBy (char '>' <|> char '=')

withNewlines :: P a -> P a
withNewlines pa = do
  updateState $ \st -> st {stAllowNewlines = stAllowNewlines st + 1}
  res <- pa
  updateState $ \st -> st {stAllowNewlines = stAllowNewlines st - 1}
  pure res

inParens :: P a -> P a
inParens pa = withNewlines (between (sym "(") (char ')') pa) <* ws

inBraces :: P a -> P a
inBraces pa = withNewlines (between (sym "{") (char '}') pa) <* ws

pMarkup :: P Markup
pMarkup = pTrivia <|> pNonTriviaMarkup

pTrivia :: P Markup
pTrivia = pTriviaWithoutEol <|> pEol

pTriviaWithoutEol :: P Markup
pTriviaWithoutEol = pSpace <|> pComment

pNonTriviaMarkup :: P Markup
pNonTriviaMarkup = do
  mp <- pHeading
    <|> pHardbreak
    <|> pStrong
    <|> pEmph
    <|> pEquation
    <|> pListItem
    <|> pUrl
    <|> pText
    <|> pRawBlock
    <|> pRawInline
    <|> pEscaped
    <|> pNbsp
    <|> pDash
    <|> pEllipsis
    <|> pQuote
    <|> pLabelInContent
    <|> pRef
    <|> pHash
    <|> pSymbol
  updateState $ \st -> st {stAtStart = False}
  pure mp

pSymbol :: P Markup
pSymbol = do
  bracketNesting <- stBracketNesting <$> getState
  let isSpecial' c = isSpecial c && (c /= ']' || bracketNesting > 0)
  c <- satisfy isSpecial'
  case c of
    '[' -> updateState $ \st -> st { stBracketNesting = bracketNesting + 1}
    ']' -> updateState $ \st -> st { stBracketNesting = bracketNesting - 1}
    _ -> pure ()
  pure $ Text $ T.singleton $ c

-- equation ::= ('$' math* '$') | ('$ ' math* ' $')
pEquation :: P Markup
pEquation = do
  void $ char '$'
  withNewlines $ do
    display <- option False $ True <$ lookAhead space
    ws
    maths <- many pMath
    void $ char '$'
    pure $ Equation display maths

mathOperatorTable :: [[Operator Text PState Identity Markup]]
mathOperatorTable =
  [ -- precedence 7 -- attachment with number, e.g. a_1 (#17), or (..) group
    [ Infix (attachBottom <$ (try (op "_" *> lookAhead (mNumber <|> mGroup))))
        AssocLeft,
      Infix (attachTop <$ (try (op "^" *> lookAhead (mNumber <|> mGroup))))
        AssocLeft
    ],
    -- precedence 6
    [ Postfix
        ( try $ do
            getState >>= guard . isNothing . stSpaceBefore
            -- NOTE: can't have space before () or [] arg in a
            -- function call! to prevent bugs with e.g. 'if 2<3 [...]'.
            pos <- 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 (pos', MGroup _ (Just t) _)
                        | pos == pos' -> T.all isLetter t
                      Just (pos', Text t)
                        | pos == pos'
                        -> case T.unsnoc t of
                                  Nothing -> True
                                  Just (_,c) -> isLetter c
                      _ -> True
            args <- mGrouped '(' ')' True
            pure $ \expr -> MGroup Nothing Nothing [expr, args]
        )
    ],
    -- precedence 5  -- factorial needs to take precedence over fraction
    [ Postfix (try $ do
                  mbBeforeSpace <- stSpaceBefore <$> getState
                  guard $ isNothing mbBeforeSpace
                  lexeme $ char '!' *> notFollowedBy (char '=')
                  pure (\expr -> MGroup Nothing Nothing [expr, Text "!"]))
    ],
    -- precedence 4 -- attachment with non-number, e.g. a_x
    [ Infix (attachBottom <$ op "_") AssocLeft,
      Infix (attachTop <$ op "^") AssocLeft
    ],
    -- precedence 3
    [ Infix (makeFrac <$ op "/") AssocLeft
    ]
  ]


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

attachBottom :: Markup -> Markup -> Markup
attachBottom (MAttach Nothing y x) z = MAttach (Just (hideOuterParens z)) y x
attachBottom z (MAttach Nothing y x) = MAttach (Just (hideOuterParens x)) y z
attachBottom base x = MAttach (Just (hideOuterParens x)) Nothing base

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

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

hideOuterParens :: Markup -> Markup
hideOuterParens (MGroup (Just "(") (Just ")") x) = MGroup Nothing Nothing x
hideOuterParens x = x

mathExpressionTable :: [[Operator Text PState Identity Expr]]
mathExpressionTable = take 16 (cycle [[mathFieldAccess], [mathFunctionCall]])

mathFieldAccess :: Operator Text PState Identity Expr
mathFieldAccess =
  Postfix (FieldAccess <$> try (sym "." *> (Ident <$> pMathField)))
 where
  pMathField = lexeme $ do
    d <- satisfy (\c -> isIdentStart c && c /= '_')
    ds <- many $ satisfy (\c -> isIdentContinue c && c /= '_' && c /= '-')
    pure $ Identifier $ T.pack (d : ds)

mathFunctionCall :: Operator Text PState Identity Expr
mathFunctionCall =
  Postfix
    ( do
        mbBeforeSpace <- stSpaceBefore <$> 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 -> FuncCall expr args
    )

mExpr :: P Markup
mExpr = Code <$> getPosition <*> pMathExpr

pMathExpr :: P Expr
pMathExpr = buildExpressionParser mathExpressionTable
               (pMathIdent <|> pMathLiteral)
 where
   pMathLiteral :: P Expr
   pMathLiteral = Block . Content
                    <$> many1 (mLiteral <|> mEscaped <|> mShorthand)

pMathIdent :: P Expr
pMathIdent =
  (Ident <$> pMathIdentifier)
    <|> ( do
            void $ char '√'
            (Ident (Identifier "root") <$ lookAhead (char '('))
              <|> ( do
                      x <- pMath
                      pure $
                        FuncCall
                          (Ident (Identifier "root"))
                          [NormalArg (Block (Content [x]))]
                  )
        )

pMathIdentifier :: P Identifier
pMathIdentifier = lexeme $ try $ do
  d <- satisfy (\c -> isIdentStart c && c /= '_')
  ds <- many1 $ satisfy (\c -> isIdentContinue c && c /= '_' && c /= '-')
  pure $ Identifier $ T.pack (d : ds)

pMath :: P Markup
pMath = buildExpressionParser mathOperatorTable pBaseMath

pBaseMath :: P Markup
pBaseMath = do
  tok <-    mNumber
        <|> mLiteral
        <|> mEscaped
        <|> mShorthand
        <|> mBreak
        <|> mAlignPoint
        <|> mExpr
        <|> mGroup
        <|> mCode
        <|> mMid
        <|> mSymbol
  pos <- getPosition
  updateState $ \s -> s{ stLastMathTok = Just (pos, tok) }
  pure tok

mGroup :: P Markup
mGroup = mGrouped '(' ')' False
     <|> mGrouped '{' '}' False
     <|> mGrouped '[' ']' False

mGrouped :: Char -> Char -> Bool -> P Markup
mGrouped op' cl requireMatch = withNewlines $ try $ do
  void $ sym [op']
  res <- many (notFollowedBy (char cl) *> 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 = lexeme $ do
  ds <- T.pack <$> many1 digit
  opt <-
    option
      mempty
      ( do
          e <- char '.'
          es <- many digit
          pure $ T.pack (e : es)
      )
  pure $ Text (ds <> opt)

mLiteral :: P Markup
mLiteral = do
  mbBeforeSpace <- stSpaceBefore <$> 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 = Text . T.singleton <$> lexeme (try pEsc)

mBreak :: P Markup
mBreak = HardBreak <$ lexeme (char '\\' *> skipMany (satisfy (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 = MAlignPoint <$ sym "&"

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

mCode :: P Markup
mCode = lexeme $ char '#' *> (Code <$> getPosition <*> pBasicExpr)

mMid :: P Markup
mMid = try $ do
  getState >>= guard . isJust . stSpaceBefore
  void $ char '|' *> space *> ws
  pure $ MGroup Nothing Nothing [Nbsp, Text "|", Nbsp]

mShorthand :: P Markup
mShorthand =
  getPosition >>= \pos ->
   lexeme (Code pos <$> choice (map toShorthandParser shorthands))
 where
  shorthands = reverse (sortOn (T.length . fst) mathSymbolShorthands)
  toShorthandParser (short, symname) =
    toSym symname <$ try (string (T.unpack short))
  toSym name =
    case map (Ident . Identifier) $ T.split (== '.') name of
      [] -> Literal None
      [i] -> i
      (i:is) -> foldr FieldAccess i is

mSymbol :: P Markup
mSymbol =
  lexeme ( Text . T.singleton
            <$> satisfy (\c -> not (isSpace c) && c /= '$' && c /= '\\'))

-- Parser that discards leading trivia, and does not parse trailing trivia
-- unless followed by non-trivia markup. Stops when non-trivia markup would
-- match `stop` parser.
-- Does not allow new lines except in block comments.
pSinglelineWhileNot :: Show a => P a -> P [Markup]
pSinglelineWhileNot stop = do
  (concat . drop 1 . concat) <$> many pSinglelineChunk
  where
    pSinglelineChunk :: P [[Markup]]
    pSinglelineChunk = try $ do
      trivia <- many1 pTriviaWithoutEol
      markup <- many1 (notFollowedBy stop >> pNonTriviaMarkup)
      pure [trivia, markup]

-- list ::= '-' space markup
-- enum ::= (digit+ '.' | '+') space markup
-- desc ::= '/' space markup ':' space markup
pListItem :: P Markup
pListItem = do
  getState >>= guard . stAtStart
  col <- sourceColumn <$> getPosition
  try
    ( do
        char '-' *> guardAfterListOrHeadingMarker
        BulletListItem <$> pIndented col
    )
    <|> try
      ( do
          start <- (Nothing <$ char '+') <|> (Just <$> enumListStart)
          guardAfterListOrHeadingMarker
          EnumListItem start <$> pIndented col
      )
    <|> do
          -- desc list
          try $ char '/' *> guardAfterListOrHeadingMarker
          updateState $ \st -> st {stAtStart = False}
          term <- pSinglelineWhileNot (char ':')
          -- previous parser might have left trivia before `:`
          skipMany pTriviaWithoutEol <* char ':'
          updateState $ \st -> st {stAtStart = True}
          DescListItem term <$> pIndented col
  where
    -- Parser that discards leading trivia, and does not parse trailing trivia
    -- if not followed by properly indented non-trivia markup.
    pIndented :: Int -> P [Markup]
    pIndented indent = do
      (concat . drop 1 . concat) <$> many pIndentedChunk
      where
        pIndentedChunk :: P [[Markup]]
        pIndentedChunk = try $ do
          -- there might be no trivia following `:` in desc list
          trivia <- many pTrivia
          col <- sourceColumn <$> getPosition
          guard $ (col > indent) || not (any isEol trivia)
          markup <- many1 pNonTriviaMarkup
          pure [trivia, markup]
          where
            isEol SoftBreak = True
            isEol ParBreak = True
            isEol _ = False

guardAfterListOrHeadingMarker :: P ()
guardAfterListOrHeadingMarker = lookAhead $ 
  void (satisfy isSpace) <|> void (string "//") <|> void (string "/*") <|>  eof

enumListStart :: P Int
enumListStart = do
  ds <- many1 digit
  void $ char '.'
  case readMaybe ds of
    Nothing -> fail $ "could not read " <> ds <> " as digits"
    Just x -> pure x

-- line-comment = '//' (!unicode(Newline))*
-- block-comment = '/*' (block-comment | .)* ('*/' | eof)
pComment :: P Markup
pComment = (
              do
                pos <- getPosition
                void $ string "*/"
                setPosition pos
                fail "Unexpected end of block comment"
            ) <|> Comment <$ (pLineComment <|> pBlockComment)

pLineComment :: P ()
pLineComment = do
  void $ string "//"
  skipMany (satisfy (\c -> c /= '\n' && c /= '\r'))

pBlockComment :: P ()
pBlockComment = do
  void $ string "/*"
  void $
    manyTill
      ( pBlockComment
          <|> void anyChar
      )
      (void (string "*/") <|> eof)

pSpace :: P Markup
pSpace = Space <$ some (satisfy (\c -> isSpace c && c /= '\r' && c /= '\n'))

pEol :: P Markup
pEol = do
  pBaseEol
  updateState $ \st -> st {stAtStart = True}
  (ParBreak <$ many1 pBaseEol)
    <|> (ParBreak <$ pEndOfContent)
    <|> pure SoftBreak

pBaseEol :: P ()
pBaseEol = try $ do
  void endOfLine
  skipMany spaceChar

spaceChar :: P Char
spaceChar = satisfy (\c -> c == ' ' || c == '\t')

pHardbreak :: P Markup
pHardbreak =
  HardBreak <$ try (char '\\' *> (void spaceChar <|> pBaseEol) *> skipMany spaceChar)

pRawInline :: P Markup
pRawInline =
  RawInline . T.pack
    <$> (char '`' *> manyTill anyChar (void (char '`') <|> eof))

pRawBlock :: P Markup
pRawBlock = do
  void $ string "```"
  numticks <- (+ 3) . length <$> many (char '`')
  lang <- T.pack <$> option "" pLangTag
  code <- manyTill anyChar (string (replicate numticks '`'))

  -- Dedent raw text; detailed description at
  -- 0.14.2: https://github.com/typst/typst/blob/b33de9de113c91c184214b299bd7a8eb3070c3ab/crates/typst-syntax/src/lexer.rs#L310-L338 
  
  -- Use parser to handle CRLF; built-in `lines` would also strip trailing \n
  let (most, lst) = either (\_ -> ([], "")) id $ runParser splitlines () "" code
  let nonblankSkipFirst = filter (not . all isSpace) $ drop 1 most
  -- The last line is always considered
  let dedent = minOrZero $ map (length . takeWhile isSpace) $ lst:nonblankSkipFirst
  
  let mostDedented = case most of
                        [] -> []
                        (x:xs) | all isSpace x -> map (drop dedent) xs
                        -- remove optional single space after the language tag/opening ```
                        ((' ':x):xs) -> x:(map (drop dedent) xs) 
                        (x:xs) -> x:(map (drop dedent) xs) 
  let dedented = if not (all isSpace lst)
                then mostDedented <> [stripOneSpaceIfEndsWithBacktick $ drop dedent lst]
                else mostDedented

  pure $ RawBlock lang (T.pack $ intercalate "\n" dedented)
  where
    -- This parser should always succeed
    splitlines :: Parsec String () ([String], String)
    splitlines = do
      most <- many (try $ manyTill anyChar endOfLine)
      lst <- manyTill anyChar eof
      pure (most, lst)
    minOrZero [] = 0
    minOrZero xs = minimum xs
    -- Allowed lang tag might change in future Typst versions, see
    -- https://github.com/typst/typst/pull/7337
    pLangTag = do
      c <- satisfy isIdentStart
      cs <- many $ satisfy isIdentContinue
      pure $ (c : cs)
    stripOneSpaceIfEndsWithBacktick s = case dropWhileEnd isSpace s of
        [] -> s
        xs | last xs == '`' -> dropOneSpaceAtEnd s
        _ -> s
      where
        dropOneSpaceAtEnd xs =
          case reverse xs of
            (' ' : rest) -> reverse rest
            _            -> xs

pStrong :: P Markup
pStrong = do
  void $ char '*'
  updateState $ \st -> st {stAtStart = False}
  Strong <$> manyTill pMarkup (char '*')

pEmph :: P Markup
pEmph = do
  void $ char '_'
  updateState $ \st -> st {stAtStart = False}
  Emph <$> manyTill pMarkup (char '_')

pHeading :: P Markup
pHeading = try $ do
  getState >>= guard . stAtStart
  lev <- length <$> many1 (char '=')
  guardAfterListOrHeadingMarker
  updateState $ \st -> st {stAtStart = False}
  Heading lev <$> pSinglelineWhileNot pLabel

pUrl :: P Markup
pUrl = try $ do
  prot <- T.pack <$> (string "http://" <|> string "https://")
  rest <- T.pack <$> pNonspaceWithBalancedBrackets 0 0 0
  pure $ Url $ prot <> rest

pNonspaceWithBalancedBrackets :: Int -> Int -> Int -> P [Char]
pNonspaceWithBalancedBrackets parens brackets braces =
  ((:) <$> char '(' <*> pNonspaceWithBalancedBrackets (parens + 1) brackets braces)
    <|> ((:) <$> (guard (parens > 0) *> char ')') <*> pNonspaceWithBalancedBrackets (parens - 1) brackets braces)
    <|> ((:) <$> char '[' <*> pNonspaceWithBalancedBrackets parens (brackets + 1) braces)
    <|> ((:) <$> (guard (brackets > 0) *> char ']') <*> pNonspaceWithBalancedBrackets parens (brackets - 1) braces)
    <|> ((:) <$> char '{' <*> pNonspaceWithBalancedBrackets parens brackets (braces + 1))
    <|> ((:) <$> (guard (braces > 0) *> char '}') *> pNonspaceWithBalancedBrackets parens brackets (braces - 1))
    <|> (:) <$> noneOf " \t\r\n()[]{}" <*> pNonspaceWithBalancedBrackets parens brackets braces
    <|> pure []

pText :: P Markup
pText = Text . mconcat <$> some
  ((do xs <- some alphaNum
       T.pack . (xs <>) <$>
             try (some (char '*' <|> char '_') <* lookAhead (satisfy nonCJKAlphaNum))
        <|> pure (T.pack xs))
 <|> (T.pack <$> some (satisfy (\c -> not (isSpace c || isSpecial c))))
  )

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

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

pEscaped :: P Markup
pEscaped = Text . T.singleton <$> pEsc

pEsc :: P Char
pEsc =
  char '\\' *> (uniEsc <|> satisfy (not . isSpace))

pStrEsc :: P Char
pStrEsc =
  try $
    char '\\'
      *> ( uniEsc
             <|> ('\\' <$ char '\\')
             <|> ('"' <$ char '"')
             <|> ('\n' <$ char 'n')
             <|> ('\t' <$ char 't')
             <|> ('\r' <$ char 'r')
         )

uniEsc :: P Char
uniEsc = chr <$> (char 'u' *> char '{' *> hexnum <* char '}')
  where
    hexnum :: P Int
    hexnum = do
      ds <- many1 hexDigit
      case readMaybe ("0x" ++ ds) of
        Just i
          | i <= 1114112 -> pure i
          | otherwise -> pure 0xFFFD
        Nothing -> fail $ "Could not read hex number " ++ ds

pNbsp :: P Markup
pNbsp = Nbsp <$ char '~'

pDash :: P Markup
pDash = do
  void $ char '-'
  (Shy <$ char '?')
    <|> (char '-' *> ((EmDash <$ char '-') <|> pure EnDash))
    <|> pure (Text "-")

pEllipsis :: P Markup
pEllipsis = do
  void $ char '.'
  (Ellipsis <$ string "..") <|> pure (Text ".")

pQuote :: P Markup
pQuote = Quote <$> (char '\'' <|> char '"')

pLabelInContent :: P Markup
pLabelInContent = Code <$> getPosition <*> pLabel

pLabel :: P Expr
pLabel =
  Label . T.pack
    <$> lexeme (try
      ( char '<'
          *> many1 (satisfy isIdentContinue <|>
                    char '_' <|> char '.' <|> char ':')
          <* char '>'
      ))

pRef :: P Markup
pRef =
  Ref
    <$> (char '@' *> (T.pack <$> many1 (satisfy isIdentContinue <|> char '_')))
    <*> option (Literal Auto) (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 = do
  void $ char '#'
  res <- Code <$> getPosition <*> pBasicExpr <* optional (sym ";")
  -- rewind if we gobbled space:
  mbBeforeSpace <- stSpaceBefore <$> getState
  case mbBeforeSpace of
    Nothing -> pure ()
    Just (pos, inp) -> do
      setPosition pos
      setInput inp
  pure res

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

pIdentifierOrUnderscore :: P Identifier
pIdentifierOrUnderscore = lexeme $ try $ do
  c <- satisfy isIdentStart
  cs <- many $ satisfy isIdentContinue
  pure $ Identifier $ T.pack (c : cs)

pIdentifier :: P Identifier
pIdentifier = do 
  ident <- pIdentifierOrUnderscore
  if ident == "_"
    then fail "expected identifier, found underscore"
    else pure $ ident

-- 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 c = c == '_' ||
  case generalCategory c of
    UppercaseLetter -> True
    LowercaseLetter -> True
    TitlecaseLetter -> True
    ModifierLetter -> True
    OtherLetter -> True
    LetterNumber -> True
    _ -> 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 c =
  isIdentStart c
    || c == '-'
    || c == '_'
    || case generalCategory c of
      NonSpacingMark -> True
      SpacingCombiningMark -> True
      DecimalNumber -> True
      ConnectorPunctuation -> True
      _ -> False

pKeyword :: String -> P ()
pKeyword t = lexeme $ try $ string t *> notFollowedBy (satisfy 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 = buildExpressionParser operatorTable (buildExpressionParser basicOperatorTable (pBaseExpr pIdentOrUnderscore))
--

-- A basic expression excludes the unary and binary operators outside of parens,
-- but includes field access and function application. A single underscore is
-- not a valid identifier in a basic expression and should be interpreted as markup.
-- Needed for pHash.
pBasicExpr :: P Expr
pBasicExpr = buildExpressionParser basicOperatorTable (pBaseExpr pIdent)

pQualifiedIdentifier :: P Expr
pQualifiedIdentifier =
  buildExpressionParser (replicate 4 [fieldAccess]) pIdent

pBaseExpr :: P Expr -> P Expr
pBaseExpr ident_parser =
  pLiteral
    <|> pKeywordExpr
    <|> pFuncExpr
    <|> ident_parser
    <|> pArrayExpr
    <|> pDictExpr
    <|> try (inParens pExpr)
    <|> (Binding <$> pDestructuringBind True)
    <|> pLabel
    <|> (Block . Content . (: [])
         <$> lexeme (pRawBlock <|> pRawInline <|> pEquation))
    <|> pBlock

pLiteral :: P Expr
pLiteral =
  Literal <$> ( pNone <|> pAuto <|> pBoolean <|> pNumeric <|> pStr )

fieldAccess :: Operator Text PState Identity Expr
fieldAccess = Postfix (FieldAccess <$> try (sym "." *> pIdent))

-- don't allow space after .
restrictedFieldAccess :: Operator Text PState Identity Expr
restrictedFieldAccess = Postfix (FieldAccess <$> try (char '.' *> pIdent))

functionCall :: Operator Text PState Identity Expr
functionCall =
  Postfix
    ( do
        mbBeforeSpace <- stSpaceBefore <$> 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 -> FuncCall expr 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 =
  take 16 (cycle [[restrictedFieldAccess], [functionCall]])

operatorTable :: [[Operator Text PState Identity Expr]]
operatorTable =
  -- precedence 8 (real field access, perhaps  with space after .)
  take 12 (cycle [[fieldAccess], [functionCall]])
    ++
    -- precedence 7 (repeated because of parsec's quirks with postfix, prefix)
    replicate 6 [Prefix (Negated <$ op "-"), Prefix (id <$ op "+")]
    ++ [
         -- precedence 6
         [ Infix (Times <$ op "*") AssocLeft,
           Infix (Divided <$ op "/") AssocLeft
         ],
         -- precedence 5
         [ Infix (Plus <$ op "+") AssocLeft,
           Infix (Minus <$ op "-") AssocLeft
         ],
         -- precedence 4
         [ Infix (Equals <$ op "==") AssocLeft,
           Infix ((\x y -> Not (Equals x y)) <$ op "!=") AssocLeft,
           Infix (LessThan <$ op "<") AssocLeft,
           Infix (LessThanOrEqual <$ op "<=") AssocLeft,
           Infix (GreaterThan <$ op ">") AssocLeft,
           Infix (GreaterThanOrEqual <$ op ">=") AssocLeft,
           Infix (InCollection <$ pKeyword "in") AssocLeft,
           Infix
             ( (\x y -> Not (InCollection x y))
                 <$ try (pKeyword "not" *> pKeyword "in")
             )
             AssocLeft
         ],
         -- precedence 3
         [ Prefix (Not <$ pKeyword "not"),
           Infix (And <$ pKeyword "and") AssocLeft
         ],
         -- precedence 2
         [ Infix (Or <$ pKeyword "or") AssocLeft
         ],
         -- precedence 1
         [ Infix (Assign <$ op "=") AssocRight,
           Infix ((\x y -> Assign x (Plus x y)) <$ op "+=") AssocRight,
           Infix ((\x y -> Assign x (Minus x y)) <$ op "-=") AssocRight,
           Infix ((\x y -> Assign x (Times x y)) <$ op "*=") AssocRight,
           Infix ((\x y -> Assign x (Divided x y)) <$ op "/=") AssocRight
         ]
       ]

pNone :: P Literal
pNone = None <$ pKeyword "none"

pAuto :: P Literal
pAuto = Auto <$ pKeyword "auto"

pBoolean :: P Literal
pBoolean =
  (Boolean True <$ pKeyword "true") <|> (Boolean False <$ pKeyword "false")

pNumber :: P (Either Integer Double)
pNumber = try $ do
  pref <- string "0b" <|> string "0x" <|> string "0o" <|> pure ""
  case pref of
    "0b" -> do
      nums <- many1 ((1 <$ char '1') <|> (0 <$ char '0'))
      pure $ Left $ sum $ zipWith (*) (reverse nums) (map (2 ^) [(0 :: Integer) ..])
    "0x" -> do
      num <- many1 hexDigit
      case readMaybe ("0x" ++ num) of
        Just (i :: Integer) -> pure $ Left i
        _ -> fail $ "could not read " <> num <> " as hex digits"
    "0o" -> do
      num <- many1 octDigit
      case readMaybe ("0o" ++ num) of
        Just (i :: Integer) -> pure $ Left i
        _ -> fail $ "could not read " <> num <> " as octal digits"
    _ -> do
      as <- many1 digit <|> ("0" <$ lookAhead (try (char '.' *> digit)))
      pe <- 
        option 
          [] 
          (try ( do
              void $ char '.'
              notFollowedBy (char '.' <|> satisfy isIdentStart)
              pure "."
          ))
      bs <- many digit
      es <-
        option
          ""
          ( do
              void $ try $ oneOf "eE" *> lookAhead (digit <|> oneOf "+-")
              sign <- option [] $ count 1 (oneOf "+-")
              ds <- many1 digit
              pure ("e" ++ sign ++ ds)
          )
      let num = pref ++ as ++ pe ++ bs ++ es
      case readMaybe num of
        Just (i :: Integer) -> pure $ Left i
        Nothing ->
          case readMaybe $ addTrailingZero num of
            Just (d :: Double) -> pure $ Right d
            Nothing -> fail $ "could not read " <> num <> " as integer"

addTrailingZero :: String -> String
addTrailingZero []  = [] 
addTrailingZero num@(_:_) = if last num == '.' then num ++ "0" else num

pNumeric :: P Literal
pNumeric = lexeme $ do
  result <- pNumber
  ( do
      unit <- pUnit
      case result of
        Left i -> pure $ Numeric (fromIntegral i) unit
        Right d -> pure $ Numeric d unit
    )
    <|> case result of
      Left i -> pure $ Int i
      Right d -> pure $ Float d

pStr :: P Literal
pStr = lexeme $ do
  void $ char '"'
  String . T.pack <$> manyTill (pStrEsc <|> satisfy (/= '"')) (char '"')

pUnit :: P Unit
pUnit =
  (Percent <$ sym "%")
    <|> (Pt <$ sym "pt")
    <|> (Mm <$ sym "mm")
    <|> (Cm <$ sym "cm")
    <|> (In <$ sym "in")
    <|> (Deg <$ sym "deg")
    <|> (Rad <$ sym "rad")
    <|> (Em <$ sym "em")
    <|> (Fr <$ sym "fr")

pIdent :: P Expr
pIdent = Ident <$> pIdentifier

pIdentOrUnderscore :: P Expr
pIdentOrUnderscore = do
  ident <- pIdentifierOrUnderscore
  if ident == "_"
    then pure $ Underscore
    else pure $ Ident ident

pBlock :: P Expr
pBlock = Block <$> (pCodeBlock <|> pContent)

pCodeBlock :: P Block
pCodeBlock = CodeBlock <$> inBraces pCode

pCode :: P [Expr]
pCode = sepEndBy pExpr (void (sym ";") <|> ws)

-- content-block ::= '[' markup ']'
pContent :: P Block
pContent = do
  pos <- getPosition
  void $ char '['
  oldBracketNesting <- stBracketNesting <$> getState
  updateState $ \st ->
    st
      { stAtStart = True,
        stContentBlockNesting =
          stContentBlockNesting st + 1,
        stBracketNesting = 0
      }
  ms <- many pMarkup
  void $ (char ']' <?> "unclosed delimiter at" <> show pos)
  ws
  updateState $ \st ->
    st
      { stAtStart = False,
        stContentBlockNesting =
          stContentBlockNesting st - 1,
        stBracketNesting = oldBracketNesting
      }
  pure $ Content ms

pEndOfContent :: P ()
pEndOfContent =
  eof <|> do
    blockNesting <- stContentBlockNesting <$> getState
    if blockNesting > 0
      then void (lookAhead (char ']'))
      else mzero

-- array-expr ::= '(' (('..' expr) | (expr ',') | (expr (',' expr)+ ','?))? ')'
pArrayExpr :: P Expr
pArrayExpr =
  try $
    inParens $
      ( do
          v <- pSpread <|> (Reg <$> pExpr)
          vs <- many $ try $ sym "," *> (pSpread <|> (Reg <$> pExpr))
          case (v, vs) of
            ((Reg _), []) -> void $ sym ","
            _ -> optional $ void $ sym ","
          pure $ Array (v : vs)
      )
        <|> (Array [] <$ optional (void $ sym ","))

-- dict-expr ::= '(' (':' | ':'? (pair (',' pair)* ','?)) ')'
-- pair ::= (ident | str) ':' expr
pDictExpr :: P Expr
pDictExpr = try $ inParens (sym ":" *> (pNonemptyDict <|> pure (Dict mempty)) <|> pNonemptyDict)
  where
    pNonemptyDict = Dict <$> sepEndBy1 (pSpread <|> pPair) (sym ",")
    pPair = Reg <$> ((,) <$> pExpr <*> try (sym ":" *> pExpr))

pSpread :: P (Spreadable a)
pSpread = try $ string ".." *> (Spr <$> pExpr)

-- func-expr ::= (params | ident) '=>' expr
pFuncExpr :: P Expr
pFuncExpr = try $ FuncExpr <$> pParamsOrIdent <*> (sym "=>" *> pExpr)
  where
    pParamsOrIdent =
      pParams
        <|> (do i <- pIdentifierOrUnderscore
                if i == "_"
                   then pure [SkipParam]
                   else pure [NormalParam i])

pKeywordExpr :: P Expr
pKeywordExpr =
  pLetExpr
    <|> pSetExpr
    <|> pShowExpr
    <|> pIfExpr
    <|> pWhileExpr
    <|> pForExpr
    <|> pImportExpr
    <|> pIncludeExpr
    <|> pBreakExpr
    <|> pContinueExpr
    <|> pReturnExpr
    <|> pContextExpr

-- args ::= ('(' (arg (',' arg)* ','?)? ')' content-block*) | content-block+
pArgs :: P [Arg]
pArgs = do
  void $ lookAhead (char '(' <|> char '[')
  args <- option [] $ inParens $ sepEndBy pArg (sym ",")
  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 = pKeyValArg <|> pSpreadArg <|> pNormalArg
  where
    pKeyValArg = KeyValArg <$> try (pIdentifier <* sym ":") <*> pExpr
    pNormalArg = NormalArg <$> pExpr
    pSpreadArg = SpreadArg <$> try (string ".." *> pExpr)

-- params ::= '(' (param (',' param)* ','?)? ')'
pParams :: P [Param]
pParams = inParens $ sepEndBy pParam (sym ",")

-- param ::= ident (':' expr)?
pParam :: P Param
pParam =
  pSinkParam <|> pDestructuringParam <|> pNormalOrDefaultParam <|> pSkipParam
  where
    pSinkParam =
      SinkParam
        <$> try
          ( sym ".."
              *> option Nothing (Just <$> pIdentifier)
          )
    pSkipParam = SkipParam <$ sym "_"
    pNormalOrDefaultParam = do
      i <- try pIdentifier
      (DefaultParam i <$> (sym ":" *> pExpr)) <|> pure (NormalParam i)
    pDestructuringParam = do
      DestructuringBind parts <- pDestructuringBind False
      pure $ DestructuringParam parts

pBind :: Bool -> P Bind
pBind False = pBasicBind <|> pDestructuringBind False
-- arbitrary expressions are allowed in assignment binds but DestructuringBind is preferred
pBind True = pDestructuringBind True <|> pExprBind
  where
    pExprBind = do
      expr <- pExpr
      pure $ case expr of
        Underscore -> BasicBind Nothing
        Ident ident -> BasicBind $ Just ident
        _ -> ExprBind expr

pBasicBind :: P Bind
pBasicBind = BasicBind <$> try (pBindIdentifier <|> inParens pBindIdentifier)

pBindIdentifier :: P (Maybe Identifier)
pBindIdentifier = do
  ident <- pIdentifierOrUnderscore
  if ident == "_"
     then pure Nothing
     else pure $ Just ident

pDestructuringBind :: Bool -> P Bind
pDestructuringBind allowExpr =
  inParens $
    DestructuringBind <$> ((pSink <|> pWithKey <|> pSimple) `sepEndBy` (sym ","))
  where
    pSink = do
      void $ string ".."
      if allowExpr
        then do
          mbexpr <- option Nothing $ Just <$> pExpr
          pure $ case mbexpr of
            Nothing -> Sink Nothing
            Just Underscore -> Sink Nothing
            Just (Ident ident) -> Sink $ Just ident
            Just (expr) -> ExprSink expr
        else Sink <$> option Nothing pBindIdentifier
    pWithKey = do
      key <- try $ pBindIdentifier <* sym ":"
      case key of
        Nothing -> fail "expected identifier, found underscore"
        Just ident -> WithKey ident <$> pBind allowExpr
    pSimple = Simple <$> pBind allowExpr

-- let-expr ::= 'let' ident params? '=' expr
pLetExpr :: P Expr
pLetExpr = do
  pKeyword "let"
  bind <- pBind False
  case bind of
    BasicBind mbname -> do
      mbparams <- option Nothing $ Just <$> pParams
      mbexpr <- option Nothing $ Just <$> (sym "=" *> pExpr)
      case (mbparams, mbexpr, mbname) of
        (Nothing, Nothing, _) -> pure $ Let bind (Literal None)
        (Nothing, Just expr, _) -> pure $ Let bind expr
        (Just params, Just expr, Just name) -> pure $ LetFunc name params expr
        (Just _, Just _, Nothing) -> fail "expected name for function"
        (Just _, Nothing, _) -> fail "expected expression for let binding"
    _ -> Let bind <$> (sym "=" *> pExpr)

-- set-expr ::= 'set' expr args
pSetExpr :: P Expr
pSetExpr = do
  oldAllowNewlines <- stAllowNewlines <$> getState
  -- see #23 -- 'set' doesn't go with 'if' unless it's on the same line
  updateState $ \st -> st {stAllowNewlines = 0}
  set <- pKeyword "set" *> (Set <$> pQualifiedIdentifier <*> pArgs)
  updateState $ \st -> st {stAllowNewlines = oldAllowNewlines}
  addCondition <- option id $ pKeyword "if" *> ((\c x -> If [(c, x)]) <$> pExpr)
  pure $ addCondition set

pShowExpr :: P Expr
pShowExpr = do
  pKeyword "show"
  from <- (Nothing <$ sym ":") <|> Just <$> (pBasicExpr <* sym ":")
  to <- pBasicExpr
  pure $ Show from to

-- if-expr ::= 'if' expr block ('else' 'if' expr block)* ('else' block)?
pIfExpr :: P Expr
pIfExpr = do
  a <- 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 = pKeyword "if" *> ((,) <$> pExpr <*> pBlock)

-- while-expr ::= 'while' expr block
pWhileExpr :: P Expr
pWhileExpr = pKeyword "while" *> (While <$> pExpr <*> pBlock)

-- for-expr ::= 'for' bind 'in' expr block
pForExpr :: P Expr
pForExpr =
  pKeyword "for" *> (For <$> pBind False <*> (pKeyword "in" *> pExpr) <*> pBlock)

pImportExpr :: P Expr
pImportExpr = pKeyword "import" *> (Import <$> pExpr <*> pImportItems)
  where
    pImportItems =
        (sym ":"
          *> ( (AllIdentifiers <$ sym "*")
                 <|> inParens pIdentifierList
                 <|> pIdentifierList
             )
        ) <|> (NoIdentifiers <$> pAs)
    pIdentifierList = SomeIdentifiers <$> sepEndBy pIdentifierAs (sym ",")
    pIdentifierAs = do
      ident <- pIdentifier
      mbAs <- pAs
      pure (ident, mbAs)
    pAs = option Nothing $ Just <$> (pKeyword "as" *> pIdentifier)

pBreakExpr :: P Expr
pBreakExpr = Break <$ pKeyword "break"

pContinueExpr :: P Expr
pContinueExpr = Continue <$ pKeyword "continue"

pReturnExpr :: P Expr
pReturnExpr = do
  pos <- getPosition
  pKeyword "return"
  pos' <- getPosition
  if sourceLine pos' > sourceLine pos
    then pure $ Return Nothing
    else Return <$> (option Nothing (Just <$> pExpr))

pContextExpr :: P Expr
pContextExpr = Context <$> (pKeyword "context" *> pExpr)

pIncludeExpr :: P Expr
pIncludeExpr = Include <$> (pKeyword "include" *> pExpr)
