-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

module Michelson.Parser.Helpers
  ( mkParser
  , sepEndBy1
  , sepBy2
  , parseDef
  , positive
  , mparens
  ) where

import Data.Default (Default(..))
import qualified Data.List.NonEmpty as NE
import qualified Text.Megaparsec as P
import Text.Megaparsec.Char.Lexer (decimal)

import Michelson.Parser.Lexer (parens, word')
import Michelson.Parser.Types (Parser)
import Util.Positive

sepEndBy1 :: MonadPlus m => m a -> m sep -> m (NonEmpty a)
sepEndBy1 :: m a -> m sep -> m (NonEmpty a)
sepEndBy1 = ([a] -> NonEmpty a) -> m [a] -> m (NonEmpty a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> NonEmpty a
forall a. [a] -> NonEmpty a
NE.fromList (m [a] -> m (NonEmpty a))
-> (m a -> m sep -> m [a]) -> m a -> m sep -> m (NonEmpty a)
forall a b c. SuperComposition a b c => a -> b -> c
... m a -> m sep -> m [a]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
P.sepEndBy1

-- | @endBy2 p sep@ parses two or more occurrences of @p@, separated by @sep@.
sepBy2 :: MonadPlus m => m a -> m sep -> m (NonEmpty a)
sepBy2 :: m a -> m sep -> m (NonEmpty a)
sepBy2 parser :: m a
parser sep :: m sep
sep = do
  a
e <- m a
parser
  m sep -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void m sep
sep
  [a]
es <- m a -> m sep -> m [a]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
P.sepBy1 m a
parser m sep
sep
  return $ a
e a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
es

-- | Make a parser from a string
mkParser :: (a -> Text) -> a -> Parser a
mkParser :: (a -> Text) -> a -> Parser a
mkParser f :: a -> Text
f a :: a
a = Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (Parser a -> Parser a) -> Parser a -> Parser a
forall a b. (a -> b) -> a -> b
$ Tokens Text -> a -> Parser a
forall a. Tokens Text -> a -> Parser a
word' (a -> Text
f a
a) a
a

-- | Apply given parser and return default value if it fails.
parseDef :: Default a => Parser a -> Parser a
parseDef :: Parser a -> Parser a
parseDef a :: Parser a
a = Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try Parser a
a Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Default a => a
def

-- | Parse a positive number.
positive :: Parser Positive
positive :: Parser Positive
positive = do
  Integer
n :: Integer <- ReaderT LetEnv (Parsec CustomParserException Text) Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal
  Integer -> Either Text Positive
forall i. (Integral i, Buildable i) => i -> Either Text Positive
mkPositive Integer
n
    Either Text Positive
-> (Either Text Positive -> Parser Positive) -> Parser Positive
forall a b. a -> (a -> b) -> b
& (Text -> Parser Positive)
-> (Positive -> Parser Positive)
-> Either Text Positive
-> Parser Positive
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Parser Positive
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Positive)
-> (Text -> String) -> Text -> Parser Positive
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a. ToString a => a -> String
toString) Positive -> Parser Positive
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Parse expression which can be wrapped in parentheses.
mparens :: Parser a -> Parser a
mparens :: Parser a -> Parser a
mparens p :: Parser a
p = Parser a
p Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser a -> Parser a
forall a. Parser a -> Parser a
parens Parser a
p