-- Copyright 2019 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

-- | This is a re-export module for parsing.
module Util.P (
    module Util.P
    , module Text.Megaparsec, module Text.Megaparsec.Char
) where
import           Prelude hiding (takeWhile)
import           Control.Monad (void)
import           Data.Text (Text)
import qualified Data.Void as Void

import           Text.Megaparsec
import           Text.Megaparsec.Char


type Parser a = Parsec Void.Void Text a

noneOfC :: Ord e => [Char] -> ParsecT e Text m Char
noneOfC :: forall e (m :: * -> *). Ord e => [Char] -> ParsecT e Text m Char
noneOfC [Char]
cs = forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char]
cs)

oneOfC :: Ord e => [Char] -> ParsecT e Text m Char
oneOfC :: forall e (m :: * -> *). Ord e => [Char] -> ParsecT e Text m Char
oneOfC [Char]
cs = forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
cs)

takeWhile :: MonadParsec e s m => (Token s -> Bool) -> m (Tokens s)
takeWhile :: forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Tokens s)
takeWhile = forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhileP forall a. Maybe a
Nothing

skipWhile :: MonadParsec e s m => (Token s -> Bool) -> m ()
skipWhile :: forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m ()
skipWhile = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhileP forall a. Maybe a
Nothing

takeWhile1 :: MonadParsec e s m => (Token s -> Bool) -> m (Tokens s)
takeWhile1 :: forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Tokens s)
takeWhile1 = forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P forall a. Maybe a
Nothing

skipWhile1 :: MonadParsec e s m => (Token s -> Bool) -> m ()
skipWhile1 :: forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m ()
skipWhile1 = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P forall a. Maybe a
Nothing