{-# LANGUAGE CPP                 #-}
{-# LANGUAGE ScopedTypeVariables #-}

module UU.Parsing.Perms(Perms(), pPerms, pPermsSep, succeedPerms, (~*~), (~$~)) where

import UU.Parsing
import Data.Maybe

-- =======================================================================================
-- ===== PERMUTATIONS ================================================================
-- =======================================================================================

newtype Perms p a = Perms (Maybe (p a), [Br p a])
data Br p a = forall b. Br (Perms p (b -> a)) (p b)

instance IsParser p s => Functor (Perms p) where
  fmap :: (a -> b) -> Perms p a -> Perms p b
fmap f :: a -> b
f (Perms (mb :: Maybe (p a)
mb, bs :: [Br p a]
bs)) = (Maybe (p b), [Br p b]) -> Perms p b
forall (p :: * -> *) a. (Maybe (p a), [Br p a]) -> Perms p a
Perms ((p a -> p b) -> Maybe (p a) -> Maybe (p b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b
f(a -> b) -> p a -> p b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) Maybe (p a)
mb, (Br p a -> Br p b) -> [Br p a] -> [Br p b]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b) -> Br p a -> Br p b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) [Br p a]
bs)

instance IsParser p s => Functor (Br p) where
  fmap :: (a -> b) -> Br p a -> Br p b
fmap f :: a -> b
f (Br perm :: Perms p (b -> a)
perm p :: p b
p) = Perms p (b -> b) -> p b -> Br p b
forall (p :: * -> *) a b. Perms p (b -> a) -> p b -> Br p a
Br (((b -> a) -> b -> b) -> Perms p (b -> a) -> Perms p (b -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b
f(a -> b) -> (b -> a) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) Perms p (b -> a)
perm) p b
p

(~*~) :: IsParser p s => Perms p (a -> b) -> p a -> Perms p b
perms :: Perms p (a -> b)
perms ~*~ :: Perms p (a -> b) -> p a -> Perms p b
~*~ p :: p a
p = Perms p (a -> b)
perms Perms p (a -> b) -> (Maybe (p a), Maybe (p a)) -> Perms p b
forall (p :: * -> *) s a b.
IsParser p s =>
Perms p (a -> b) -> (Maybe (p a), Maybe (p a)) -> Perms p b
`add` (p a -> Maybe (p a)
forall (p :: * -> *) s v. IsParser p s => p v -> Maybe (p v)
getzerop p a
p, p a -> Maybe (p a)
forall (p :: * -> *) s v. IsParser p s => p v -> Maybe (p v)
getonep p a
p)

(~$~) :: IsParser p s => (a -> b) -> p a -> Perms p b
f :: a -> b
f     ~$~ :: (a -> b) -> p a -> Perms p b
~$~ p :: p a
p = (a -> b) -> Perms p (a -> b)
forall (p :: * -> *) s a. IsParser p s => a -> Perms p a
succeedPerms a -> b
f Perms p (a -> b) -> p a -> Perms p b
forall (p :: * -> *) s a b.
IsParser p s =>
Perms p (a -> b) -> p a -> Perms p b
~*~ p a
p

succeedPerms :: IsParser p s => a -> Perms p a
succeedPerms :: a -> Perms p a
succeedPerms x :: a
x = (Maybe (p a), [Br p a]) -> Perms p a
forall (p :: * -> *) a. (Maybe (p a), [Br p a]) -> Perms p a
Perms (p a -> Maybe (p a)
forall a. a -> Maybe a
Just (a -> p a
forall (p :: * -> *) s a. IsParser p s => a -> p a
pLow a
x), [])

add :: IsParser p s => Perms p (a -> b) -> (Maybe (p a),Maybe (p a)) -> Perms p b
add :: Perms p (a -> b) -> (Maybe (p a), Maybe (p a)) -> Perms p b
add b2a :: Perms p (a -> b)
b2a@(Perms (eb2a :: Maybe (p (a -> b))
eb2a, nb2a :: [Br p (a -> b)]
nb2a)) bp :: (Maybe (p a), Maybe (p a))
bp@(eb :: Maybe (p a)
eb, nb :: Maybe (p a)
nb)
 =  let changing :: IsParser p s => (a -> b) -> Perms p a -> Perms p b
        f :: a -> b
f changing :: (a -> b) -> Perms p a -> Perms p b
`changing` Perms (ep :: Maybe (p a)
ep, np :: [Br p a]
np) = (Maybe (p b), [Br p b]) -> Perms p b
forall (p :: * -> *) a. (Maybe (p a), [Br p a]) -> Perms p a
Perms ((p a -> p b) -> Maybe (p a) -> Maybe (p b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b
f (a -> b) -> p a -> p b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) Maybe (p a)
ep, [Perms p (b -> b) -> p b -> Br p b
forall (p :: * -> *) a b. Perms p (b -> a) -> p b -> Br p a
Br ((a -> b
f(a -> b) -> (b -> a) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((b -> a) -> b -> b) -> Perms p (b -> a) -> Perms p (b -> b)
forall (p :: * -> *) s a b.
IsParser p s =>
(a -> b) -> Perms p a -> Perms p b
`changing` Perms p (b -> a)
pp) p b
p | Br pp :: Perms p (b -> a)
pp p :: p b
p <- [Br p a]
np])
    in (Maybe (p b), [Br p b]) -> Perms p b
forall (p :: * -> *) a. (Maybe (p a), [Br p a]) -> Perms p a
Perms
      ( do { p (a -> b)
f <- Maybe (p (a -> b))
eb2a
           ; p a
x <- Maybe (p a)
eb
           ; p b -> Maybe (p b)
forall (m :: * -> *) a. Monad m => a -> m a
return (p (a -> b)
f p (a -> b) -> p a -> p b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>  p a
x)
           }
      ,  (case Maybe (p a)
nb of
          Nothing     -> [Br p b] -> [Br p b]
forall a. a -> a
id
          Just pb :: p a
pb     -> (Perms p (a -> b) -> p a -> Br p b
forall (p :: * -> *) a b. Perms p (b -> a) -> p b -> Br p a
Br Perms p (a -> b)
b2a  p a
pbBr p b -> [Br p b] -> [Br p b]
forall a. a -> [a] -> [a]
:)
        )[ Perms p (b -> b) -> p b -> Br p b
forall (p :: * -> *) a b. Perms p (b -> a) -> p b -> Br p a
Br (((b -> a -> b) -> a -> b -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((b -> a -> b) -> a -> b -> b)
-> Perms p (b -> a -> b) -> Perms p (a -> b -> b)
forall (p :: * -> *) s a b.
IsParser p s =>
(a -> b) -> Perms p a -> Perms p b
`changing` Perms p (b -> a -> b)
c) Perms p (a -> b -> b)
-> (Maybe (p a), Maybe (p a)) -> Perms p (b -> b)
forall (p :: * -> *) s a b.
IsParser p s =>
Perms p (a -> b) -> (Maybe (p a), Maybe (p a)) -> Perms p b
`add`  (Maybe (p a), Maybe (p a))
bp) p b
d |  Br c :: Perms p (b -> a -> b)
c d :: p b
d <- [Br p (a -> b)]
nb2a]
      )

pPerms :: IsParser p s => Perms p a -> p a
pPerms :: Perms p a -> p a
pPerms (Perms (empty :: Maybe (p a)
empty,nonempty :: [Br p a]
nonempty))
 = (p a -> p a -> p a) -> p a -> [p a] -> p a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl p a -> p a -> p a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) (p a -> Maybe (p a) -> p a
forall a. a -> Maybe a -> a
fromMaybe p a
forall (p :: * -> *) s a. IsParser p s => p a
pFail Maybe (p a)
empty) [ (((b -> a) -> b -> a) -> b -> (b -> a) -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (b -> a) -> b -> a
forall a b. (a -> b) -> a -> b
($)) (b -> (b -> a) -> a) -> p b -> p ((b -> a) -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p b
p p ((b -> a) -> a) -> p (b -> a) -> p a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Perms p (b -> a) -> p (b -> a)
forall (p :: * -> *) s a. IsParser p s => Perms p a -> p a
pPerms Perms p (b -> a)
pp
                                       | Br pp :: Perms p (b -> a)
pp  p :: p b
p <- [Br p a]
nonempty
                                       ]

pPermsSep :: IsParser p s => p x -> Perms p a -> p a
pPermsSep :: p x -> Perms p a -> p a
pPermsSep (p x
sep :: p z) perm :: Perms p a
perm = p () -> Perms p a -> p a
forall a. p () -> Perms p a -> p a
p2p (() -> p ()
forall (p :: * -> *) s a. IsParser p s => a -> p a
pSucceed ()) Perms p a
perm
 where  p2p ::  p () -> Perms p a -> p a
        p2p :: p () -> Perms p a -> p a
p2p fsep :: p ()
fsep (Perms (mbempty :: Maybe (p a)
mbempty, nonempties :: [Br p a]
nonempties)) =
                let empty :: p a
empty          = p a -> Maybe (p a) -> p a
forall a. a -> Maybe a -> a
fromMaybe  p a
forall (p :: * -> *) s a. IsParser p s => p a
pFail Maybe (p a)
mbempty
                    pars :: Br p a -> p a
pars (Br t :: Perms p (b -> a)
t p :: p b
p)  = ((b -> a) -> b -> a) -> b -> (b -> a) -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (b -> a) -> b -> a
forall a b. (a -> b) -> a -> b
($) (b -> (b -> a) -> a) -> p () -> p (b -> (b -> a) -> a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ p ()
fsep p (b -> (b -> a) -> a) -> p b -> p ((b -> a) -> a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> p b
p p ((b -> a) -> a) -> p (b -> a) -> p a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Perms p (b -> a) -> p (b -> a)
forall a. Perms p a -> p a
p2p_sep Perms p (b -> a)
t
                in (p a -> p a -> p a) -> p a -> [p a] -> p a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr p a -> p a -> p a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) p a
empty ((Br p a -> p a) -> [Br p a] -> [p a]
forall a b. (a -> b) -> [a] -> [b]
map Br p a -> p a
forall a. Br p a -> p a
pars [Br p a]
nonempties)
        p2p_sep :: Perms p a -> p a
p2p_sep =  p () -> Perms p a -> p a
forall a. p () -> Perms p a -> p a
p2p (()() -> p x -> p ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ p x
sep)