{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Safe #-}
-- | The lexical layer of the Eidos concrete syntax (doc/eidos.md §9): the
--   token parsers, the reserved-word table, and the identifier predicate —
--   each defined once, so that "ReWire.Eidos.Parse" (which reads the
--   format) and "ReWire.Eidos.Pretty" (which backtick-quotes exactly the
--   occurrence texts that would not lex as identifiers) cannot disagree.
--   The grammar is newline-insensitive: 'space' skips @--@ line comments
--   along with whitespace, and a @#@ separates an identifier from its
--   unique, terminating keywords too (@case#1@ is a name token).
module ReWire.Eidos.Lexer
      ( Parser, failParse
      , space, lexeme, symbol, withSpan, getAnn, keyword
      , reservedWords, isIdentStart, isIdentChar, identStartChar, identChar, identRaw
      , uniqName, bareName, tupleName, conName, listConName, underscore
      , natural, integer, stringLit
      , comma, semi, arrow, dcolon, equals
      , parens, braces, brackets
      ) where

import ReWire.Annotation (Annote, srcAnnote)
import ReWire.Eidos.Syntax (Uniq)
import ReWire.Error (failAt, MonadError, AstError)

import Control.Monad (void, when)
import Data.Char (isAlpha, isAlphaNum)
import Data.Functor (($>))
import Data.Text (Text, pack)
import Data.Void (Void)
import Numeric.Natural (Natural)
import Text.Megaparsec (Parsec, ParseErrorBundle, many, try, (<|>), (<?>), manyTill, between, notFollowedBy, satisfy, anySingle, empty, getSourcePos, attachSourcePos, errorOffset, bundleErrors, bundlePosState, parseErrorTextPretty)
import Text.Megaparsec.Char (char, space1)
import Text.Megaparsec.Pos (SourcePos (..), unPos)

import qualified Data.HashSet               as Set
import qualified Data.List.NonEmpty         as NE
import qualified Data.Text                  as T
import qualified Text.Megaparsec.Char.Lexer as L

type Parser = Parsec Void Text

-- | A parse failure as a located 'AstError' (at the first error's
--   position).
failParse :: MonadError AstError m => ParseErrorBundle Text Void -> m a
failParse :: forall (m :: * -> *) a.
MonadError AstError m =>
ParseErrorBundle Text Void -> m a
failParse ParseErrorBundle Text Void
bundle = Annote -> Text -> m a
forall (m :: * -> *) an a.
(MonadError AstError m, Annotation an) =>
an -> Text -> m a
failAt (String -> (Uniq, Uniq) -> (Uniq, Uniq) -> Annote
srcAnnote (SourcePos -> String
sourceName SourcePos
pos) (SourcePos -> (Uniq, Uniq)
lc SourcePos
pos) (SourcePos -> (Uniq, Uniq)
lc SourcePos
pos)) (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ParseError Text Void -> String
forall s e.
(VisualStream s, ShowErrorComponent e) =>
ParseError s e -> String
parseErrorTextPretty ParseError Text Void
e)
      where (ParseError Text Void
e, SourcePos
pos) = NonEmpty (ParseError Text Void, SourcePos)
-> (ParseError Text Void, SourcePos)
forall a. NonEmpty a -> a
NE.head (NonEmpty (ParseError Text Void, SourcePos)
 -> (ParseError Text Void, SourcePos))
-> NonEmpty (ParseError Text Void, SourcePos)
-> (ParseError Text Void, SourcePos)
forall a b. (a -> b) -> a -> b
$ (NonEmpty (ParseError Text Void, SourcePos), PosState Text)
-> NonEmpty (ParseError Text Void, SourcePos)
forall a b. (a, b) -> a
fst ((NonEmpty (ParseError Text Void, SourcePos), PosState Text)
 -> NonEmpty (ParseError Text Void, SourcePos))
-> (NonEmpty (ParseError Text Void, SourcePos), PosState Text)
-> NonEmpty (ParseError Text Void, SourcePos)
forall a b. (a -> b) -> a -> b
$ (ParseError Text Void -> Uniq)
-> NonEmpty (ParseError Text Void)
-> PosState Text
-> (NonEmpty (ParseError Text Void, SourcePos), PosState Text)
forall (t :: * -> *) s a.
(Traversable t, TraversableStream s) =>
(a -> Uniq) -> t a -> PosState s -> (t (a, SourcePos), PosState s)
attachSourcePos ParseError Text Void -> Uniq
forall s e. ParseError s e -> Uniq
errorOffset (ParseErrorBundle Text Void -> NonEmpty (ParseError Text Void)
forall s e. ParseErrorBundle s e -> NonEmpty (ParseError s e)
bundleErrors ParseErrorBundle Text Void
bundle) (ParseErrorBundle Text Void -> PosState Text
forall s e. ParseErrorBundle s e -> PosState s
bundlePosState ParseErrorBundle Text Void
bundle)
            lc :: SourcePos -> (Uniq, Uniq)
lc SourcePos
sp = (Pos -> Uniq
unPos (Pos -> Uniq) -> Pos -> Uniq
forall a b. (a -> b) -> a -> b
$ SourcePos -> Pos
sourceLine SourcePos
sp, Pos -> Uniq
unPos (Pos -> Uniq) -> Pos -> Uniq
forall a b. (a -> b) -> a -> b
$ SourcePos -> Pos
sourceColumn SourcePos
sp)


space :: Parser ()
space :: Parser ()
space = Parser () -> Parser () -> Parser () -> Parser ()
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> m () -> m () -> m ()
L.space (Parser () -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space1) (Tokens Text -> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Tokens s -> m ()
L.skipLineComment Tokens Text
"--") Parser ()
forall a. ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a
empty

lexeme :: Parser a -> Parser a
lexeme :: forall a. Parser a -> Parser a
lexeme = Parser ()
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme Parser ()
space

symbol :: Text -> Parser Text
symbol :: Text -> Parser Text
symbol = Parser ()
-> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> Tokens s -> m (Tokens s)
L.symbol Parser ()
space

-- | Run a parser that builds a node from an annotation, supplying it the
--   source span the parser consumed so the node carries a real location.
withSpan :: Parser (Annote -> a) -> Parser a
withSpan :: forall a. Parser (Annote -> a) -> Parser a
withSpan Parser (Annote -> a)
p = do
      s <- ParsecT Void Text Identity SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
      f <- p
      e <- getSourcePos
      pure $ f $ srcAnnote (sourceName s) (lc s) (lc e)
      where lc :: SourcePos -> (Uniq, Uniq)
lc SourcePos
sp = (Pos -> Uniq
unPos (Pos -> Uniq) -> Pos -> Uniq
forall a b. (a -> b) -> a -> b
$ SourcePos -> Pos
sourceLine SourcePos
sp, Pos -> Uniq
unPos (Pos -> Uniq) -> Pos -> Uniq
forall a b. (a -> b) -> a -> b
$ SourcePos -> Pos
sourceColumn SourcePos
sp)

-- | A point annotation at the current position (for nodes built by folds,
--   where 'withSpan' does not fit).
getAnn :: Parser Annote
getAnn :: Parser Annote
getAnn = do
      s <- ParsecT Void Text Identity SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
      pure $ srcAnnote (sourceName s) (lc s) (lc s)
      where lc :: SourcePos -> (Uniq, Uniq)
lc SourcePos
sp = (Pos -> Uniq
unPos (Pos -> Uniq) -> Pos -> Uniq
forall a b. (a -> b) -> a -> b
$ SourcePos -> Pos
sourceLine SourcePos
sp, Pos -> Uniq
unPos (Pos -> Uniq) -> Pos -> Uniq
forall a b. (a -> b) -> a -> b
$ SourcePos -> Pos
sourceColumn SourcePos
sp)

-- | @#@ separates an identifier from its unique, so it terminates keywords
--   too: @case#1@ is a name token, not the keyword @case@.
keyword :: Text -> Parser ()
keyword :: Text -> Parser ()
keyword Text
k = Parser () -> Parser ()
forall a. Parser a -> Parser a
lexeme (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Parser () -> Parser ()
forall a. Parser a -> Parser 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 ()
string' Text
k Parser () -> Parser () -> Parser ()
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Char -> Parser ()
forall a. ParsecT Void Text Identity a -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (ParsecT Void Text Identity Char
identChar ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'#')
      where string' :: Text -> Parser ()
            string' :: Text -> Parser ()
string' = (Char -> ParsecT Void Text Identity Char) -> String -> Parser ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Char -> ParsecT Void Text Identity Char
Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char (String -> Parser ()) -> (Text -> String) -> Text -> Parser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

-- | The reserved words of the concrete syntax: every keyword of the
--   grammar, plus @_@ (the default alternative). One table for the parser
--   (a bare name may not be one of these) and the printer (which quotes an
--   occurrence that is one).
reservedWords :: Set.HashSet Text
reservedWords :: HashSet Text
reservedWords = [Text] -> HashSet Text
forall a. (Eq a, Hashable a) => [a] -> HashSet a
Set.fromList
      [ Text
"let", Text
"in", Text
"rec", Text
"join", Text
"jump", Text
"case", Text
"of", Text
"top", Text
"data"
      , Text
"forall", Text
"inline", Text
"noinline", Text
"from", Text
"baked", Text
"list", Text
"vec"
      , Text
"proc", Text
"entry", Text
"block", Text
"state", Text
"put", Text
"get", Text
"pause", Text
"goto", Text
"halt", Text
"undef"
      , Text
"Nat", Text
"_"
      ]

-- | The identifier lexeme: a start character, then identifier characters
--   (dotted, primed, and @$@-marked names included). The printer's quoting
--   predicate is the same pair of tests.
isIdentStart, isIdentChar :: Char -> Bool
isIdentStart :: Char -> Bool
isIdentStart Char
c = Char -> Bool
isAlpha 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
'$'
isIdentChar :: Char -> Bool
isIdentChar  Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
"_.$'" :: String)

identStartChar :: Parser Char
identStartChar :: ParsecT Void Text Identity Char
identStartChar = (Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isIdentStart

identChar :: Parser Char
identChar :: ParsecT Void Text Identity Char
identChar = (Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isIdentChar

-- | Raw (non-lexeme) dotted identifier text, or a backtick-quoted name
--   (arbitrary text; the printer quotes occurrences that do not lex as
--   identifiers, e.g. operator names).
identRaw :: Parser Text
identRaw :: Parser Text
identRaw = Parser Text
quoted Parser Text -> Parser Text -> Parser Text
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
plain
      where plain :: Parser Text
            plain :: Parser Text
plain = do
                  c  <- ParsecT Void Text Identity Char
identStartChar
                  cs <- many identChar
                  pure $ pack $ c : cs

            quoted :: Parser Text
            quoted :: Parser Text
quoted = do
                  _  <- Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'`'
                  cs <- many $ satisfy (/= '`')
                  _  <- char '`'
                  pure $ pack cs

-- | A unique-carrying name token, @occ#uniq@ (term variables, type
--   variables, labels). Reserved words are admitted as occurrence text:
--   the @#@ disambiguates them from keywords.
uniqName :: Parser (Text, Uniq)
uniqName :: Parser (Text, Uniq)
uniqName = Parser (Text, Uniq) -> Parser (Text, Uniq)
forall a. Parser a -> Parser a
lexeme (Parser (Text, Uniq) -> Parser (Text, Uniq)
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser (Text, Uniq) -> Parser (Text, Uniq))
-> Parser (Text, Uniq) -> Parser (Text, Uniq)
forall a b. (a -> b) -> a -> b
$ (,) (Text -> Uniq -> (Text, Uniq))
-> Parser Text -> ParsecT Void Text Identity (Uniq -> (Text, Uniq))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
identRaw ParsecT Void Text Identity (Uniq -> (Text, Uniq))
-> ParsecT Void Text Identity Uniq -> Parser (Text, Uniq)
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'#' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Uniq
-> ParsecT Void Text Identity Uniq
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
-> ParsecT Void Text Identity Uniq
-> ParsecT Void Text Identity Uniq
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
L.signed (() -> Parser ()
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) ParsecT Void Text Identity Uniq
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.decimal))
      Parser (Text, Uniq) -> String -> Parser (Text, Uniq)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"name#unique"

-- | A bare dotted name with no unique (type/data constructors, primitives,
--   provenance names).
bareName :: Parser Text
bareName :: Parser Text
bareName = Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme (Parser Text -> Parser Text
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser Text -> Parser Text) -> Parser Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ do
      x <- Parser Text
identRaw
      when (x `Set.member` reservedWords) $ fail "reserved word"
      -- A bare "_" is not a name: a constructor named "_" would print
      -- identically to the default case alternative. ("_#u" names are fine.)
      when (x == "_") $ fail "'_' is not a name"
      notFollowedBy $ char '#'
      pure x)
      Parser Text -> String -> Parser Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"name"

-- | The unit and tuple constructor names: @()@, @(,)@, @(,,)@, ...
--   (written tightly, as printed).
tupleName :: Parser Text
tupleName :: Parser Text
tupleName = Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme (Parser Text -> Parser Text
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser Text -> Parser Text) -> Parser Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ do
      _  <- Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'('
      cs <- many $ char ','
      _  <- char ')'
      pure $ pack $ "(" <> cs <> ")")
      Parser Text -> String -> Parser Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"tuple constructor"

-- | A constructor name position: bare, the @(,)@ family, or the list type
--   constructors (which appear as declared datatype names in dumps).
conName :: Parser Text
conName :: Parser Text
conName = Parser Text
bareName Parser Text -> Parser Text -> Parser Text
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
tupleName Parser Text -> Parser Text -> Parser Text
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
listConName

listConName :: Parser Text
listConName :: Parser Text
listConName = Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme (Parser Text -> Parser Text
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text
"[_]" Text -> Parser Text -> Parser Text
forall a b.
a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
symbol Text
"[_]") Parser Text -> Parser Text -> Parser Text
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text -> Parser Text
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text
"[]" Text -> Parser Text -> Parser Text
forall a b.
a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
symbol Text
"[]"))
      Parser Text -> String -> Parser Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"list constructor"

-- | The default-alternative wildcard (@_@ alone is also a valid identifier
--   start, so it needs the same guards as a keyword).
underscore :: Parser ()
underscore :: Parser ()
underscore = Parser () -> Parser ()
forall a. Parser a -> Parser a
lexeme (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Parser () -> Parser ()
forall a. Parser a -> Parser 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
$ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'_' ParsecT Void Text Identity Char -> Parser () -> Parser ()
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Char -> Parser ()
forall a. ParsecT Void Text Identity a -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (ParsecT Void Text Identity Char
identChar ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'#')

natural :: Parser Natural
natural :: Parser Natural
natural = Parser Natural -> Parser Natural
forall a. Parser a -> Parser a
lexeme Parser Natural
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.decimal

integer :: Parser Integer
integer :: Parser Integer
integer = Parser Integer -> Parser Integer
forall a. Parser a -> Parser a
lexeme (Parser Integer -> Parser Integer)
-> Parser Integer -> Parser Integer
forall a b. (a -> b) -> a -> b
$ Parser () -> Parser Integer -> Parser Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
L.signed (() -> Parser ()
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) Parser Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.decimal

-- | String literals, with exactly the escapes the printer emits:
--   @\\\\ \\\" \\n \\t \\r@.
stringLit :: Parser Text
stringLit :: Parser Text
stringLit = Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'"' ParsecT Void Text Identity Char -> Parser Text -> Parser Text
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (String -> Text
pack (String -> Text)
-> ParsecT Void Text Identity String -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill ParsecT Void Text Identity Char
strChar (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'"')))
      Parser Text -> String -> Parser Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"string literal"
      where strChar :: Parser Char
            strChar :: ParsecT Void Text Identity Char
strChar = (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\\' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Char
escChar) ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Char
ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle

            escChar :: Parser Char
            escChar :: ParsecT Void Text Identity Char
escChar = Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\\'
                  ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'"'
                  ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'n' ParsecT Void Text Identity Char
-> Char -> ParsecT Void Text Identity Char
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char
'\n')
                  ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
't' ParsecT Void Text Identity Char
-> Char -> ParsecT Void Text Identity Char
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char
'\t')
                  ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'r' ParsecT Void Text Identity Char
-> Char -> ParsecT Void Text Identity Char
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char
'\r')
                  ParsecT Void Text Identity Char
-> String -> ParsecT Void Text Identity Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"escape character (one of \\\\ \\\" \\n \\t \\r)"

comma, semi, arrow, dcolon, equals :: Parser ()
comma :: Parser ()
comma  = Parser Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Text -> Parser ()) -> Parser Text -> Parser ()
forall a b. (a -> b) -> a -> b
$ Text -> Parser Text
symbol Text
","
semi :: Parser ()
semi   = Parser Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Text -> Parser ()) -> Parser Text -> Parser ()
forall a b. (a -> b) -> a -> b
$ Text -> Parser Text
symbol Text
";"
arrow :: Parser ()
arrow  = Parser Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Text -> Parser ()) -> Parser Text -> Parser ()
forall a b. (a -> b) -> a -> b
$ Text -> Parser Text
symbol Text
"->"
dcolon :: Parser ()
dcolon = Parser Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Text -> Parser ()) -> Parser Text -> Parser ()
forall a b. (a -> b) -> a -> b
$ Text -> Parser Text
symbol Text
"::"
equals :: Parser ()
equals = Parser Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Text -> Parser ()) -> Parser Text -> Parser ()
forall a b. (a -> b) -> a -> b
$ Text -> Parser Text
symbol Text
"="

parens, braces, brackets :: Parser a -> Parser a
parens :: forall a. Parser a -> Parser a
parens   = Parser Text
-> Parser Text
-> ParsecT Void Text Identity a
-> ParsecT Void Text Identity a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Text -> Parser Text
symbol Text
"(") (Parser Text
 -> ParsecT Void Text Identity a -> ParsecT Void Text Identity a)
-> Parser Text
-> ParsecT Void Text Identity a
-> ParsecT Void Text Identity a
forall a b. (a -> b) -> a -> b
$ Text -> Parser Text
symbol Text
")"
braces :: forall a. Parser a -> Parser a
braces   = Parser Text
-> Parser Text
-> ParsecT Void Text Identity a
-> ParsecT Void Text Identity a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Text -> Parser Text
symbol Text
"{") (Parser Text
 -> ParsecT Void Text Identity a -> ParsecT Void Text Identity a)
-> Parser Text
-> ParsecT Void Text Identity a
-> ParsecT Void Text Identity a
forall a b. (a -> b) -> a -> b
$ Text -> Parser Text
symbol Text
"}"
brackets :: forall a. Parser a -> Parser a
brackets = Parser Text
-> Parser Text
-> ParsecT Void Text Identity a
-> ParsecT Void Text Identity a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Text -> Parser Text
symbol Text
"[") (Parser Text
 -> ParsecT Void Text Identity a -> ParsecT Void Text Identity a)
-> Parser Text
-> ParsecT Void Text Identity a
-> ParsecT Void Text Identity a
forall a b. (a -> b) -> a -> b
$ Text -> Parser Text
symbol Text
"]"