{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Token lexing and comment preservation for the Swarm language.
module Swarm.Language.Parser.Lex (
  -- * Parsing with source locations
  parseLoc,
  parseLocG,

  -- * Whitespace + comments
  getCommentSituation,
  lineComment,
  blockComment,
  sc,

  -- * Tokens

  -- ** Lexemes
  lexeme,

  -- ** Specific token types
  symbol,
  operator,
  reservedWords,
  reservedCS,
  reserved,
  IdentifierType (..),
  locIdentifier,
  locTmVar,
  locTyName,
  identifier,
  tyVar,
  tyName,
  tmVar,
  textLiteral,
  integer,

  -- ** Combinators
  braces,
  parens,
  brackets,
) where

import Control.Lens (use, (%=), (.=))
import Control.Monad (void)
import Data.Char (isLower, isUpper)
import Data.Containers.ListUtils (nubOrd)
import Data.List.Extra (enumerate)
import Data.Sequence qualified as Seq
import Data.Set (Set)
import Data.Set qualified as S
import Data.Text (Text)
import Data.Text qualified as T
import Swarm.Language.Parser.Core
import Swarm.Language.Syntax
import Swarm.Language.Syntax.Direction
import Swarm.Language.TDVar (TDVar, mkTDVar)
import Swarm.Language.Types (baseTyName)
import Swarm.Util (failT, squote)
import Text.Megaparsec
import Text.Megaparsec.Char
import Text.Megaparsec.Char.Lexer qualified as L
import Witch (from, into)

------------------------------------------------------------
-- Parsing with source locations

-- | Add 'SrcLoc' to a parser
parseLocG :: Parser a -> Parser (SrcLoc, a)
parseLocG :: forall a. Parser a -> Parser (SrcLoc, a)
parseLocG Parser a
pa = do
  -- Remember the start location.
  Int
start <- ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
  a
a <- Parser a
pa
  -- Instead of using 'getOffset' to get the end location, which would
  -- include any whitespace consumed at the end of @pa@, get the
  -- @preWSLoc@ which was set by 'sc' at the /beginning/ of the
  -- consumed whitespace.
  Int
end <- Getting Int WSState Int
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Int
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Int WSState Int
Lens' WSState Int
preWSLoc
  (SrcLoc, a) -> Parser (SrcLoc, a)
forall a.
a -> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Int -> SrcLoc
SrcLoc Int
start Int
end, a
a)

-- | Add 'SrcLoc' to a 'Term' parser
parseLoc :: Parser Term -> Parser Syntax
parseLoc :: Parser Term -> Parser Syntax
parseLoc Parser Term
pterm = (SrcLoc -> Term -> Syntax) -> (SrcLoc, Term) -> Syntax
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry SrcLoc -> Term -> Syntax
Syntax ((SrcLoc, Term) -> Syntax)
-> ReaderT
     ParserConfig (StateT WSState (Parsec Void Text)) (SrcLoc, Term)
-> Parser Syntax
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Term
-> ReaderT
     ParserConfig (StateT WSState (Parsec Void Text)) (SrcLoc, Term)
forall a. Parser a -> Parser (SrcLoc, a)
parseLocG Parser Term
pterm

------------------------------------------------------------
-- Whitespace

-- Approach for preserving comments taken from https://www.reddit.com/r/haskell/comments/ni4gpm/comment/gz0ipmp/

-- | If we see a comment starting now, is it the first non-whitespace
--   thing on the current line so far, or were there other
--   non-whitespace tokens previously?
getCommentSituation :: Parser CommentSituation
getCommentSituation :: Parser CommentSituation
getCommentSituation = do
  Bool
fl <- Getting Bool WSState Bool
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Bool WSState Bool
Lens' WSState Bool
freshLine
  CommentSituation -> Parser CommentSituation
forall a.
a -> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (CommentSituation -> Parser CommentSituation)
-> CommentSituation -> Parser CommentSituation
forall a b. (a -> b) -> a -> b
$ if Bool
fl then CommentSituation
StandaloneComment else CommentSituation
SuffixComment

-- | Parse a line comment, while appending it out-of-band to the list of
--   comments saved in the custom state.
lineComment :: Text -> Parser ()
lineComment :: Text -> Parser ()
lineComment Text
start = do
  CommentSituation
cs <- Parser CommentSituation
getCommentSituation
  -- Note we must manually get the start and end offset rather than
  -- using parseLocG, since parseLocG explicitly does not include the
  -- source span of trailing whitespace.
  Int
s <- ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
  Text
t <- Tokens Text
-> ReaderT
     ParserConfig (StateT WSState (Parsec Void Text)) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Text
Tokens Text
start ReaderT
  ParserConfig (StateT WSState (Parsec Void Text)) (Tokens Text)
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe String
-> (Token Text -> Bool)
-> ReaderT
     ParserConfig (StateT WSState (Parsec Void Text)) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP (String -> Maybe String
forall a. a -> Maybe a
Just String
"character") (Token Text -> Token Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
Token Text
'\n')
  Int
e <- ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
  (Seq Comment -> Identity (Seq Comment))
-> WSState -> Identity WSState
Lens' WSState (Seq Comment)
comments ((Seq Comment -> Identity (Seq Comment))
 -> WSState -> Identity WSState)
-> (Seq Comment -> Seq Comment) -> Parser ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Seq Comment -> Comment -> Seq Comment
forall a. Seq a -> a -> Seq a
Seq.|> SrcLoc -> CommentType -> CommentSituation -> Text -> Comment
Comment (Int -> Int -> SrcLoc
SrcLoc Int
s Int
e) CommentType
LineComment CommentSituation
cs Text
t)

-- | Parse a block comment, while appending it out-of-band to the list of
--   comments saved in the custom state.
blockComment :: Text -> Text -> Parser ()
blockComment :: Text -> Text -> Parser ()
blockComment Text
start Text
end = do
  CommentSituation
cs <- Parser CommentSituation
getCommentSituation
  -- Note we must manually get the start and end offset rather than
  -- using parseLocG, since parseLocG explicitly does not include the
  -- source span of trailing whitespace.
  Int
s <- ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
  ReaderT
  ParserConfig (StateT WSState (Parsec Void Text)) (Tokens Text)
-> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT
   ParserConfig (StateT WSState (Parsec Void Text)) (Tokens Text)
 -> Parser ())
-> ReaderT
     ParserConfig (StateT WSState (Parsec Void Text)) (Tokens Text)
-> Parser ()
forall a b. (a -> b) -> a -> b
$ Tokens Text
-> ReaderT
     ParserConfig (StateT WSState (Parsec Void Text)) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Text
Tokens Text
start
  [Token Text]
t <- ReaderT
  ParserConfig (StateT WSState (Parsec Void Text)) (Token Text)
-> ReaderT
     ParserConfig (StateT WSState (Parsec Void Text)) (Tokens Text)
-> ReaderT
     ParserConfig (StateT WSState (Parsec Void Text)) [Token Text]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill ReaderT
  ParserConfig (StateT WSState (Parsec Void Text)) (Token Text)
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle (Tokens Text
-> ReaderT
     ParserConfig (StateT WSState (Parsec Void Text)) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Text
Tokens Text
end)
  Int
e <- ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
  (Seq Comment -> Identity (Seq Comment))
-> WSState -> Identity WSState
Lens' WSState (Seq Comment)
comments ((Seq Comment -> Identity (Seq Comment))
 -> WSState -> Identity WSState)
-> (Seq Comment -> Seq Comment) -> Parser ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Seq Comment -> Comment -> Seq Comment
forall a. Seq a -> a -> Seq a
Seq.|> SrcLoc -> CommentType -> CommentSituation -> Text -> Comment
Comment (Int -> Int -> SrcLoc
SrcLoc Int
s Int
e) CommentType
BlockComment CommentSituation
cs (forall target source. From source target => source -> target
into @Text [Token Text]
t))

-- | Skip spaces and comments.
sc :: Parser ()
sc :: Parser ()
sc = do
  -- Remember where we were before we started consuming whitespace.
  Int
l <- ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
  (Int -> Identity Int) -> WSState -> Identity WSState
Lens' WSState Int
preWSLoc ((Int -> Identity Int) -> WSState -> Identity WSState)
-> Int -> Parser ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int
l
  -- Typically we would use L.space here, but we have to inline its
  -- definition and use our own slight variant, since we need to treat
  -- end-of-line specially.
  Parser () -> Parser ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany (Parser () -> Parser ())
-> ([Parser ()] -> Parser ()) -> [Parser ()] -> Parser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Parser ()] -> Parser ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([Parser ()] -> Parser ())
-> ([Parser ()] -> [Parser ()]) -> [Parser ()] -> Parser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Parser () -> Parser ()) -> [Parser ()] -> [Parser ()]
forall a b. (a -> b) -> [a] -> [b]
map Parser () -> Parser ()
forall a.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden ([Parser ()] -> Parser ()) -> [Parser ()] -> Parser ()
forall a b. (a -> b) -> a -> b
$
    [ Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace1
    , ReaderT
  ParserConfig (StateT WSState (Parsec Void Text)) (Tokens Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol ReaderT
  ParserConfig (StateT WSState (Parsec Void Text)) (Tokens Text)
-> Parser () -> Parser ()
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ((Bool -> Identity Bool) -> WSState -> Identity WSState
Lens' WSState Bool
freshLine ((Bool -> Identity Bool) -> WSState -> Identity WSState)
-> Bool -> Parser ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True) -- If we see a newline, reset freshLine to True.
    , Text -> Parser ()
lineComment Text
"//"
    , Text -> Text -> Parser ()
blockComment Text
"/*" Text
"*/"
    ]

------------------------------------------------------------
-- Tokens

-- | In general, we follow the convention that every token parser
--   assumes no leading whitespace and consumes all trailing
--   whitespace.  Concretely, we achieve this by wrapping every token
--   parser using 'lexeme'.
--
--   Also sets freshLine to False every time we see a non-whitespace
--   token.
lexeme :: Parser a -> Parser a
lexeme :: forall a.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
lexeme Parser a
p = ((Bool -> Identity Bool) -> WSState -> Identity WSState
Lens' WSState Bool
freshLine ((Bool -> Identity Bool) -> WSState -> Identity WSState)
-> Bool -> Parser ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
False) Parser () -> Parser a -> Parser a
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser () -> Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme Parser ()
sc Parser a
p

-- | A lexeme consisting of a literal string.
symbol :: Text -> Parser Text
symbol :: Text
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
symbol Text
s = ((Bool -> Identity Bool) -> WSState -> Identity WSState
Lens' WSState Bool
freshLine ((Bool -> Identity Bool) -> WSState -> Identity WSState)
-> Bool -> Parser ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
False) Parser ()
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
-> Tokens Text
-> ReaderT
     ParserConfig (StateT WSState (Parsec Void Text)) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> Tokens s -> m (Tokens s)
L.symbol Parser ()
sc Text
Tokens Text
s

-- | A lexeme consisting of a specific string, not followed by any other
--   operator character.
operator :: Text -> Parser Text
operator :: Text
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
operator Text
n = (ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
forall a.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
lexeme (ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
 -> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text)
-> (ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
    -> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text)
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
forall a.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try) (Tokens Text
-> ReaderT
     ParserConfig (StateT WSState (Parsec Void Text)) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Text
Tokens Text
n ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
-> Parser ()
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
-> Parser ()
forall a.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
operatorChar)

-- | Recognize a single character which is one of the characters used
--   by a built-in operator.
operatorChar :: Parser Text
operatorChar :: ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
operatorChar = Char -> Text
T.singleton (Char -> Text)
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Char
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Token Text]
-> ReaderT
     ParserConfig (StateT WSState (Parsec Void Text)) (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf String
[Token Text]
opChars
 where
  isOp :: ConstInfo -> Bool
isOp = \case { ConstMFunc {} -> Bool
False; ConstMeta
_ -> Bool
True } (ConstMeta -> Bool)
-> (ConstInfo -> ConstMeta) -> ConstInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstInfo -> ConstMeta
constMeta
  opChars :: String
opChars = String -> String
forall a. Ord a => [a] -> [a]
nubOrd (String -> String)
-> ([ConstInfo] -> String) -> [ConstInfo] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConstInfo -> String) -> [ConstInfo] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Text -> String
forall source target. From source target => source -> target
from (Text -> String) -> (ConstInfo -> Text) -> ConstInfo -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstInfo -> Text
syntax) ([ConstInfo] -> String)
-> ([ConstInfo] -> [ConstInfo]) -> [ConstInfo] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConstInfo -> Bool) -> [ConstInfo] -> [ConstInfo]
forall a. (a -> Bool) -> [a] -> [a]
filter ConstInfo -> Bool
isOp ([ConstInfo] -> String) -> [ConstInfo] -> String
forall a b. (a -> b) -> a -> b
$ (Const -> ConstInfo) -> [Const] -> [ConstInfo]
forall a b. (a -> b) -> [a] -> [b]
map Const -> ConstInfo
constInfo [Const]
allConst

-- | Names of base types built into the language.
baseTypeNames :: [Text]
baseTypeNames :: [Text]
baseTypeNames = (BaseTy -> Text) -> [BaseTy] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map BaseTy -> Text
baseTyName [BaseTy]
forall a. (Enum a, Bounded a) => [a]
enumerate

-- | Names of types built into the language.
primitiveTypeNames :: [Text]
primitiveTypeNames :: [Text]
primitiveTypeNames = Text
"Cmd" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
baseTypeNames

-- | List of keywords built into the language.
keywords :: [Text]
keywords :: [Text]
keywords = Text -> [Text]
T.words Text
"let in def tydef end true false forall require stock requirements rec"

-- | List of reserved words that cannot be used as variable names.
reservedWords :: Set Text
reservedWords :: Set Text
reservedWords =
  [Text] -> Set Text
forall a. Ord a => [a] -> Set a
S.fromList ([Text] -> Set Text) -> [Text] -> Set Text
forall a b. (a -> b) -> a -> b
$
    (Const -> Text) -> [Const] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (ConstInfo -> Text
syntax (ConstInfo -> Text) -> (Const -> ConstInfo) -> Const -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Const -> ConstInfo
constInfo) ((Const -> Bool) -> [Const] -> [Const]
forall a. (a -> Bool) -> [a] -> [a]
filter Const -> Bool
isUserFunc [Const]
allConst)
      [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (Direction -> Text) -> [Direction] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Direction -> Text
directionSyntax [Direction]
allDirs
      [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
primitiveTypeNames
      [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
keywords

-- | Parse a reserved word, given a string recognizer (which can
--   /e.g./ be case sensitive or not), making sure it is not a prefix
--   of a longer variable name, and allowing the parser to backtrack
--   if it fails.
reservedGen :: (Text -> Parser a) -> Text -> Parser ()
reservedGen :: forall a. (Text -> Parser a) -> Text -> Parser ()
reservedGen Text -> Parser a
str Text
w = (Parser () -> Parser ()
forall a.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
lexeme (Parser () -> Parser ())
-> (Parser () -> Parser ()) -> Parser () -> Parser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser () -> Parser ()
forall a.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try) (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Text -> Parser a
str Text
w Parser a -> Parser () -> Parser ()
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Char
-> Parser ()
forall a.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Char
ReaderT
  ParserConfig (StateT WSState (Parsec Void Text)) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Char
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Char
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Char
forall a.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token Text
-> ReaderT
     ParserConfig (StateT WSState (Parsec Void Text)) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'_')

-- | Parse a case-sensitive reserved word.
reservedCS :: Text -> Parser ()
reservedCS :: Text -> Parser ()
reservedCS = (Text
 -> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text)
-> Text -> Parser ()
forall a. (Text -> Parser a) -> Text -> Parser ()
reservedGen Text
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
Tokens Text
-> ReaderT
     ParserConfig (StateT WSState (Parsec Void Text)) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string

-- | Parse a case-insensitive reserved word.
reserved :: Text -> Parser ()
reserved :: Text -> Parser ()
reserved = (Text
 -> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text)
-> Text -> Parser ()
forall a. (Text -> Parser a) -> Text -> Parser ()
reservedGen Text
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
Tokens Text
-> ReaderT
     ParserConfig (StateT WSState (Parsec Void Text)) (Tokens Text)
forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
string'

-- | What kind of identifier are we parsing?
data IdentifierType = IDTyVar | IDTyName | IDTmVar
  deriving (IdentifierType -> IdentifierType -> Bool
(IdentifierType -> IdentifierType -> Bool)
-> (IdentifierType -> IdentifierType -> Bool) -> Eq IdentifierType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IdentifierType -> IdentifierType -> Bool
== :: IdentifierType -> IdentifierType -> Bool
$c/= :: IdentifierType -> IdentifierType -> Bool
/= :: IdentifierType -> IdentifierType -> Bool
Eq, Eq IdentifierType
Eq IdentifierType =>
(IdentifierType -> IdentifierType -> Ordering)
-> (IdentifierType -> IdentifierType -> Bool)
-> (IdentifierType -> IdentifierType -> Bool)
-> (IdentifierType -> IdentifierType -> Bool)
-> (IdentifierType -> IdentifierType -> Bool)
-> (IdentifierType -> IdentifierType -> IdentifierType)
-> (IdentifierType -> IdentifierType -> IdentifierType)
-> Ord IdentifierType
IdentifierType -> IdentifierType -> Bool
IdentifierType -> IdentifierType -> Ordering
IdentifierType -> IdentifierType -> IdentifierType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: IdentifierType -> IdentifierType -> Ordering
compare :: IdentifierType -> IdentifierType -> Ordering
$c< :: IdentifierType -> IdentifierType -> Bool
< :: IdentifierType -> IdentifierType -> Bool
$c<= :: IdentifierType -> IdentifierType -> Bool
<= :: IdentifierType -> IdentifierType -> Bool
$c> :: IdentifierType -> IdentifierType -> Bool
> :: IdentifierType -> IdentifierType -> Bool
$c>= :: IdentifierType -> IdentifierType -> Bool
>= :: IdentifierType -> IdentifierType -> Bool
$cmax :: IdentifierType -> IdentifierType -> IdentifierType
max :: IdentifierType -> IdentifierType -> IdentifierType
$cmin :: IdentifierType -> IdentifierType -> IdentifierType
min :: IdentifierType -> IdentifierType -> IdentifierType
Ord, Int -> IdentifierType -> String -> String
[IdentifierType] -> String -> String
IdentifierType -> String
(Int -> IdentifierType -> String -> String)
-> (IdentifierType -> String)
-> ([IdentifierType] -> String -> String)
-> Show IdentifierType
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> IdentifierType -> String -> String
showsPrec :: Int -> IdentifierType -> String -> String
$cshow :: IdentifierType -> String
show :: IdentifierType -> String
$cshowList :: [IdentifierType] -> String -> String
showList :: [IdentifierType] -> String -> String
Show)

-- | Parse an identifier together with its source location info.
locIdentifier :: IdentifierType -> Parser LocVar
locIdentifier :: IdentifierType -> Parser LocVar
locIdentifier IdentifierType
idTy =
  (SrcLoc -> Text -> LocVar) -> (SrcLoc, Text) -> LocVar
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry SrcLoc -> Text -> LocVar
forall v. SrcLoc -> v -> Located v
LV ((SrcLoc, Text) -> LocVar)
-> ReaderT
     ParserConfig (StateT WSState (Parsec Void Text)) (SrcLoc, Text)
-> Parser LocVar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
-> ReaderT
     ParserConfig (StateT WSState (Parsec Void Text)) (SrcLoc, Text)
forall a. Parser a -> Parser (SrcLoc, a)
parseLocG ((ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
forall a.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
lexeme (ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
 -> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text)
-> (ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
    -> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text)
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
forall a.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try) (ReaderT ParserConfig (StateT WSState (Parsec Void Text)) String
p ReaderT ParserConfig (StateT WSState (Parsec Void Text)) String
-> (String
    -> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text)
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> (a
    -> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b)
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
forall {source} {m :: * -> *}.
(From source Text, MonadFail m) =>
source -> m Text
check) ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
-> String
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"variable name")
 where
  p :: ReaderT ParserConfig (StateT WSState (Parsec Void Text)) String
p = (:) (Char -> String -> String)
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Char
-> ReaderT
     ParserConfig (StateT WSState (Parsec Void Text)) (String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Char
ReaderT
  ParserConfig (StateT WSState (Parsec Void Text)) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
letterChar ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Char
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Char
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Char
forall a.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token Text
-> ReaderT
     ParserConfig (StateT WSState (Parsec Void Text)) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'_') ReaderT
  ParserConfig (StateT WSState (Parsec Void Text)) (String -> String)
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) String
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) String
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) (a -> b)
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Char
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Char
ReaderT
  ParserConfig (StateT WSState (Parsec Void Text)) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Char
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Char
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Char
forall a.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token Text
-> ReaderT
     ParserConfig (StateT WSState (Parsec Void Text)) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'_' ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Char
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Char
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Char
forall a.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token Text
-> ReaderT
     ParserConfig (StateT WSState (Parsec Void Text)) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\'')
  check :: source -> m Text
check (forall target source. From source target => source -> target
into @Text -> Text
t)
    | IdentifierType
IDTyVar <- IdentifierType
idTy
    , Text -> Text
T.toTitle Text
t Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Text
reservedWords =
        [Text] -> m Text
forall (m :: * -> *) a. MonadFail m => [Text] -> m a
failT [Text
"Reserved type name", Text -> Text
squote Text
t, Text
"cannot be used as a type variable name; perhaps you meant", Text -> Text
squote (Text -> Text
T.toTitle Text
t) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"?"]
    | IdentifierType
IDTyName <- IdentifierType
idTy
    , Text
t Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Text
reservedWords =
        [Text] -> m Text
forall (m :: * -> *) a. MonadFail m => [Text] -> m a
failT [Text
"Reserved type name", Text -> Text
squote Text
t, Text
"cannot be redefined."]
    | Text
t Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Text
reservedWords Bool -> Bool -> Bool
|| Text -> Text
T.toLower Text
t Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Text
reservedWords =
        [Text] -> m Text
forall (m :: * -> *) a. MonadFail m => [Text] -> m a
failT [Text
"Reserved word", Text -> Text
squote Text
t, Text
"cannot be used as a variable name"]
    | IdentifierType
IDTyName <- IdentifierType
idTy
    , Char -> Bool
isLower (HasCallStack => Text -> Char
Text -> Char
T.head Text
t) =
        [Text] -> m Text
forall (m :: * -> *) a. MonadFail m => [Text] -> m a
failT [Text
"Type synonym names must start with an uppercase letter"]
    | IdentifierType
IDTyVar <- IdentifierType
idTy
    , Char -> Bool
isUpper (HasCallStack => Text -> Char
Text -> Char
T.head Text
t) =
        [Text] -> m Text
forall (m :: * -> *) a. MonadFail m => [Text] -> m a
failT [Text
"Type variable names must start with a lowercase letter"]
    | Bool
otherwise = Text -> m Text
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
t

-- | Parse a term variable together with its source location info.
locTmVar :: Parser LocVar
locTmVar :: Parser LocVar
locTmVar = IdentifierType -> Parser LocVar
locIdentifier IdentifierType
IDTmVar

-- | Parse a user-defined type name together with its source location
--   info.
locTyName :: Parser (Located TDVar)
locTyName :: Parser (Located TDVar)
locTyName = ((LocVar -> Located TDVar)
-> Parser LocVar -> Parser (Located TDVar)
forall a b.
(a -> b)
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((LocVar -> Located TDVar)
 -> Parser LocVar -> Parser (Located TDVar))
-> ((Text -> TDVar) -> LocVar -> Located TDVar)
-> (Text -> TDVar)
-> Parser LocVar
-> Parser (Located TDVar)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> TDVar) -> LocVar -> Located TDVar
forall a b. (a -> b) -> Located a -> Located b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) Text -> TDVar
mkTDVar (IdentifierType -> Parser LocVar
locIdentifier IdentifierType
IDTyName)

-- | Parse an identifier, i.e. any non-reserved string containing
--   alphanumeric characters and underscores, not starting with a
--   digit. The Bool indicates whether we are parsing a type variable.
identifier :: IdentifierType -> Parser Var
identifier :: IdentifierType
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
identifier = (LocVar -> Text)
-> Parser LocVar
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
forall a b.
(a -> b)
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LocVar -> Text
forall v. Located v -> v
lvVar (Parser LocVar
 -> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text)
-> (IdentifierType -> Parser LocVar)
-> IdentifierType
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentifierType -> Parser LocVar
locIdentifier

-- | Parse a type variable, which must start with an underscore or
--   lowercase letter and cannot be the lowercase version of a type
--   name.
tyVar :: Parser Var
tyVar :: ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
tyVar = IdentifierType
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
identifier IdentifierType
IDTyVar

-- | Parse a (user-defined) type constructor name, which must start
--   with an uppercase letter.
--
--   Note that this always produces a variable with version number 0,
--   via 'mkTDVar'.  We cannot properly version variables at parsing
--   time since we don't know what else is in scope.  There is a
--   separate name resolution pass later that assigns correct version
--   numbers to user type names.
tyName :: Parser TDVar
tyName :: Parser TDVar
tyName = Text -> TDVar
mkTDVar (Text -> TDVar)
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
-> Parser TDVar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IdentifierType
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
identifier IdentifierType
IDTyName

-- | Parse a term variable, which can start in any case and just
--   cannot be the same (case-insensitively) as a lowercase reserved
--   word.
tmVar :: Parser Var
tmVar :: ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
tmVar = IdentifierType
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
identifier IdentifierType
IDTmVar

-- | Parse a text literal (including escape sequences) in double quotes.
textLiteral :: Parser Text
textLiteral :: ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
textLiteral = String -> Text
forall target source. From source target => source -> target
into (String -> Text)
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) String
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) String
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) String
forall a.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
lexeme (Token Text
-> ReaderT
     ParserConfig (StateT WSState (Parsec Void Text)) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'"' ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Char
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) String
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) String
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Char
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Char
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Char
L.charLiteral (Token Text
-> ReaderT
     ParserConfig (StateT WSState (Parsec Void Text)) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'"'))

-- | Parse a positive integer literal token, in decimal, binary,
--   octal, or hexadecimal notation.  Note that negation is handled as
--   a separate operator.
integer :: Parser Integer
integer :: Parser Integer
integer =
  String -> Parser Integer -> Parser Integer
forall a.
String
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"integer literal" (Parser Integer -> Parser Integer)
-> Parser Integer -> Parser Integer
forall a b. (a -> b) -> a -> b
$
    Parser Integer -> Parser Integer
forall a.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
lexeme (Parser Integer -> Parser Integer)
-> Parser Integer -> Parser Integer
forall a b. (a -> b) -> a -> b
$ do
      Integer
n <-
        Tokens Text
-> ReaderT
     ParserConfig (StateT WSState (Parsec Void Text)) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"0b"
          ReaderT
  ParserConfig (StateT WSState (Parsec Void Text)) (Tokens Text)
-> Parser Integer -> Parser Integer
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.binary
          Parser Integer -> Parser Integer -> Parser Integer
forall a.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text
-> ReaderT
     ParserConfig (StateT WSState (Parsec Void Text)) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"0o"
            ReaderT
  ParserConfig (StateT WSState (Parsec Void Text)) (Tokens Text)
-> Parser Integer -> Parser Integer
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.octal
          Parser Integer -> Parser Integer -> Parser Integer
forall a.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text
-> ReaderT
     ParserConfig (StateT WSState (Parsec Void Text)) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"0x"
            ReaderT
  ParserConfig (StateT WSState (Parsec Void Text)) (Tokens Text)
-> Parser Integer -> Parser Integer
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.hexadecimal
          Parser Integer -> Parser Integer -> Parser Integer
forall a.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.decimal
      ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Char
-> Parser ()
forall a.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Char
ReaderT
  ParserConfig (StateT WSState (Parsec Void Text)) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar
      Integer -> Parser Integer
forall a.
a -> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
n

------------------------------------------------------------
-- Combinators

braces :: Parser a -> Parser a
braces :: forall a.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
braces = ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Text
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
symbol Text
"{") (Text
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
symbol Text
"}")

parens :: Parser a -> Parser a
parens :: forall a.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
parens = ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Text
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
symbol Text
"(") (Text
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
symbol Text
")")

brackets :: Parser a -> Parser a
brackets :: forall a.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
brackets = ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Text
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
symbol Text
"[") (Text
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Text
symbol Text
"]")