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

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

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

import Morley.Michelson.Parser.Types (Parser)
import Morley.Util.SizedList.Types

-- | Version of 'P.sepEndBy1' returning a 'NonEmpty' list
sepEndBy1 :: MonadPlus m => m a -> m sep -> m (NonEmpty a)
sepEndBy1 :: forall (m :: * -> *) a sep.
MonadPlus m =>
m a -> m sep -> m (NonEmpty a)
sepEndBy1 = ([a] -> NonEmpty a) -> m [a] -> m (NonEmpty a)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> NonEmpty a
forall a. HasCallStack => [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

-- | Version of 'P.some' returning a 'NonEmpty' list
some' :: MonadPlus f => f a -> f (NonEmpty a)
some' :: forall (f :: * -> *) a. MonadPlus f => f a -> f (NonEmpty a)
some' = ([a] -> NonEmpty a) -> f [a] -> f (NonEmpty a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> NonEmpty a
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList (f [a] -> f (NonEmpty a))
-> (f a -> f [a]) -> f a -> f (NonEmpty a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> f [a]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.some

-- | Version of 'P.sepBy1' returning a 'NonEmpty' list
sepBy1 :: MonadPlus f => f a -> f sep -> f (NonEmpty a)
sepBy1 :: forall (m :: * -> *) a sep.
MonadPlus m =>
m a -> m sep -> m (NonEmpty a)
sepBy1 = ([a] -> NonEmpty a) -> f [a] -> f (NonEmpty a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> NonEmpty a
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList (f [a] -> f (NonEmpty a))
-> (f a -> f sep -> f [a]) -> f a -> f sep -> f (NonEmpty a)
forall a b c. SuperComposition a b c => a -> b -> c
... f a -> f sep -> f [a]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
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 :: forall (m :: * -> *) a sep.
MonadPlus m =>
m a -> m sep -> m (NonEmpty a)
sepBy2 m a
parser 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

-- | Apply given parser and return default value if it fails.
parseDef :: Default a => Parser a -> Parser a
parseDef :: forall a. Default a => Parser a -> Parser a
parseDef Parser a
a = Parser a -> Parser a
forall a.
ParsecT CustomParserException Text Identity a
-> ParsecT CustomParserException Text Identity 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 a.
ParsecT CustomParserException Text Identity a
-> ParsecT CustomParserException Text Identity a
-> ParsecT CustomParserException Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a -> Parser a
forall a. a -> ParsecT CustomParserException Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Default a => a
def

-- | 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 :: forall (n :: Nat) (m :: * -> *) a.
(SingIPeano n, Applicative m) =>
m a -> m (SizedList n a)
count = SizedList' (ToPeano n) (m a) -> m (SizedList' (ToPeano n) a)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a.
Applicative f =>
SizedList' (ToPeano n) (f a) -> f (SizedList' (ToPeano n) a)
sequenceA (SizedList' (ToPeano n) (m a) -> m (SizedList' (ToPeano n) a))
-> (m a -> SizedList' (ToPeano n) (m a))
-> m a
-> m (SizedList' (ToPeano n) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> SizedList' (ToPeano n) (m a)
forall a. a -> SizedList' (ToPeano n) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# INLINE count #-}