    {-# 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)