{-# LANGUAGE AllowAmbiguousTypes #-}
module Parsers.Utils.Attoparsec where

import Control.Applicative hiding (some)
import Control.Monad (Monad(..), MonadPlus)
import Data.Attoparsec.Combinator
import Data.Bool (Bool(..))
import Data.Char (Char)
import Data.Either (Either(..))
import Data.Eq (Eq(..))
import Data.Function (flip, ($), id)
import Data.Functor (void)
import Data.Maybe (Maybe(..), maybe)
import Data.String (String)
import Data.Word (Word8)
import qualified Data.List as List
import qualified Data.Text as T
import qualified Data.ByteString as BS
import qualified Data.Attoparsec.Internal.Types as AP
import qualified Data.Attoparsec.ByteString as AP.ByteString
import qualified Data.Attoparsec.ByteString.Char8 as AP.ByteString.Char8
import qualified Data.Attoparsec.Text as AP.Text

-- * Class 'Inputable'
class AP.Chunk inp => Inputable inp where
  type Token inp
  null :: inp -> Bool
  empty :: inp
  uncons :: inp -> Maybe (Token inp, inp)
  satisfy :: (Token inp -> Bool) -> AP.Parser inp (Token inp)
  char :: Char -> AP.Parser inp Char
  notInClass :: String -> Token inp -> Bool
instance Inputable T.Text where
  type Token T.Text = Char
  null :: Text -> Bool
null = Text -> Bool
T.null
  empty :: Text
empty = Text
T.empty
  uncons :: Text -> Maybe (Token Text, Text)
uncons = Text -> Maybe (Char, Text)
Text -> Maybe (Token Text, Text)
T.uncons
  satisfy :: (Token Text -> Bool) -> Parser Text (Token Text)
satisfy = (Char -> Bool) -> Parser Text Char
(Token Text -> Bool) -> Parser Text (Token Text)
AP.Text.satisfy
  char :: Char -> Parser Text Char
char = Char -> Parser Text Char
AP.Text.char
  notInClass :: String -> Token Text -> Bool
notInClass = String -> Char -> Bool
String -> Token Text -> Bool
AP.Text.notInClass
instance Inputable BS.ByteString where
  type Token BS.ByteString = Word8
  null :: ByteString -> Bool
null = ByteString -> Bool
BS.null
  empty :: ByteString
empty = ByteString
BS.empty
  uncons :: ByteString -> Maybe (Token ByteString, ByteString)
uncons = ByteString -> Maybe (Word8, ByteString)
ByteString -> Maybe (Token ByteString, ByteString)
BS.uncons
  satisfy :: (Token ByteString -> Bool) -> Parser ByteString (Token ByteString)
satisfy = (Word8 -> Bool) -> Parser Word8
(Token ByteString -> Bool) -> Parser ByteString (Token ByteString)
AP.ByteString.satisfy
  char :: Char -> Parser ByteString Char
char = Char -> Parser ByteString Char
AP.ByteString.Char8.char
  notInClass :: String -> Token ByteString -> Bool
notInClass = String -> Word8 -> Bool
String -> Token ByteString -> Bool
AP.ByteString.notInClass

between :: Applicative f => f a -> f b -> f c -> f c
between :: forall (f :: * -> *) a b c.
Applicative f =>
f a -> f b -> f c -> f c
between f a
o f b
c f c
p = f a
o f a -> f c -> f c
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f c
p f c -> f b -> f c
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* f b
c

match :: (Monad m, Eq a) => [a] -> m a -> (a -> m b) -> m b -> m b
match :: forall (m :: * -> *) a b.
(Monad m, Eq a) =>
[a] -> m a -> (a -> m b) -> m b -> m b
match [a]
xs m a
p a -> m b
f m b
def = m a
p m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\a
x -> if a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
List.elem a
x [a]
xs then a -> m b
f a
x else m b
def)

skipSome :: Alternative p => p a -> p ()
skipSome :: forall (p :: * -> *) a. Alternative p => p a -> p ()
skipSome p a
p = p [a] -> p ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (p a -> p [a]
forall (p :: * -> *) a. Alternative p => p a -> p [a]
some p a
p)

some :: Alternative p => p a -> p [a]
some :: forall (p :: * -> *) a. Alternative p => p a -> p [a]
some = p a -> p [a]
forall (p :: * -> *) a. Alternative p => p a -> p [a]
many1

maybeP :: Alternative p => p a -> p (Maybe a)
maybeP :: forall (p :: * -> *) a. Alternative p => p a -> p (Maybe a)
maybeP p a
p = Maybe a -> p (Maybe a) -> p (Maybe a)
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option Maybe a
forall a. Maybe a
Nothing (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> p a -> p (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p a
p)

fromMaybeP :: Monad m => m (Maybe a) -> m a -> m a
fromMaybeP :: forall (m :: * -> *) a. Monad m => m (Maybe a) -> m a -> m a
fromMaybeP m (Maybe a)
mmx m a
d = m (Maybe a)
mmx m (Maybe a) -> (Maybe a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m a -> (a -> m a) -> Maybe a -> m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m a
d a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return

(<+>) :: Alternative p => p a -> p b -> p (Either a b)
p a
p <+> :: forall (p :: * -> *) a b.
Alternative p =>
p a -> p b -> p (Either a b)
<+> p b
q = a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> p a -> p (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p a
p p (Either a b) -> p (Either a b) -> p (Either a b)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> p b -> p (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p b
q

(<:>) :: Applicative p => p a -> p [a] -> p [a]
<:> :: forall (p :: * -> *) a. Applicative p => p a -> p [a] -> p [a]
(<:>) = (a -> [a] -> [a]) -> p a -> p [a] -> p [a]
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:)

(<~>) :: Applicative p => p a -> p b -> p (a, b)
<~> :: forall (p :: * -> *) a b. Applicative p => p a -> p b -> p (a, b)
(<~>) = (a -> b -> (a, b)) -> p a -> p b -> p (a, b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,)

pfoldl1 :: Alternative p => (b -> a -> b) -> b -> p a -> p b
pfoldl1 :: forall (p :: * -> *) b a.
Alternative p =>
(b -> a -> b) -> b -> p a -> p b
pfoldl1 b -> a -> b
f b
k p a
p = (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' b -> a -> b
f b
k ([a] -> b) -> p [a] -> p b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p a -> p [a]
forall (p :: * -> *) a. Alternative p => p a -> p [a]
some p a
p

(>?>) :: MonadPlus m => m a -> (a -> Bool) -> m a
m a
m >?> :: forall (m :: * -> *) a. MonadPlus m => m a -> (a -> Bool) -> m a
>?> a -> Bool
f = m a
m m a -> (a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
x -> if a -> Bool
f a
x then a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x else m a
forall (f :: * -> *) a. Alternative f => f a
Control.Applicative.empty

chainPre :: Alternative p => p (a -> a) -> p a -> p a
chainPre :: forall (p :: * -> *) a. Alternative p => p (a -> a) -> p a -> p a
chainPre p (a -> a)
op p a
p = (a -> [a -> a] -> a) -> [a -> a] -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (((a -> a) -> a -> a) -> a -> [a -> a] -> a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
List.foldr (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
($)) ([a -> a] -> a -> a) -> p [a -> a] -> p (a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p (a -> a) -> p [a -> a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many p (a -> a)
op p (a -> a) -> p a -> p a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> p a
p

chainPost :: Alternative p => p a -> p (a -> a) -> p a
chainPost :: forall (p :: * -> *) a. Alternative p => p a -> p (a -> a) -> p a
chainPost p a
p p (a -> a)
op = (a -> (a -> a) -> a) -> a -> [a -> a] -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (((a -> a) -> a -> a) -> a -> (a -> a) -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
($)) (a -> [a -> a] -> a) -> p a -> p ([a -> a] -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p a
p p ([a -> a] -> a) -> p [a -> a] -> p a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> p (a -> a) -> p [a -> a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many p (a -> a)
op

chainl1 :: Alternative p => p a -> p (a -> a -> a) -> p a
chainl1 :: forall (p :: * -> *) a.
Alternative p =>
p a -> p (a -> a -> a) -> p a
chainl1 p a
p p (a -> a -> a)
op = p a -> p (a -> a) -> p a
forall (p :: * -> *) a. Alternative p => p a -> p (a -> a) -> p a
chainPost p a
p ((a -> a -> a) -> a -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((a -> a -> a) -> a -> a -> a)
-> p (a -> a -> a) -> p (a -> a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p (a -> a -> a)
op p (a -> a -> a) -> p a -> p (a -> a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> p a
p)

chainr1 :: Alternative p => p a -> p (a -> a -> a) -> p a
chainr1 :: forall (p :: * -> *) a.
Alternative p =>
p a -> p (a -> a -> a) -> p a
chainr1 p a
p p (a -> a -> a)
op = let go :: p a
go = p a
p p a -> p (a -> a) -> p a
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> (((a -> a -> a) -> a -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((a -> a -> a) -> a -> a -> a)
-> p (a -> a -> a) -> p (a -> a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p (a -> a -> a)
op p (a -> a -> a) -> p a -> p (a -> a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> p a
go) p (a -> a) -> p (a -> a) -> p (a -> a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (a -> a) -> p (a -> a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure a -> a
forall a. a -> a
id) in p a
go

data Level p s a
  = InfixL  [p (a -> a -> a)]
  | InfixR  [p (a -> a -> a)]
  | Prefix  [p (a -> a)]
  | Postfix [p (a -> a)]

precedence :: Alternative p => [Level p s a] -> p a -> p a
precedence :: forall (p :: * -> *) s a.
Alternative p =>
[Level p s a] -> p a -> p a
precedence [Level p s a]
levels p a
atom = (p a -> Level p s a -> p a) -> p a -> [Level p s a] -> p a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' p a -> Level p s a -> p a
forall {f :: * -> *} {a} {s}.
Alternative f =>
f a -> Level f s a -> f a
convert p a
atom [Level p s a]
levels
  where
  convert :: f a -> Level f s a -> f a
convert f a
x (InfixL [f (a -> a -> a)]
ops)  = f a -> f (a -> a -> a) -> f a
forall (p :: * -> *) a.
Alternative p =>
p a -> p (a -> a -> a) -> p a
chainl1 f a
x ([f (a -> a -> a)] -> f (a -> a -> a)
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice [f (a -> a -> a)]
ops)
  convert f a
x (InfixR [f (a -> a -> a)]
ops)  = f a -> f (a -> a -> a) -> f a
forall (p :: * -> *) a.
Alternative p =>
p a -> p (a -> a -> a) -> p a
chainr1 f a
x ([f (a -> a -> a)] -> f (a -> a -> a)
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice [f (a -> a -> a)]
ops)
  convert f a
x (Prefix [f (a -> a)]
ops)  = f (a -> a) -> f a -> f a
forall (p :: * -> *) a. Alternative p => p (a -> a) -> p a -> p a
chainPre ([f (a -> a)] -> f (a -> a)
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice [f (a -> a)]
ops) f a
x
  convert f a
x (Postfix [f (a -> a)]
ops) = f a -> f (a -> a) -> f a
forall (p :: * -> *) a. Alternative p => p a -> p (a -> a) -> p a
chainPost f a
x ([f (a -> a)] -> f (a -> a)
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice [f (a -> a)]
ops)