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) = LayoutHint -> F a b -> F a b
forall a b. LayoutHint -> F a b -> F a b
layoutHintF LayoutHint
serHint (FSP a b -> F a b
forall hi ho. FSP hi ho -> F hi ho
F{-ff-} (FSP a b -> F a b) -> FSP a b -> F a b
forall a b. (a -> b) -> a -> b
$ FSP a b -> FSP a a -> FSP 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' :: 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)) = b -> Message (Path, b1) b
forall a b. b -> Message a b
High b
x
        post (Left (Low (Path, b1)
tcmd)) = (Path, b1) -> Message (Path, b1) b
forall b1 b2. (Path, b1) -> Message (Path, b1) b2
compTurnLeft (Path, b1)
tcmd
        post (Right (Path, b1)
tcmd) = (Path, b1) -> Message (Path, b1) b
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) = Message a b -> Either (Message a b) b
forall a b. a -> Either a b
Left Message a b
ltev
        mid (Right (Low b
tcmd)) = b -> Either (Message a b) b
forall a b. b -> Either a b
Right b
tcmd
        mid (Right (High b
x)) = Message a b -> Either (Message a b) b
forall a b. a -> Either a b
Left (b -> Message a b
forall a b. b -> Message a b
High b
x)
        pre :: Message (Path, b1) b
-> [Either (Message (Path, b1) b2) (Message (Path, b1) b)]
pre (High b
x) = [Message (Path, b1) b
-> Either (Message (Path, b1) b2) (Message (Path, b1) b)
forall a b. b -> Either a b
Right (b -> Message (Path, b1) b
forall a b. b -> Message a b
High b
x)]
        pre (Low ([], b1
_)) = []
        pre (Low (Path, b1)
tev) = (Path, b1)
-> [Either (Message (Path, b1) b2) (Message (Path, b1) b)]
-> (Either (Message (Path, b1) b2) (Message (Path, b1) b)
    -> [Either (Message (Path, b1) b2) (Message (Path, b1) b)])
-> [Either (Message (Path, b1) b2) (Message (Path, b1) b)]
forall b1 p b2 b3.
(Path, b1)
-> p
-> (Either (Message (Path, b1) b2) (Message (Path, b1) b3) -> p)
-> p
compPath (Path, b1)
tev [] (Either (Message (Path, b1) b2) (Message (Path, b1) b)
-> [Either (Message (Path, b1) b2) (Message (Path, b1) b)]
-> [Either (Message (Path, b1) b2) (Message (Path, b1) b)]
forall a. a -> [a] -> [a]
:[])
    in  SP
  (Either (Message TEvent a) (FEvent c)) (Message (Path, FRequest) b)
-> SP (FEvent c) (Either (Message TEvent a) (FEvent c)) -> FSP c b
forall a1 b a2. SP a1 b -> SP a2 a1 -> SP a2 b
serCompSP ((Either (Message (Path, FRequest) b) (Path, FRequest)
 -> Message (Path, FRequest) b)
-> SP
     (Either (Message TEvent a) (FEvent c))
     (Either (Message (Path, FRequest) b) (Path, FRequest))
-> SP
     (Either (Message TEvent a) (FEvent c)) (Message (Path, FRequest) b)
forall t b a. (t -> b) -> SP a t -> SP a b
postMapSP Either (Message (Path, FRequest) b) (Path, FRequest)
-> Message (Path, FRequest) b
forall b1 b.
Either (Message (Path, b1) b) (Path, b1) -> Message (Path, b1) b
post
                             (SP
  (Either (Message TEvent a) (Path, FRequest))
  (Either (Message (Path, FRequest) b) (Path, FRequest))
-> SP
     (Either (Message TEvent a) (FEvent c))
     (Either (Message TEvent a) (Path, FRequest))
-> SP
     (Either (Message TEvent a) (FEvent c))
     (Either (Message (Path, FRequest) b) (Path, FRequest))
forall a1 b a2. SP a1 b -> SP a2 a1 -> SP a2 b
serCompSP (FSP a b
-> SP
     (Either (Message TEvent a) (Path, FRequest))
     (Either (Message (Path, FRequest) b) (Path, FRequest))
forall a1 a2 b. SP a1 a2 -> SP (Either a1 b) (Either a2 b)
idRightSP FSP a b
f1)
                                        ((Either (Message TEvent a) (Message (Path, FRequest) a)
 -> Either (Message TEvent a) (Path, FRequest))
-> SP
     (Either (Message TEvent a) (FEvent c))
     (Either (Message TEvent a) (Message (Path, FRequest) a))
-> SP
     (Either (Message TEvent a) (FEvent c))
     (Either (Message TEvent a) (Path, FRequest))
forall t b a. (t -> b) -> SP a t -> SP a b
postMapSP Either (Message TEvent a) (Message (Path, FRequest) a)
-> Either (Message TEvent a) (Path, FRequest)
forall a b b.
Either (Message a b) (Message b b) -> Either (Message a b) b
mid (FSP c a
-> SP
     (Either (Message TEvent a) (FEvent c))
     (Either (Message TEvent a) (Message (Path, FRequest) a))
forall a1 b a2. SP a1 b -> SP (Either a2 a1) (Either a2 b)
idLeftSP FSP c a
f2))))
                  ((FEvent c -> [Either (Message TEvent a) (FEvent c)])
-> SP (FEvent c) (Either (Message TEvent a) (FEvent c))
forall t b. (t -> [b]) -> SP t b
concmapSP FEvent c -> [Either (Message TEvent a) (FEvent c)]
forall b1 b b2.
Message (Path, b1) b
-> [Either (Message (Path, b1) b2) (Message (Path, b1) b)]
pre)

serCompRightToLeftF :: (F (Either a b) (Either c a)) -> F b c
serCompRightToLeftF :: 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) = Message a b -> Either a (Message a b)
forall a b. b -> Either a b
Right (a -> Message a b
forall a b. a -> Message a b
Low a
x)
        post (High (Left b
x)) = Message a b -> Either a (Message a b)
forall a b. b -> Either a b
Right (b -> Message a b
forall a b. b -> Message a b
High b
x)
        post (High (Right a
x)) = a -> Either a (Message a b)
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)) = a -> Message a (Either a b)
forall a b. a -> Message a b
Low a
x
        pre (Right (High b
x)) = Either a b -> Message a (Either a b)
forall a b. b -> Message a b
High (b -> Either a b
forall a b. b -> Either a b
Right b
x)
        pre (Left a
xs) = Either a b -> Message a (Either a b)
forall a b. b -> Message a b
High (a -> Either a b
forall a b. a -> Either a b
Left a
xs)
    in FSP b c -> F b c
forall hi ho. FSP hi ho -> F hi ho
F{-ff-} (FSP b c -> F b c) -> FSP b c -> F b c
forall a b. (a -> b) -> a -> b
$ SP
  (Either a (Message TEvent b))
  (Either a (Message (Path, FRequest) c))
-> FSP b c
forall a1 a2 b. SP (Either a1 a2) (Either a1 b) -> SP a2 b
loopLeftSP ((Either a (Message TEvent b) -> Message TEvent (Either a b))
-> (Message (Path, FRequest) (Either c a)
    -> Either a (Message (Path, FRequest) c))
-> FSP (Either a b) (Either c a)
-> SP
     (Either a (Message TEvent b))
     (Either a (Message (Path, FRequest) c))
forall t1 a t2 b. (t1 -> a) -> (t2 -> b) -> SP a t2 -> SP t1 b
prepostMapSP Either a (Message TEvent b) -> Message TEvent (Either a b)
forall a a b. Either a (Message a b) -> Message a (Either a b)
pre Message (Path, FRequest) (Either c a)
-> Either a (Message (Path, FRequest) c)
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 :: 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) = Message a b -> Either a (Message a b)
forall a b. b -> Either a b
Right (a -> Message a b
forall a b. a -> Message a b
Low a
x)
        post (High (Right b
x)) = Message a b -> Either a (Message a b)
forall a b. b -> Either a b
Right (b -> Message a b
forall a b. b -> Message a b
High b
x)
        post (High (Left a
x)) = a -> Either a (Message a b)
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)) = a -> Message a (Either a b)
forall a b. a -> Message a b
Low a
x
        pre (Right (High a
x)) = Either a b -> Message a (Either a b)
forall a b. b -> Message a b
High (a -> Either a b
forall a b. a -> Either a b
Left a
x)
        pre (Left b
xs) = Either a b -> Message a (Either a b)
forall a b. b -> Message a b
High (b -> Either a b
forall a b. b -> Either a b
Right b
xs)
    in FSP a c -> F a c
forall hi ho. FSP hi ho -> F hi ho
F{-ff-} (FSP a c -> F a c) -> FSP a c -> F a c
forall a b. (a -> b) -> a -> b
$ SP
  (Either b (Message TEvent a))
  (Either b (Message (Path, FRequest) c))
-> FSP a c
forall a1 a2 b. SP (Either a1 a2) (Either a1 b) -> SP a2 b
loopLeftSP ((Either b (Message TEvent a) -> Message TEvent (Either a b))
-> (Message (Path, FRequest) (Either b c)
    -> Either b (Message (Path, FRequest) c))
-> FSP (Either a b) (Either b c)
-> SP
     (Either b (Message TEvent a))
     (Either b (Message (Path, FRequest) c))
forall t1 a t2 b. (t1 -> a) -> (t2 -> b) -> SP a t2 -> SP t1 b
prepostMapSP Either b (Message TEvent a) -> Message TEvent (Either a b)
forall b a a. Either b (Message a a) -> Message a (Either a b)
pre Message (Path, FRequest) (Either b c)
-> Either b (Message (Path, FRequest) c)
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 :: F a b -> F (Either a c) (Either b c)
idRightF F a b
w = F a b -> F c c -> F (Either a c) (Either b c)
forall a b c d. F a b -> F c d -> F (Either a c) (Either b d)
compF F a b
w F c c
forall b. F b b
idF

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

absF :: (SP a b) -> F a b
absF :: 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 FSP a b -> F a b
forall hi ho. FSP hi ho -> F hi ho
F{-ff-} (FSP a b -> F a b) -> FSP a b -> F a b
forall a b. (a -> b) -> a -> b
$ SP a (Message (Path, FRequest) b)
-> SP (Message TEvent a) a -> FSP a b
forall a1 b a2. SP a1 b -> SP a2 a1 -> SP a2 b
serCompSP ((b -> Message (Path, FRequest) b)
-> SP a b -> SP a (Message (Path, FRequest) b)
forall t b a. (t -> b) -> SP a t -> SP a b
postMapSP b -> Message (Path, FRequest) b
forall a b. b -> Message a b
High SP a b
sp) ((Message TEvent a -> [a]) -> SP (Message TEvent a) a
forall t b. (t -> [b]) -> SP t b
concmapSP Message TEvent a -> [a]
forall a a. Message a a -> [a]
pre)

concatMapF :: (a -> [b]) -> F a b
concatMapF = SP a b -> F a b
forall a b. SP a b -> F a b
absF (SP a b -> F a b) -> ((a -> [b]) -> SP a b) -> (a -> [b]) -> F a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> [b]) -> SP a b
forall t b. (t -> [b]) -> SP t b
concatMapSP
mapF :: (a -> b) -> F a b
mapF = SP a b -> F a b
forall a b. SP a b -> F a b
absF (SP a b -> F a b) -> ((a -> b) -> SP a b) -> (a -> b) -> F a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> SP a b
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 = SP a b -> F a b
forall a b. SP a b -> F a b
absF ((t -> a -> (t, [b])) -> t -> SP a b
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 = (b -> b) -> F b b
forall a b. (a -> b) -> F a b
mapF b -> b
forall a. a -> a
id

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

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

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

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