module UU.Util.PermTree where
import Control.Monad(ap,liftM2)
data Perms p a = Choice (Maybe a) [Branch p a]
data Branch p a = forall x . Br (p x) (Perms p (x->a))
instance Functor (Perms p) where
fmap :: forall a b. (a -> b) -> Perms p a -> Perms p b
fmap a -> b
f (Choice Maybe a
e [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 a b. (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 a b. (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 :: forall a b. (a -> b) -> Branch p a -> Branch p b
fmap a -> b
f (Br p x
p 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 a b. (a -> b) -> Perms p a -> Perms p 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 :: Maybe a -> p a -> Perms p (a->b) -> Perms p b
add :: forall a (p :: * -> *) b.
Maybe a -> p a -> Perms p (a -> b) -> Perms p b
add Maybe a
da p a
pa tab :: Perms p (a -> b)
tab@(Choice Maybe (a -> b)
dab [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 p x
px 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 a b. (a -> b) -> Perms p a -> Perms p b
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)
empty :: a -> Perms p a
empty :: forall a (p :: * -> *). a -> Perms p a
empty 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
a -> b
f <$$> :: forall a b (p :: * -> *). (a -> b) -> p a -> Perms p b
<$$> 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
a -> b
f <$?> :: forall a b (p :: * -> *). (a -> b) -> (a, p a) -> Perms p b
<$?> (a
e,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
Perms p (a -> b)
ps <||> :: forall (p :: * -> *) a b. Perms p (a -> b) -> p a -> Perms p b
<||> 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
Perms p (a -> b)
ps <|?> :: forall (p :: * -> *) a b. Perms p (a -> b) -> (a, p a) -> Perms p b
<|?> (a
e,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