packages feed

morley-1.16.3: src/Morley/Michelson/Parser/Helpers.hs

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

-- TODO [#712]: Remove this next major release
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

module Morley.Michelson.Parser.Helpers
  ( mkParser
  , sepEndBy1
  , some'
  , sepBy1
  , sepBy2
  , parseDef
  , positive
  , count
  ) where

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

import Morley.Michelson.Parser.Lexer (word')
import Morley.Michelson.Parser.Types (Parser)
import Morley.Util.Positive
import Morley.Util.SizedList.Types

-- | Version of 'P.sepEndBy1' returning a 'NonEmpty' list
sepEndBy1 :: MonadPlus m => m a -> m sep -> m (NonEmpty a)
sepEndBy1 = fmap NE.fromList ... P.sepEndBy1

-- | Version of 'P.some' returning a 'NonEmpty' list
some' :: MonadPlus f => f a -> f (NonEmpty a)
some' = fmap NE.fromList . P.some

-- | Version of 'P.sepBy1' returning a 'NonEmpty' list
sepBy1 :: MonadPlus f => f a -> f sep -> f (NonEmpty a)
sepBy1 = fmap NE.fromList ... P.sepBy1

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

-- | Make a parser from a string
mkParser :: (a -> Text) -> a -> Parser le a
mkParser f a = word' (f a) a

-- | Apply given parser and return default value if it fails.
parseDef :: Default a => Parser le a -> Parser le a
parseDef a = P.try a <|> pure def

-- | Parse a positive number.
positive :: Parser le Positive
positive = do
  n :: Integer <- decimal
  mkPositive n
    & either (fail . toString) pure

-- | Parse expression @n@ times, where @n@ is a type-level natural.
-- Essentially, a type-safe version of 'P.count', but requires
-- the count to be known on the type level.
count :: (SingIPeano n, Applicative m) => m a -> m (SizedList n a)
count = sequenceA . pure
{-# INLINE count #-}