module ConnectF where
import Fudgets(F,(>+<))

infixl :&:,>&<


--leaf :: (o->h)->F i o->(F i o,o->h,i->i)
tagF :: (o -> h) -> F i o -> TagF i o h ((->) i)
tagF o -> h
handler F i o
fud = forall i o h (t :: * -> *).
F i o -> (o -> h) -> t i -> TagF i o h t
TagF F i o
fud o -> h
handler forall a. a -> a
id

--data TagF a b c = TagF a b c
data TagF i o h t = TagF (F i o) (o->h) (t i)
-- TagF makes the type more readable but also more restrictive...

TagF i a h f1
tf1 >&< :: TagF i a h f1
-> TagF b b h f2 -> TagF (Either i b) (Either a b) h (Tags f1 f2)
>&< TagF b b h f2
tf2 = forall {f2 :: * -> *} {f1 :: * -> *} {i} {a} {b} {b} {h}.
(Tag f2, Tag f1) =>
(F i a -> F b b -> F (Either i b) (Either a b))
-> TagF i a h f1
-> TagF b b h f2
-> TagF (Either i b) (Either a b) h (Tags f1 f2)
compTagF forall {a} {b} {c} {d}.
F a b -> F c d -> F (Either a c) (Either b d)
(>+<) TagF i a h f1
tf1 TagF b b h f2
tf2

compTagF :: (F i a -> F b b -> F (Either i b) (Either a b))
-> TagF i a h f1
-> TagF b b h f2
-> TagF (Either i b) (Either a b) h (Tags f1 f2)
compTagF F i a -> F b b -> F (Either i b) (Either a b)
compF (TagF F i a
fud1 a -> h
get1 f1 i
tag1) (TagF F b b
fud2 b -> h
get2 f2 b
tag2) =
    forall i o h (t :: * -> *).
F i o -> (o -> h) -> t i -> TagF i o h t
TagF (F i a -> F b b -> F (Either i b) (Either a b)
compF F i a
fud1 F b b
fud2) (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> h
get1 b -> h
get2) (forall {b}. f1 (Either i b)
etag1 forall (f1 :: * -> *) (f2 :: * -> *) a.
f1 a -> f2 a -> Tags f1 f2 a
:&: forall {a}. f2 (Either a b)
etag2)
  where
    etag1 :: f1 (Either i b)
etag1 = forall (f :: * -> *) b c. Tag f => (b -> c) -> f b -> f c
extend forall a b. a -> Either a b
Left f1 i
tag1
    etag2 :: f2 (Either a b)
etag2 = forall (f :: * -> *) b c. Tag f => (b -> c) -> f b -> f c
extend forall a b. b -> Either a b
Right f2 b
tag2

mapTF :: (F i o -> F i o) -> TagF i o h t -> TagF i o h t
mapTF F i o -> F i o
f (TagF F i o
fud o -> h
get t i
tag) = forall i o h (t :: * -> *).
F i o -> (o -> h) -> t i -> TagF i o h t
TagF (F i o -> F i o
f F i o
fud) o -> h
get t i
tag

ltr :: (b -> c)
-> TagF b a c f2
-> (F b a, Either a b -> c, Tags ((->) b) f2 (Either b b))
ltr b -> c
ih (TagF F b a
fud a -> c
get f2 b
tag) =
  (F b a
fud,forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> c
get b -> c
ih,forall a b. b -> Either a b
Right forall (f1 :: * -> *) (f2 :: * -> *) a.
f1 a -> f2 a -> Tags f1 f2 a
:&: forall (f :: * -> *) b c. Tag f => (b -> c) -> f b -> f c
extend forall a b. a -> Either a b
Left f2 b
tag)

class Tag f where
  extend :: (b->c) -> f b -> f c

data Tags f1 f2 a = (f1 a) :&: (f2 a)

instance Tag ((->) a) where
  extend :: forall b c. (b -> c) -> (a -> b) -> a -> c
extend = forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)

instance (Tag f1,Tag f2) => Tag (Tags f1 f2) where
  extend :: forall b c. (b -> c) -> Tags f1 f2 b -> Tags f1 f2 c
extend b -> c
f (f1 b
g1:&:f2 b
g2) = forall (f :: * -> *) b c. Tag f => (b -> c) -> f b -> f c
extend b -> c
f f1 b
g1forall (f1 :: * -> *) (f2 :: * -> *) a.
f1 a -> f2 a -> Tags f1 f2 a
:&:forall (f :: * -> *) b c. Tag f => (b -> c) -> f b -> f c
extend b -> c
f f2 b
g2

{-
newtype Selector d a = S (d a->Maybe a)

instance Tag (Selector d) where
  extend f 


f d1 d2 = (either d1 no,either no d2)
 :: (d1 a -> Maybe a) ->
    (d2 b -> Maybe b) ->
    (Either (d1 a) (d2 b)->Maybe a,Either (d1 a) (d2 b)->Maybe b)

a->Maybe b -> Either a c -> Maybe b
-}

no :: p -> Maybe a
no p
_ = forall a. Maybe a
Nothing
yes :: a -> Maybe a
yes a
s = forall a. a -> Maybe a
Just a
s
left :: (a -> Maybe a) -> Either a b -> Maybe a
left a -> Maybe a
f = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> Maybe a
f forall {p} {a}. p -> Maybe a
no
right :: (b -> Maybe a) -> Either a b -> Maybe a
right = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {p} {a}. p -> Maybe a
no
leftleft :: (a -> Maybe a) -> Either (Either a b) b -> Maybe a
leftleft = forall {a} {a} {b}. (a -> Maybe a) -> Either a b -> Maybe a
left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {a} {b}. (a -> Maybe a) -> Either a b -> Maybe a
left
leftyes :: Either a b -> Maybe a
leftyes = forall {a} {a} {b}. (a -> Maybe a) -> Either a b -> Maybe a
left forall a. a -> Maybe a
yes