{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecursiveDo #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module PlutusCore.Parser.ParserCommon where
import Control.Monad (when)
import Control.Monad.Except (MonadError)
import Control.Monad.Reader (ReaderT, ask, local, runReaderT)
import Control.Monad.State (StateT, evalStateT)
import Data.Map qualified as M
import Data.Text (Text)
import Text.Megaparsec hiding (ParseError, State, parse, some)
import Text.Megaparsec.Char (char, space1)
import Text.Megaparsec.Char.Lexer qualified as Lex hiding (hexadecimal)
import Control.Monad.State.Class (MonadState, get, put)
import PlutusCore.Annotation
import PlutusCore.Core.Type
import PlutusCore.Error
import PlutusCore.Name.Unique (Name (..), Unique (..), isIdentifierChar, isIdentifierStartingChar,
isQuotedIdentifierChar)
import PlutusCore.Quote
newtype ParserState = ParserState {ParserState -> Map Text Unique
identifiers :: M.Map Text Unique}
deriving stock (Int -> ParserState -> ShowS
[ParserState] -> ShowS
ParserState -> String
(Int -> ParserState -> ShowS)
-> (ParserState -> String)
-> ([ParserState] -> ShowS)
-> Show ParserState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParserState -> ShowS
showsPrec :: Int -> ParserState -> ShowS
$cshow :: ParserState -> String
show :: ParserState -> String
$cshowList :: [ParserState] -> ShowS
showList :: [ParserState] -> ShowS
Show)
type Parser =
ParsecT ParserError Text (StateT ParserState (ReaderT (Maybe Version) Quote))
instance (Stream s, MonadQuote m) => MonadQuote (ParsecT e s m)
initial :: ParserState
initial :: ParserState
initial = Map Text Unique -> ParserState
ParserState Map Text Unique
forall k a. Map k a
M.empty
getVersion :: Parser (Maybe Version)
getVersion :: Parser (Maybe Version)
getVersion = Parser (Maybe Version)
forall r (m :: * -> *). MonadReader r m => m r
ask
withVersion :: Version -> Parser a -> Parser a
withVersion :: forall a. Version -> Parser a -> Parser a
withVersion Version
v = (Maybe Version -> Maybe Version)
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
forall a.
(Maybe Version -> Maybe Version)
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (Maybe Version -> Maybe Version -> Maybe Version
forall a b. a -> b -> a
const (Maybe Version -> Maybe Version -> Maybe Version)
-> Maybe Version -> Maybe Version -> Maybe Version
forall a b. (a -> b) -> a -> b
$ Version -> Maybe Version
forall a. a -> Maybe a
Just Version
v)
whenVersion :: (Version -> Bool) -> Parser () -> Parser ()
whenVersion :: (Version -> Bool) -> Parser () -> Parser ()
whenVersion Version -> Bool
p Parser ()
act = do
Maybe Version
mv <- Parser (Maybe Version)
getVersion
case Maybe Version
mv of
Maybe Version
Nothing -> () -> Parser ()
forall a.
a
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just Version
v -> Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Version -> Bool
p Version
v) Parser ()
act
parse
:: (AsParserErrorBundle e, MonadError e m, MonadQuote m)
=> Parser a
-> String
-> Text
-> m a
parse :: forall e (m :: * -> *) a.
(AsParserErrorBundle e, MonadError e m, MonadQuote m) =>
Parser a -> String -> Text -> m a
parse Parser a
p String
file Text
str = do
let res :: Quote (Either ParserErrorBundle a)
res = (Either (ParseErrorBundle Text ParserError) a
-> Either ParserErrorBundle a)
-> Quote (Either (ParseErrorBundle Text ParserError) a)
-> Quote (Either ParserErrorBundle a)
forall a b. (a -> b) -> Quote a -> Quote b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either (ParseErrorBundle Text ParserError) a
-> Either ParserErrorBundle a
forall a.
Either (ParseErrorBundle Text ParserError) a
-> Either ParserErrorBundle a
toErrorB (ReaderT
(Maybe Version)
Quote
(Either (ParseErrorBundle Text ParserError) a)
-> Maybe Version
-> Quote (Either (ParseErrorBundle Text ParserError) a)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (StateT
ParserState
(ReaderT (Maybe Version) Quote)
(Either (ParseErrorBundle Text ParserError) a)
-> ParserState
-> ReaderT
(Maybe Version)
Quote
(Either (ParseErrorBundle Text ParserError) a)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (Parser a
-> String
-> Text
-> StateT
ParserState
(ReaderT (Maybe Version) Quote)
(Either (ParseErrorBundle Text ParserError) a)
forall (m :: * -> *) e s a.
Monad m =>
ParsecT e s m a
-> String -> s -> m (Either (ParseErrorBundle s e) a)
runParserT Parser a
p String
file Text
str) ParserState
initial) Maybe Version
forall a. Maybe a
Nothing)
AReview e ParserErrorBundle -> Either ParserErrorBundle a -> m a
forall e (m :: * -> *) t a.
MonadError e m =>
AReview e t -> Either t a -> m a
throwingEither AReview e ParserErrorBundle
forall r. AsParserErrorBundle r => Prism' r ParserErrorBundle
Prism' e ParserErrorBundle
_ParserErrorBundle (Either ParserErrorBundle a -> m a)
-> m (Either ParserErrorBundle a) -> m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Quote (Either ParserErrorBundle a)
-> m (Either ParserErrorBundle a)
forall a. Quote a -> m a
forall (m :: * -> *) a. MonadQuote m => Quote a -> m a
liftQuote Quote (Either ParserErrorBundle a)
res
toErrorB :: Either (ParseErrorBundle Text ParserError) a -> Either ParserErrorBundle a
toErrorB :: forall a.
Either (ParseErrorBundle Text ParserError) a
-> Either ParserErrorBundle a
toErrorB (Left ParseErrorBundle Text ParserError
err) = ParserErrorBundle -> Either ParserErrorBundle a
forall a b. a -> Either a b
Left (ParserErrorBundle -> Either ParserErrorBundle a)
-> ParserErrorBundle -> Either ParserErrorBundle a
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle Text ParserError -> ParserErrorBundle
ParseErrorB ParseErrorBundle Text ParserError
err
toErrorB (Right a
a) = a -> Either ParserErrorBundle a
forall a b. b -> Either a b
Right a
a
parseGen :: (AsParserErrorBundle e, MonadError e m, MonadQuote m) => Parser a -> Text -> m a
parseGen :: forall e (m :: * -> *) a.
(AsParserErrorBundle e, MonadError e m, MonadQuote m) =>
Parser a -> Text -> m a
parseGen Parser a
stuff = Parser a -> String -> Text -> m a
forall e (m :: * -> *) a.
(AsParserErrorBundle e, MonadError e m, MonadQuote m) =>
Parser a -> String -> Text -> m a
parse Parser a
stuff String
"test"
whitespace :: Parser ()
whitespace :: Parser ()
whitespace = Parser () -> Parser () -> Parser () -> Parser ()
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> m () -> m () -> m ()
Lex.space 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 ()
Lex.skipLineComment Tokens Text
"--") (Tokens Text -> Tokens Text -> Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Tokens s -> Tokens s -> m ()
Lex.skipBlockCommentNested Tokens Text
"{-" Tokens Text
"-}")
leadingWhitespace :: Parser a -> Parser a
leadingWhitespace :: forall a. Parser a -> Parser a
leadingWhitespace = (Parser ()
whitespace Parser ()
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
forall a b.
ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
b
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>)
trailingWhitespace :: Parser a -> Parser a
trailingWhitespace :: forall a. Parser a -> Parser a
trailingWhitespace = (ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
-> Parser ()
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
forall a b.
ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
b
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
whitespace)
withSpan' :: (SrcSpan -> Parser a) -> Parser a
withSpan' :: forall a. (SrcSpan -> Parser a) -> Parser a
withSpan' SrcSpan -> Parser a
f = mdo
SourcePos
start <- ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
a
res <- SrcSpan -> Parser a
f SrcSpan
sp
SourcePos
end <- ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
let sp :: SrcSpan
sp = SourcePos -> SourcePos -> SrcSpan
toSrcSpan SourcePos
start SourcePos
end
a -> Parser a
forall a.
a
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
res
withSpan :: (SrcSpan -> Parser a) -> Parser a
withSpan :: forall a. (SrcSpan -> Parser a) -> Parser a
withSpan = (ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
-> Parser ()
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
forall a b.
ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
b
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
whitespace) (ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a)
-> ((SrcSpan
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a)
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a)
-> (SrcSpan
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a)
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SrcSpan
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a)
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
forall a. (SrcSpan -> Parser a) -> Parser a
withSpan'
lexeme :: Parser a -> Parser a
lexeme :: forall a. Parser a -> Parser a
lexeme = Parser ()
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
Lex.lexeme Parser ()
whitespace
symbol :: Text -> Parser Text
symbol :: Text -> Parser Text
symbol = Parser ()
-> Tokens Text
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
(Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> Tokens s -> m (Tokens s)
Lex.symbol Parser ()
whitespace
inParens :: Parser a -> Parser a
inParens :: forall a. Parser a -> Parser a
inParens = Parser Text
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
Char
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Text -> Parser Text
symbol Text
"(") (Token Text
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
(Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
')')
inBrackets :: Parser a -> Parser a
inBrackets :: forall a. Parser a -> Parser a
inBrackets = Parser Text
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
Char
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Text -> Parser Text
symbol Text
"[") (Token Text
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
(Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
']')
inBraces :: Parser a -> Parser a
inBraces :: forall a. Parser a -> Parser a
inBraces = Parser Text
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
Char
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Text -> Parser Text
symbol Text
"{") (Token Text
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
(Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'}')
toSrcSpan :: SourcePos -> SourcePos -> SrcSpan
toSrcSpan :: SourcePos -> SourcePos -> SrcSpan
toSrcSpan SourcePos
start SourcePos
end =
SrcSpan
{ srcSpanFile :: String
srcSpanFile = SourcePos -> String
sourceName SourcePos
start
, srcSpanSLine :: Int
srcSpanSLine = Pos -> Int
unPos (SourcePos -> Pos
sourceLine SourcePos
start)
, srcSpanSCol :: Int
srcSpanSCol = Pos -> Int
unPos (SourcePos -> Pos
sourceColumn SourcePos
start)
, srcSpanELine :: Int
srcSpanELine = Pos -> Int
unPos (SourcePos -> Pos
sourceLine SourcePos
end)
, srcSpanECol :: Int
srcSpanECol = Pos -> Int
unPos (SourcePos -> Pos
sourceColumn SourcePos
end)
}
version :: Parser Version
version :: Parser Version
version = Parser Version -> Parser Version
forall a. Parser a -> Parser a
trailingWhitespace (Parser Version -> Parser Version)
-> Parser Version -> Parser Version
forall a b. (a -> b) -> a -> b
$ do
Natural
x <- ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
Natural
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
Lex.decimal
Char
_ <- Token Text
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
(Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'.'
Natural
y <- ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
Natural
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
Lex.decimal
Char
_ <- Token Text
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
(Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'.'
Natural -> Natural -> Natural -> Version
Version Natural
x Natural
y (Natural -> Version)
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
Natural
-> Parser Version
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
Natural
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
Lex.decimal
name :: Parser Name
name :: Parser Name
name = Parser Name -> Parser Name
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser Name -> Parser Name) -> Parser Name -> Parser Name
forall a b. (a -> b) -> a -> b
$ Parser Name
parseUnquoted Parser Name -> Parser Name -> Parser Name
forall a.
ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Name
parseQuoted
where
parseUnquoted :: Parser Name
parseUnquoted :: Parser Name
parseUnquoted = do
Token Text
_ <- ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
(Token Text)
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
(Token Text)
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead ((Token Text -> Bool)
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
(Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isIdentifierStartingChar)
Text
str <- Maybe String
-> (Token Text -> Bool)
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
(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
"identifier-unquoted") Char -> Bool
Token Text -> Bool
isIdentifierChar
Text -> Unique -> Name
Name Text
str (Unique -> Name)
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
Unique
-> Parser Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
Unique
uniqueSuffix Text
str
parseQuoted :: Parser Name
parseQuoted :: Parser Name
parseQuoted = do
Char
_ <- Token Text
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
(Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'`'
Token Text
_ <- ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
(Token Text)
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
(Token Text)
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead ((Token Text -> Bool)
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
(Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isQuotedIdentifierChar)
Text
str <- Maybe String
-> (Token Text -> Bool)
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
(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
"identifier-quoted") Char -> Bool
Token Text -> Bool
isQuotedIdentifierChar
Char
_ <- Token Text
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
(Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'`'
Text -> Unique -> Name
Name Text
str (Unique -> Name)
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
Unique
-> Parser Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
Unique
uniqueSuffix Text
str
uniqueSuffix :: Text -> Parser Unique
uniqueSuffix :: Text
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
Unique
uniqueSuffix Text
nameStr = ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
Unique
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
Unique
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Int -> Unique
Unique (Int -> Unique)
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
Int
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
Unique
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Token Text
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
(Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'-' ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
Char
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
Int
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
Int
forall a b.
ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
b
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
Lex.decimal)) ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
Unique
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
Unique
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
Unique
forall a.
ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
Unique
forall (m :: * -> *).
(MonadState ParserState m, MonadQuote m) =>
Text -> m Unique
uniqueForName Text
nameStr
uniqueForName :: (MonadState ParserState m, MonadQuote m) => Text -> m Unique
uniqueForName :: forall (m :: * -> *).
(MonadState ParserState m, MonadQuote m) =>
Text -> m Unique
uniqueForName Text
nameStr = do
ParserState
parserState <- m ParserState
forall s (m :: * -> *). MonadState s m => m s
get
case Text -> Map Text Unique -> Maybe Unique
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
nameStr (ParserState -> Map Text Unique
identifiers ParserState
parserState) of
Just Unique
u -> Unique -> m Unique
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Unique
u
Maybe Unique
Nothing -> do
Unique
fresh <- m Unique
forall (m :: * -> *). MonadQuote m => m Unique
freshUnique
ParserState -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (ParserState -> m ()) -> ParserState -> m ()
forall a b. (a -> b) -> a -> b
$ Map Text Unique -> ParserState
ParserState (Map Text Unique -> ParserState) -> Map Text Unique -> ParserState
forall a b. (a -> b) -> a -> b
$ Text -> Unique -> Map Text Unique -> Map Text Unique
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
nameStr Unique
fresh (Map Text Unique -> Map Text Unique)
-> Map Text Unique -> Map Text Unique
forall a b. (a -> b) -> a -> b
$ ParserState -> Map Text Unique
identifiers ParserState
parserState
Unique -> m Unique
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Unique
fresh