module SerCompF(stubF, bypassF, throughF, toBothF,
                idF, concatMapF, mapF, mapstateF, absF, idLeftF,
                idRightF, serCompLeftToRightF, serCompRightToLeftF,
		serCompF) where
--import Command(Command(..))
import CompF
import CompFfun(postMapHigh)
import CompSP
--import Direction
--import Event(Event(..))
import Fudget
import Loop
--import Message(Message(..))
import NullF
--import Path(Path(..))
import Route
import Spops
import EitherUtils(stripEither)
import LayoutHints

serCompF :: F a b -> F a a -> F a b
serCompF (F FSP a b
f1) (F FSP a a
f2) = forall a b. LayoutHint -> F a b -> F a b
layoutHintF LayoutHint
serHint (forall hi ho. FSP hi ho -> F hi ho
F{-ff-} forall a b. (a -> b) -> a -> b
$ forall a b c. FSP a b -> FSP c a -> FSP c b
serCompF' FSP a b
f1 FSP a a
f2)

serCompF' :: FSP a b -> FSP c a -> FSP c b
serCompF' :: forall a b c. FSP a b -> FSP c a -> FSP c b
serCompF' FSP a b
f1 FSP c a
f2 =
    let post :: Either (Message (Path, b1) b) (Path, b1) -> Message (Path, b1) b
post (Left (High b
x)) = forall a b. b -> Message a b
High b
x
        post (Left (Low (Path, b1)
tcmd)) = forall {b1} {b2}. (Path, b1) -> Message (Path, b1) b2
compTurnLeft (Path, b1)
tcmd
        post (Right (Path, b1)
tcmd) = forall {b1} {b2}. (Path, b1) -> Message (Path, b1) b2
compTurnRight (Path, b1)
tcmd
        mid :: Either (Message a b) (Message b b) -> Either (Message a b) b
mid (Left Message a b
ltev) = forall a b. a -> Either a b
Left Message a b
ltev
        mid (Right (Low b
tcmd)) = forall a b. b -> Either a b
Right b
tcmd
        mid (Right (High b
x)) = forall a b. a -> Either a b
Left (forall a b. b -> Message a b
High b
x)
        pre :: Message (Path, b1) b
-> [Either (Message (Path, b1) b3) (Message (Path, b1) b)]
pre (High b
x) = [forall a b. b -> Either a b
Right (forall a b. b -> Message a b
High b
x)]
        pre (Low ([], b1
_)) = []
        pre (Low (Path, b1)
tev) = forall {b1} {b2} {b3} {b4}.
(Path, b1)
-> b2
-> (Either (Message (Path, b1) b3) (Message (Path, b1) b4) -> b2)
-> b2
compPath (Path, b1)
tev [] (forall a. a -> [a] -> [a]
:[])
    in  forall {a1} {b} {a2}. SP a1 b -> SP a2 a1 -> SP a2 b
serCompSP (forall {t} {b} {a}. (t -> b) -> SP a t -> SP a b
postMapSP forall {b1} {b}.
Either (Message (Path, b1) b) (Path, b1) -> Message (Path, b1) b
post
                             (forall {a1} {b} {a2}. SP a1 b -> SP a2 a1 -> SP a2 b
serCompSP (forall {a1} {a2} {b}. SP a1 a2 -> SP (Either a1 b) (Either a2 b)
idRightSP FSP a b
f1)
                                        (forall {t} {b} {a}. (t -> b) -> SP a t -> SP a b
postMapSP forall {a} {b} {b}.
Either (Message a b) (Message b b) -> Either (Message a b) b
mid (forall {a1} {b} {a2}. SP a1 b -> SP (Either a2 a1) (Either a2 b)
idLeftSP FSP c a
f2))))
                  (forall {t} {b}. (t -> [b]) -> SP t b
concmapSP forall {b1} {b} {b3}.
Message (Path, b1) b
-> [Either (Message (Path, b1) b3) (Message (Path, b1) b)]
pre)

serCompRightToLeftF :: (F (Either a b) (Either c a)) -> F b c
serCompRightToLeftF :: forall a b c. F (Either a b) (Either c a) -> F b c
serCompRightToLeftF (F FSP (Either a b) (Either c a)
sp) =
    let post :: Message a (Either b a) -> Either a (Message a b)
post (Low a
x) = forall a b. b -> Either a b
Right (forall a b. a -> Message a b
Low a
x)
        post (High (Left b
x)) = forall a b. b -> Either a b
Right (forall a b. b -> Message a b
High b
x)
        post (High (Right a
x)) = forall a b. a -> Either a b
Left a
x
        pre :: Either a (Message a b) -> Message a (Either a b)
pre (Right (Low a
x)) = forall a b. a -> Message a b
Low a
x
        pre (Right (High b
x)) = forall a b. b -> Message a b
High (forall a b. b -> Either a b
Right b
x)
        pre (Left a
xs) = forall a b. b -> Message a b
High (forall a b. a -> Either a b
Left a
xs)
    in forall hi ho. FSP hi ho -> F hi ho
F{-ff-} forall a b. (a -> b) -> a -> b
$ forall {a} {b1} {b2}. SP (Either a b1) (Either a b2) -> SP b1 b2
loopLeftSP (forall {t1} {a} {t2} {b}.
(t1 -> a) -> (t2 -> b) -> SP a t2 -> SP t1 b
prepostMapSP forall {a} {a} {b}.
Either a (Message a b) -> Message a (Either a b)
pre forall {a} {b} {a}.
Message a (Either b a) -> Either a (Message a b)
post FSP (Either a b) (Either c a)
sp)

serCompLeftToRightF :: (F (Either a b) (Either b c)) -> F a c
serCompLeftToRightF :: forall a b c. F (Either a b) (Either b c) -> F a c
serCompLeftToRightF (F FSP (Either a b) (Either b c)
sp) =
    let post :: Message a (Either a b) -> Either a (Message a b)
post (Low a
x) = forall a b. b -> Either a b
Right (forall a b. a -> Message a b
Low a
x)
        post (High (Right b
x)) = forall a b. b -> Either a b
Right (forall a b. b -> Message a b
High b
x)
        post (High (Left a
x)) = forall a b. a -> Either a b
Left a
x
        pre :: Either b (Message a a) -> Message a (Either a b)
pre (Right (Low a
x)) = forall a b. a -> Message a b
Low a
x
        pre (Right (High a
x)) = forall a b. b -> Message a b
High (forall a b. a -> Either a b
Left a
x)
        pre (Left b
xs) = forall a b. b -> Message a b
High (forall a b. b -> Either a b
Right b
xs)
    in forall hi ho. FSP hi ho -> F hi ho
F{-ff-} forall a b. (a -> b) -> a -> b
$ forall {a} {b1} {b2}. SP (Either a b1) (Either a b2) -> SP b1 b2
loopLeftSP (forall {t1} {a} {t2} {b}.
(t1 -> a) -> (t2 -> b) -> SP a t2 -> SP t1 b
prepostMapSP forall {b} {a} {a}.
Either b (Message a a) -> Message a (Either a b)
pre forall {a} {a} {b}.
Message a (Either a b) -> Either a (Message a b)
post FSP (Either a b) (Either b c)
sp)

idRightF :: (F a b) -> F (Either a c) (Either b c)
--and idRightF w = w:+:idF
idRightF :: forall a b c. F a b -> F (Either a c) (Either b c)
idRightF F a b
w = forall {a} {b} {c} {d}.
F a b -> F c d -> F (Either a c) (Either b d)
compF F a b
w forall {b}. F b b
idF

idLeftF :: F c d -> F (Either b c) (Either b d)
idLeftF F c d
w = forall {a} {b} {c} {d}.
F a b -> F c d -> F (Either a c) (Either b d)
compF forall {b}. F b b
idF F c d
w

absF :: (SP a b) -> F a b
absF :: forall a b. SP a b -> F a b
absF SP a b
sp =
    let pre :: Message a a -> [a]
pre (High a
x) = [a
x]
        pre (Low a
y) = []
    in forall hi ho. FSP hi ho -> F hi ho
F{-ff-} forall a b. (a -> b) -> a -> b
$ forall {a1} {b} {a2}. SP a1 b -> SP a2 a1 -> SP a2 b
serCompSP (forall {t} {b} {a}. (t -> b) -> SP a t -> SP a b
postMapSP forall a b. b -> Message a b
High SP a b
sp) (forall {t} {b}. (t -> [b]) -> SP t b
concmapSP forall {a} {a}. Message a a -> [a]
pre)

concatMapF :: (a -> [b]) -> F a b
concatMapF = forall a b. SP a b -> F a b
absF forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {t} {b}. (t -> [b]) -> SP t b
concatMapSP
mapF :: (a -> b) -> F a b
mapF = forall a b. SP a b -> F a b
absF forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {t} {b}. (t -> b) -> SP t b
mapSP
mapstateF :: (t -> a -> (t, [b])) -> t -> F a b
mapstateF t -> a -> (t, [b])
f t
x = forall a b. SP a b -> F a b
absF (forall {t} {a} {b}. (t -> a -> (t, [b])) -> t -> SP a b
mapstateSP t -> a -> (t, [b])
f t
x)

idF :: F b b
idF = forall {a} {b}. (a -> b) -> F a b
mapF forall a. a -> a
id

toBothF :: F b (Either b b)
toBothF = forall {a} {b}. (a -> [b]) -> F a b
concatMapF (\b
x -> [forall a b. a -> Either a b
Left b
x, forall a b. b -> Either a b
Right b
x])

throughF :: F c b -> F c (Either b c)
throughF F c b
w = forall {a} {b} {a}. F a b -> F a a -> F a b
serCompF (forall a b c. F a b -> F (Either a c) (Either b c)
idRightF F c b
w) forall {b}. F b (Either b b)
toBothF

--and throughF w = idRightF w:==:toBothF
bypassF :: (F a a) -> F a a
bypassF :: forall a. F a a -> F a a
bypassF F a a
f = forall {a} {ho} {hi}. (a -> ho) -> F hi a -> F hi ho
postMapHigh forall {a}. Either a a -> a
stripEither (forall {c} {b}. F c b -> F c (Either b c)
throughF F a a
f)

stubF :: F a b -> F c d
stubF :: forall a b c d. F a b -> F c d
stubF F a b
f = forall {a} {b} {a}. F a b -> F a a -> F a b
serCompF (forall {a} {b} {a}. F a b -> F a a -> F a b
serCompF forall {hi} {ho}. F hi ho
nullF F a b
f) forall {hi} {ho}. F hi ho
nullF