-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

module Morley.Michelson.Parser.Common
  ( viewName_
  ) where

import Text.Megaparsec (anySingle, customFailure, manyTill)
import Text.Megaparsec.Char (string)

import Morley.Michelson.Parser.Error
import Morley.Michelson.Parser.Lexer
import Morley.Michelson.Parser.Types
import Morley.Michelson.Untyped

viewName_ :: Parser ViewName
viewName_ :: Parser ViewName
viewName_ = Parser ViewName -> Parser ViewName
forall a. Parser a -> Parser a
lexeme do
  Tokens Text
-> ParsecT CustomParserException Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"\""
  [Token Text]
str <- ParsecT CustomParserException Text Identity (Token Text)
-> ParsecT CustomParserException Text Identity (Tokens Text)
-> ParsecT CustomParserException Text Identity [Token Text]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill ParsecT CustomParserException Text Identity (Token Text)
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle (Tokens Text
-> ParsecT CustomParserException Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"\"")
  Text -> Either BadViewNameError ViewName
mkViewName ([Token Text] -> Text
forall a. ToText a => a -> Text
toText [Token Text]
str)
    Either BadViewNameError ViewName
-> (Either BadViewNameError ViewName -> Parser ViewName)
-> Parser ViewName
forall a b. a -> (a -> b) -> b
& (BadViewNameError -> Parser ViewName)
-> (ViewName -> Parser ViewName)
-> Either BadViewNameError ViewName
-> Parser ViewName
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (CustomParserException -> Parser ViewName
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (CustomParserException -> Parser ViewName)
-> (BadViewNameError -> CustomParserException)
-> BadViewNameError
-> Parser ViewName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BadViewNameError -> CustomParserException
ViewNameException) ViewName -> Parser ViewName
forall a. a -> ParsecT CustomParserException Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure