{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Text.Parser.Permutation
( Permutation
, permute
, (<||>), (<$$>)
, (<|?>), (<$?>)
) where
import Control.Applicative
import qualified Data.Foldable as F (asum)
infixl 1 <||>, <|?>
infixl 2 <$$>, <$?>
(<||>) :: Functor m => Permutation m (a -> b) -> m a -> Permutation m b
<||> :: forall (m :: * -> *) a b.
Functor m =>
Permutation m (a -> b) -> m a -> Permutation m b
(<||>) = forall (m :: * -> *) a b.
Functor m =>
Permutation m (a -> b) -> m a -> Permutation m b
add
{-# INLINE (<||>) #-}
(<$$>) :: Functor m => (a -> b) -> m a -> Permutation m b
<$$> :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> m a -> Permutation m b
(<$$>) a -> b
f m a
p = forall a b (m :: * -> *). (a -> b) -> Permutation m (a -> b)
newPermutation a -> b
f forall (m :: * -> *) a b.
Functor m =>
Permutation m (a -> b) -> m a -> Permutation m b
<||> m a
p
{-# INLINE (<$$>) #-}
(<|?>) :: Functor m => Permutation m (a -> b) -> (a, m a) -> Permutation m b
<|?> :: forall (m :: * -> *) a b.
Functor m =>
Permutation m (a -> b) -> (a, m a) -> Permutation m b
(<|?>) Permutation m (a -> b)
perm (a
x,m a
p) = forall (m :: * -> *) a b.
Functor m =>
Permutation m (a -> b) -> a -> m a -> Permutation m b
addOpt Permutation m (a -> b)
perm a
x m a
p
{-# INLINE (<|?>) #-}
(<$?>) :: Functor m => (a -> b) -> (a, m a) -> Permutation m b
<$?> :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> (a, m a) -> Permutation m b
(<$?>) a -> b
f (a
x,m a
p) = forall a b (m :: * -> *). (a -> b) -> Permutation m (a -> b)
newPermutation a -> b
f forall (m :: * -> *) a b.
Functor m =>
Permutation m (a -> b) -> (a, m a) -> Permutation m b
<|?> (a
x,m a
p)
{-# INLINE (<$?>) #-}
data Permutation m a = Permutation (Maybe a) [Branch m a]
instance Functor m => Functor (Permutation m) where
fmap :: forall a b. (a -> b) -> Permutation m a -> Permutation m b
fmap a -> b
f (Permutation Maybe a
x [Branch m a]
xs) = forall (m :: * -> *) a. Maybe a -> [Branch m a] -> Permutation m a
Permutation (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Maybe a
x) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Branch m a]
xs)
data Branch m a = forall b. Branch (Permutation m (b -> a)) (m b)
instance Functor m => Functor (Branch m) where
fmap :: forall a b. (a -> b) -> Branch m a -> Branch m b
fmap a -> b
f (Branch Permutation m (b -> a)
perm m b
p) = forall (m :: * -> *) a b.
Permutation m (b -> a) -> m b -> Branch m a
Branch (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b
fforall b c a. (b -> c) -> (a -> b) -> a -> c
.) Permutation m (b -> a)
perm) m b
p
permute :: forall m a. Alternative m => Permutation m a -> m a
permute :: forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
permute (Permutation Maybe a
def [Branch m a]
xs)
= forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
F.asum (forall a b. (a -> b) -> [a] -> [b]
map forall {m :: * -> *} {a}. Alternative m => Branch m a -> m a
branch [Branch m a]
xs forall a. [a] -> [a] -> [a]
++ [m a]
e)
where
e :: [m a]
e :: [m a]
e = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure) Maybe a
def
branch :: Branch m a -> m a
branch (Branch Permutation m (b -> a)
perm m b
p) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. a -> a
id forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m b
p forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
permute Permutation m (b -> a)
perm
newPermutation :: (a -> b) -> Permutation m (a -> b)
newPermutation :: forall a b (m :: * -> *). (a -> b) -> Permutation m (a -> b)
newPermutation a -> b
f = forall (m :: * -> *) a. Maybe a -> [Branch m a] -> Permutation m a
Permutation (forall a. a -> Maybe a
Just a -> b
f) []
{-# INLINE newPermutation #-}
add :: Functor m => Permutation m (a -> b) -> m a -> Permutation m b
add :: forall (m :: * -> *) a b.
Functor m =>
Permutation m (a -> b) -> m a -> Permutation m b
add perm :: Permutation m (a -> b)
perm@(Permutation Maybe (a -> b)
_mf [Branch m (a -> b)]
fs) m a
p
= forall (m :: * -> *) a. Maybe a -> [Branch m a] -> Permutation m a
Permutation forall a. Maybe a
Nothing (Branch m b
firstforall a. a -> [a] -> [a]
:forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Branch m (a -> a) -> Branch m a
insert [Branch m (a -> b)]
fs)
where
first :: Branch m b
first = forall (m :: * -> *) a b.
Permutation m (b -> a) -> m b -> Branch m a
Branch Permutation m (a -> b)
perm m a
p
insert :: Branch m (a -> a) -> Branch m a
insert (Branch Permutation m (b -> a -> a)
perm' m b
p')
= forall (m :: * -> *) a b.
Permutation m (b -> a) -> m b -> Branch m a
Branch (forall (m :: * -> *) a b.
Functor m =>
Permutation m (a -> b) -> m a -> Permutation m b
add (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b c. (a -> b -> c) -> b -> a -> c
flip Permutation m (b -> a -> a)
perm') m a
p) m b
p'
addOpt :: Functor m => Permutation m (a -> b) -> a -> m a -> Permutation m b
addOpt :: forall (m :: * -> *) a b.
Functor m =>
Permutation m (a -> b) -> a -> m a -> Permutation m b
addOpt perm :: Permutation m (a -> b)
perm@(Permutation Maybe (a -> b)
mf [Branch m (a -> b)]
fs) a
x m a
p
= forall (m :: * -> *) a. Maybe a -> [Branch m a] -> Permutation m a
Permutation (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> a -> b
$ a
x) Maybe (a -> b)
mf) (Branch m b
firstforall a. a -> [a] -> [a]
:forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Branch m (a -> a) -> Branch m a
insert [Branch m (a -> b)]
fs)
where
first :: Branch m b
first = forall (m :: * -> *) a b.
Permutation m (b -> a) -> m b -> Branch m a
Branch Permutation m (a -> b)
perm m a
p
insert :: Branch m (a -> a) -> Branch m a
insert (Branch Permutation m (b -> a -> a)
perm' m b
p') = forall (m :: * -> *) a b.
Permutation m (b -> a) -> m b -> Branch m a
Branch (forall (m :: * -> *) a b.
Functor m =>
Permutation m (a -> b) -> a -> m a -> Permutation m b
addOpt (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b c. (a -> b -> c) -> b -> a -> c
flip Permutation m (b -> a -> a)
perm') a
x m a
p) m b
p'