{-# OPTIONS_GHC -Wno-redundant-constraints -Wno-dodgy-imports -Wno-unused-imports #-}

-- |
-- Generic helpers for HeadedMegaparsec.
module PostgresqlSyntax.Extras.HeadedMegaparsec where

import Control.Applicative.Combinators hiding (some)
import Control.Applicative.Combinators.NonEmpty
import qualified Data.Text as Text
import HeadedMegaparsec hiding (string)
import PostgresqlSyntax.Prelude hiding (bit, expr, filter, head, many, option, some, sortBy, tail, try)
import Text.Megaparsec (Parsec, Stream, TraversableStream, VisualStream)
import qualified Text.Megaparsec as Megaparsec
import qualified Text.Megaparsec.Char as MegaparsecChar
import qualified Text.Megaparsec.Char.Lexer as MegaparsecLexer

-- $setup
-- >>> testParser parser = either putStr print . run parser

-- * Executors

run :: (Ord err, VisualStream strm, TraversableStream strm, Megaparsec.ShowErrorComponent err) => HeadedParsec err strm a -> strm -> Either String a
run :: forall err strm a.
(Ord err, VisualStream strm, TraversableStream strm,
 ShowErrorComponent err) =>
HeadedParsec err strm a -> strm -> Either String a
run HeadedParsec err strm a
p = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
Megaparsec.errorBundlePretty forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
Megaparsec.runParser (forall err strm a.
(Ord err, Stream strm) =>
HeadedParsec err strm a -> Parsec err strm a
toParsec HeadedParsec err strm a
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *). MonadParsec e s m => m ()
Megaparsec.eof) String
""

-- * Primitives

-- |
-- Lifted megaparsec\'s `Megaparsec.eof`.
eof :: (Ord err, Stream strm) => HeadedParsec err strm ()
eof :: forall err strm. (Ord err, Stream strm) => HeadedParsec err strm ()
eof = forall err strm a. Parsec err strm a -> HeadedParsec err strm a
parse forall e s (m :: * -> *). MonadParsec e s m => m ()
Megaparsec.eof

-- |
-- Lifted megaparsec\'s `Megaparsec.space`.
space :: (Ord err, Stream strm, Megaparsec.Token strm ~ Char) => HeadedParsec err strm ()
space :: forall err strm.
(Ord err, Stream strm, Token strm ~ Char) =>
HeadedParsec err strm ()
space = forall err strm a. Parsec err strm a -> HeadedParsec err strm a
parse forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
MegaparsecChar.space

-- |
-- Lifted megaparsec\'s `Megaparsec.space1`.
space1 :: (Ord err, Stream strm, Megaparsec.Token strm ~ Char) => HeadedParsec err strm ()
space1 :: forall err strm.
(Ord err, Stream strm, Token strm ~ Char) =>
HeadedParsec err strm ()
space1 = forall err strm a. Parsec err strm a -> HeadedParsec err strm a
parse forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
MegaparsecChar.space1

-- |
-- Lifted megaparsec\'s `Megaparsec.char`.
char :: (Ord err, Stream strm, Megaparsec.Token strm ~ Char) => Char -> HeadedParsec err strm Char
char :: forall err strm.
(Ord err, Stream strm, Token strm ~ Char) =>
Char -> HeadedParsec err strm Char
char Char
a = forall err strm a. Parsec err strm a -> HeadedParsec err strm a
parse (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MegaparsecChar.char Char
a)

-- |
-- Lifted megaparsec\'s `Megaparsec.char'`.
char' :: (Ord err, Stream strm, Megaparsec.Token strm ~ Char) => Char -> HeadedParsec err strm Char
char' :: forall err strm.
(Ord err, Stream strm, Token strm ~ Char) =>
Char -> HeadedParsec err strm Char
char' Char
a = forall err strm a. Parsec err strm a -> HeadedParsec err strm a
parse (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MegaparsecChar.char' Char
a)

-- |
-- Lifted megaparsec\'s `Megaparsec.string`.
string :: (Ord err, Stream strm) => Megaparsec.Tokens strm -> HeadedParsec err strm (Megaparsec.Tokens strm)
string :: forall err strm.
(Ord err, Stream strm) =>
Tokens strm -> HeadedParsec err strm (Tokens strm)
string = forall err strm a. Parsec err strm a -> HeadedParsec err strm a
parse forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MegaparsecChar.string

-- |
-- Lifted megaparsec\'s `Megaparsec.string'`.
string' :: (Ord err, Stream strm, FoldCase (Megaparsec.Tokens strm)) => Megaparsec.Tokens strm -> HeadedParsec err strm (Megaparsec.Tokens strm)
string' :: forall err strm.
(Ord err, Stream strm, FoldCase (Tokens strm)) =>
Tokens strm -> HeadedParsec err strm (Tokens strm)
string' = forall err strm a. Parsec err strm a -> HeadedParsec err strm a
parse forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
MegaparsecChar.string'

-- |
-- Lifted megaparsec\'s `Megaparsec.takeWhileP`.
takeWhileP :: (Ord err, Stream strm) => Maybe String -> (Megaparsec.Token strm -> Bool) -> HeadedParsec err strm (Megaparsec.Tokens strm)
takeWhileP :: forall err strm.
(Ord err, Stream strm) =>
Maybe String
-> (Token strm -> Bool) -> HeadedParsec err strm (Tokens strm)
takeWhileP Maybe String
label Token strm -> Bool
predicate = forall err strm a. Parsec err strm a -> HeadedParsec err strm a
parse (forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
Megaparsec.takeWhileP Maybe String
label Token strm -> Bool
predicate)

-- |
-- Lifted megaparsec\'s `Megaparsec.takeWhile1P`.
takeWhile1P :: (Ord err, Stream strm) => Maybe String -> (Megaparsec.Token strm -> Bool) -> HeadedParsec err strm (Megaparsec.Tokens strm)
takeWhile1P :: forall err strm.
(Ord err, Stream strm) =>
Maybe String
-> (Token strm -> Bool) -> HeadedParsec err strm (Tokens strm)
takeWhile1P Maybe String
label Token strm -> Bool
predicate = forall err strm a. Parsec err strm a -> HeadedParsec err strm a
parse (forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
Megaparsec.takeWhile1P Maybe String
label Token strm -> Bool
predicate)

satisfy :: (Ord err, Stream strm) => (Megaparsec.Token strm -> Bool) -> HeadedParsec err strm (Megaparsec.Token strm)
satisfy :: forall err strm.
(Ord err, Stream strm) =>
(Token strm -> Bool) -> HeadedParsec err strm (Token strm)
satisfy = forall err strm a. Parsec err strm a -> HeadedParsec err strm a
parse forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
Megaparsec.satisfy

decimal :: (Ord err, Stream strm, Megaparsec.Token strm ~ Char, Integral decimal) => HeadedParsec err strm decimal
decimal :: forall err strm decimal.
(Ord err, Stream strm, Token strm ~ Char, Integral decimal) =>
HeadedParsec err strm decimal
decimal = forall err strm a. Parsec err strm a -> HeadedParsec err strm a
parse forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
MegaparsecLexer.decimal

float :: (Ord err, Stream strm, Megaparsec.Token strm ~ Char, RealFloat float) => HeadedParsec err strm float
float :: forall err strm float.
(Ord err, Stream strm, Token strm ~ Char, RealFloat float) =>
HeadedParsec err strm float
float = forall err strm a. Parsec err strm a -> HeadedParsec err strm a
parse forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, RealFloat a) =>
m a
MegaparsecLexer.float

-- * Combinators

sep1 :: (Ord err, Stream strm, Megaparsec.Token strm ~ Char) => HeadedParsec err strm separtor -> HeadedParsec err strm a -> HeadedParsec err strm (NonEmpty a)
sep1 :: forall err strm separtor a.
(Ord err, Stream strm, Token strm ~ Char) =>
HeadedParsec err strm separtor
-> HeadedParsec err strm a -> HeadedParsec err strm (NonEmpty a)
sep1 HeadedParsec err strm separtor
separator HeadedParsec err strm a
parser = do
  a
head <- HeadedParsec err strm a
parser
  forall strm err. Stream strm => HeadedParsec err strm ()
endHead
  [a]
tail <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
many forall a b. (a -> b) -> a -> b
$ HeadedParsec err strm separtor
separator forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> HeadedParsec err strm a
parser
  return (a
head forall a. a -> [a] -> NonEmpty a
:| [a]
tail)

sepEnd1 :: (Ord err, Stream strm, Megaparsec.Token strm ~ Char) => HeadedParsec err strm separator -> HeadedParsec err strm end -> HeadedParsec err strm el -> HeadedParsec err strm (NonEmpty el, end)
sepEnd1 :: forall err strm separator end el.
(Ord err, Stream strm, Token strm ~ Char) =>
HeadedParsec err strm separator
-> HeadedParsec err strm end
-> HeadedParsec err strm el
-> HeadedParsec err strm (NonEmpty el, end)
sepEnd1 HeadedParsec err strm separator
sepP HeadedParsec err strm end
endP HeadedParsec err strm el
elP = do
  el
headEl <- HeadedParsec err strm el
elP
  let loop :: [el] -> HeadedParsec err strm (NonEmpty el, end)
loop ![el]
list = do
        HeadedParsec err strm separator
sepP
        forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
          [ do
              end
end <- HeadedParsec err strm end
endP
              return (el
headEl forall a. a -> [a] -> NonEmpty a
:| forall a. [a] -> [a]
reverse [el]
list, end
end),
            do
              el
el <- HeadedParsec err strm el
elP
              [el] -> HeadedParsec err strm (NonEmpty el, end)
loop (el
el forall a. a -> [a] -> [a]
: [el]
list)
          ]
   in [el] -> HeadedParsec err strm (NonEmpty el, end)
loop []

notFollowedBy :: (Ord err, Stream strm) => HeadedParsec err strm a -> HeadedParsec err strm ()
notFollowedBy :: forall err strm a.
(Ord err, Stream strm) =>
HeadedParsec err strm a -> HeadedParsec err strm ()
notFollowedBy HeadedParsec err strm a
a = forall err strm a. Parsec err strm a -> HeadedParsec err strm a
parse (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
Megaparsec.notFollowedBy (forall err strm a.
(Ord err, Stream strm) =>
HeadedParsec err strm a -> Parsec err strm a
toParsec HeadedParsec err strm a
a))