    module UU.Util.PermTree where

    import Control.Monad(ap,liftM2)

    ------------------------------------------------------------------------------------
    -- data type for permutation trees
    ------------------------------------------------------------------------------------

    data Perms p a  = Choice (Maybe a) [Branch p a]
    data Branch p a = forall x . Br  (p x) (Perms p  (x->a))

    ------------------------------------------------------------------------------------
    -- definition of fmap on permutation trees
    ------------------------------------------------------------------------------------

    instance Functor (Perms p) where
      fmap :: (a -> b) -> Perms p a -> Perms p b
    fmap f :: a -> b
    f (Choice e :: Maybe a
    e bs :: [Branch p a]
    bs) = Maybe b -> [Branch p b] -> Perms p b
    forall (p :: * -> *) a. Maybe a -> [Branch p a] -> Perms p a
    Choice ((a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> b
    f Maybe a
    e) ((Branch p a -> Branch p b) -> [Branch p a] -> [Branch p b]
    forall a b. (a -> b) -> [a] -> [b]
    map ((a -> b) -> Branch p a -> Branch p b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> b
    f) [Branch p a]
    bs)

    instance Functor (Branch p) where
      fmap :: (a -> b) -> Branch p a -> Branch p b
    fmap f :: a -> b
    f (Br p :: p x
    p ps :: Perms p (x -> a)
    ps) = p x -> Perms p (x -> b) -> Branch p b
    forall (p :: * -> *) a x. p x -> Perms p (x -> a) -> Branch p a
    Br p x
    p (((x -> a) -> x -> b) -> Perms p (x -> a) -> Perms p (x -> b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (a -> b
    f(a -> b) -> (x -> a) -> x -> b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .) Perms p (x -> a)
    ps)

    ------------------------------------------------------------------------------------
    -- add single parser to permutation tree
    ------------------------------------------------------------------------------------

    {-
    ap :: Maybe (a->b)-> Maybe a -> Maybe b
    ap (Just f) (Just x) = Just (f x)
    ap _        _        = Nothing
    -}

    add :: Maybe a -> p a -> Perms p (a->b) -> Perms p b
    add :: Maybe a -> p a -> Perms p (a -> b) -> Perms p b
    add da :: Maybe a
    da pa :: p a
    pa tab :: Perms p (a -> b)
    tab@(Choice dab :: Maybe (a -> b)
    dab bsab :: [Branch p (a -> b)]
    bsab) = let empty :: Maybe b
    empty = Maybe (a -> b)
    dab Maybe (a -> b) -> Maybe a -> Maybe b
    forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
    `ap` Maybe a
    da
                                          insert :: Branch p (a -> a) -> Branch p a
    insert (Br px :: p x
    px txab :: Perms p (x -> a -> a)
    txab) = p x -> Perms p (x -> a) -> Branch p a
    forall (p :: * -> *) a x. p x -> Perms p (x -> a) -> Branch p a
    Br p x
    px (Maybe a -> p a -> Perms p (a -> x -> a) -> Perms p (x -> a)
    forall a (p :: * -> *) b.
    Maybe a -> p a -> Perms p (a -> b) -> Perms p b
    add Maybe a
    da p a
    pa (((x -> a -> a) -> a -> x -> a)
    -> Perms p (x -> a -> a) -> Perms p (a -> x -> a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (x -> a -> a) -> a -> x -> a
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Perms p (x -> a -> a)
    txab))
                                      in Maybe b -> [Branch p b] -> Perms p b
    forall (p :: * -> *) a. Maybe a -> [Branch p a] -> Perms p a
    Choice Maybe b
    empty (p a -> Perms p (a -> b) -> Branch p b
    forall (p :: * -> *) a x. p x -> Perms p (x -> a) -> Branch p a
    Br p a
    pa Perms p (a -> b)
    tabBranch p b -> [Branch p b] -> [Branch p b]
    forall a. a -> [a] -> [a]
    :(Branch p (a -> b) -> Branch p b)
    -> [Branch p (a -> b)] -> [Branch p b]
    forall a b. (a -> b) -> [a] -> [b]
    map Branch p (a -> b) -> Branch p b
    forall a. Branch p (a -> a) -> Branch p a
    insert [Branch p (a -> b)]
    bsab)

    ------------------------------------------------------------------------------------
    -- permutation construction combinators
    ------------------------------------------------------------------------------------
    empty         :: a -> Perms p a
    empty :: a -> Perms p a
    empty x :: a
    x       =  Maybe a -> [Branch p a] -> Perms p a
    forall (p :: * -> *) a. Maybe a -> [Branch p a] -> Perms p a
    Choice (a -> Maybe a
    forall a. a -> Maybe a
    Just a
    x) []

    (<$$>)        :: (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 a (p :: * -> *). a -> Perms p a
    empty a -> b
    f Perms p (a -> b) -> p a -> Perms p b
    forall (p :: * -> *) a b. Perms p (a -> b) -> p a -> Perms p b
    <||> p a
    p

    (<$?>)        :: (a->b) -> (a, p a) -> Perms p b
    f :: a -> b
    f <$?> :: (a -> b) -> (a, p a) -> Perms p b
    <$?> (e :: a
    e,p :: p a
    p)  =  (a -> b) -> Perms p (a -> b)
    forall a (p :: * -> *). a -> Perms p a
    empty a -> b
    f Perms p (a -> b) -> (a, p a) -> Perms p b
    forall (p :: * -> *) a b. Perms p (a -> b) -> (a, p a) -> Perms p b
    <|?> (a
    e,p a
    p)

    (<||>)        :: Perms p (a->b) -> p a -> Perms p b
    ps :: Perms p (a -> b)
    ps <||> :: Perms p (a -> b) -> p a -> Perms p b
    <||> p :: p a
    p     =  Maybe a -> p a -> Perms p (a -> b) -> Perms p b
    forall a (p :: * -> *) b.
    Maybe a -> p a -> Perms p (a -> b) -> Perms p b
    add Maybe a
    forall a. Maybe a
    Nothing p a
    p Perms p (a -> b)
    ps

    (<|?>)        :: Perms p (a->b) -> (a, p a) -> Perms p b
    ps :: Perms p (a -> b)
    ps <|?> :: Perms p (a -> b) -> (a, p a) -> Perms p b
    <|?> (e :: a
    e,p :: p a
    p) =  Maybe a -> p a -> Perms p (a -> b) -> Perms p b
    forall a (p :: * -> *) b.
    Maybe a -> p a -> Perms p (a -> b) -> Perms p b
    add (a -> Maybe a
    forall a. a -> Maybe a
    Just a
    e) p a
    p Perms p (a -> b)
    ps