module Loops(loopF, loopThroughRightF, loopCompThroughRightF, loopCompThroughLeftF, loopRightF, loopLeftF, loopOnlyF) where
import Maptrace(ctrace)
import CompFfun(prepostMapHigh)
import CompOps
import Fudget
import Loop
import SpEither(toBothSP,mapFilterSP)
import EitherUtils(stripEither, swapEither)
import LayoutHints
import Route
import Direction
import Loopthrough
import CompSP
loopLeftF :: (F (Either a b) (Either a c)) -> F b c
loopLeftF :: F (Either a b) (Either a c) -> F b c
loopLeftF (F FSP (Either a b) (Either a 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 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 (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 TCommand 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 TCommand (Either a c) -> Either a (Message TCommand c))
-> FSP (Either a b) (Either a c)
-> SP (Either a (Message TEvent b)) (Either a (Message TCommand 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 TCommand (Either a c) -> Either a (Message TCommand c)
forall a a b. Message a (Either a b) -> Either a (Message a b)
post FSP (Either a b) (Either a c)
sp))
loopRightF :: (F (Either a b) (Either c b)) -> F a c
loopRightF :: F (Either a b) (Either c b) -> F a c
loopRightF F (Either a b) (Either c b)
f = F (Either b a) (Either b c) -> F a c
forall a b c. F (Either a b) (Either a c) -> F b c
loopLeftF ((Either b a -> Either a b)
-> (Either c b -> Either b c)
-> F (Either a b) (Either c b)
-> F (Either b a) (Either b c)
forall hi b c ho. (hi -> b) -> (c -> ho) -> F b c -> F hi ho
prepostMapHigh Either b a -> Either a b
forall b a. Either b a -> Either a b
swapEither Either c b -> Either b c
forall b a. Either b a -> Either a b
swapEither F (Either a b) (Either c b)
f)
loopThroughRightF :: F (Either a b) (Either c d) -> F c a -> F b d
loopThroughRightF :: F (Either a b) (Either c d) -> F c a -> F b d
loopThroughRightF (F FSP (Either a b) (Either c d)
m) (F FSP c a
s) =
LayoutHint -> F b d -> F b d
forall a b. LayoutHint -> F a b -> F a b
layoutHintF LayoutHint
loopHint (F b d -> F b d) -> F b d -> F b d
forall a b. (a -> b) -> a -> b
$
FSP b d -> F b d
forall hi ho. FSP hi ho -> F hi ho
F (FSP b d -> F b d) -> FSP b d -> F b d
forall a b. (a -> b) -> a -> b
$
SP
(Either (Message TCommand a) (Message TEvent b))
(Either (Message TEvent c) (Message TCommand d))
-> FSP c a -> FSP b d
forall a1 a2 a3 b.
SP (Either a1 a2) (Either a3 b) -> SP a3 a1 -> SP a2 b
loopThroughRightSP
(Either (Message TCommand (Either c d)) (Either TCommand TEvent)
-> Either (Message TEvent c) (Message TCommand d)
forall b1 b b2 a.
Either (Message (Path, b1) (Either b b2)) (Either (Path, b1) a)
-> Either (Message a b) (Message (Path, b1) b2)
post (Either (Message TCommand (Either c d)) (Either TCommand TEvent)
-> Either (Message TEvent c) (Message TCommand d))
-> SP
(Either (FEvent (Either a b)) (Either TCommand TEvent))
(Either (Message TCommand (Either c d)) (Either TCommand TEvent))
-> SP
(Either (FEvent (Either a b)) (Either TCommand TEvent))
(Either (Message TEvent c) (Message TCommand d))
forall t b a. (t -> b) -> SP a t -> SP a b
`postMapSP` (FSP (Either a b) (Either c d)
-> SP
(Either (FEvent (Either a b)) (Either TCommand TEvent))
(Either (Message TCommand (Either c d)) (Either TCommand TEvent))
forall a1 a2 b. SP a1 a2 -> SP (Either a1 b) (Either a2 b)
idRightSP FSP (Either a b) (Either c d)
m) SP
(Either (FEvent (Either a b)) (Either TCommand TEvent))
(Either (Message TEvent c) (Message TCommand d))
-> SP
(Either (Message TCommand a) (Message TEvent b))
(Either (FEvent (Either a b)) (Either TCommand TEvent))
-> SP
(Either (Message TCommand a) (Message TEvent b))
(Either (Message TEvent c) (Message TCommand d))
forall a1 b a2. SP a1 b -> SP a2 a1 -> SP a2 b
`serCompSP` (Either (Message TCommand a) (Message TEvent b)
-> Maybe (Either (FEvent (Either a b)) (Either TCommand TEvent)))
-> SP
(Either (Message TCommand a) (Message TEvent b))
(Either (FEvent (Either a b)) (Either TCommand TEvent))
forall t b. (t -> Maybe b) -> SP t b
mapFilterSP Either (Message TCommand a) (Message TEvent b)
-> Maybe (Either (FEvent (Either a b)) (Either TCommand TEvent))
forall b a a b.
Show b =>
Either (Message a a) (Message (Path, b) b)
-> Maybe
(Either (Message (Path, b) (Either a b)) (Either a (Path, b)))
pre) FSP c a
s where
post :: Either (Message (Path, b1) (Either b b2)) (Either (Path, b1) a)
-> Either (Message a b) (Message (Path, b1) b2)
post (Left (Low (Path, b1)
c)) = Message (Path, b1) b2
-> Either (Message a b) (Message (Path, b1) b2)
forall a b. b -> Either a b
Right ((Path, b1) -> Message (Path, b1) b2
forall b1 b2. (Path, b1) -> Message (Path, b1) b2
compTurnLeft (Path, b1)
c)
post (Right (Left (Path, b1)
c)) = Message (Path, b1) b2
-> Either (Message a b) (Message (Path, b1) b2)
forall a b. b -> Either a b
Right ((Path, b1) -> Message (Path, b1) b2
forall b1 b2. (Path, b1) -> Message (Path, b1) b2
compTurnRight (Path, b1)
c)
post (Right (Right a
e)) = Message a b -> Either (Message a b) (Message (Path, b1) b2)
forall a b. a -> Either a b
Left (a -> Message a b
forall a b. a -> Message a b
Low a
e)
post (Left (High (Left b
m))) = Message a b -> Either (Message a b) (Message (Path, b1) b2)
forall a b. a -> Either a b
Left (b -> Message a b
forall a b. b -> Message a b
High b
m)
post (Left (High (Right b2
m))) = Message (Path, b1) b2
-> Either (Message a b) (Message (Path, b1) b2)
forall a b. b -> Either a b
Right (b2 -> Message (Path, b1) b2
forall a b. b -> Message a b
High b2
m)
pre :: Either (Message a a) (Message (Path, b) b)
-> Maybe
(Either (Message (Path, b) (Either a b)) (Either a (Path, b)))
pre (Right (Low (Path
p,b
e))) =
case Path
p of
Direction
L:Path
p -> Either (Message (Path, b) (Either a b)) (Either a (Path, b))
-> Maybe
(Either (Message (Path, b) (Either a b)) (Either a (Path, b)))
forall a. a -> Maybe a
Just (Either (Message (Path, b) (Either a b)) (Either a (Path, b))
-> Maybe
(Either (Message (Path, b) (Either a b)) (Either a (Path, b))))
-> Either (Message (Path, b) (Either a b)) (Either a (Path, b))
-> Maybe
(Either (Message (Path, b) (Either a b)) (Either a (Path, b)))
forall a b. (a -> b) -> a -> b
$ Message (Path, b) (Either a b)
-> Either (Message (Path, b) (Either a b)) (Either a (Path, b))
forall a b. a -> Either a b
Left ((Path, b) -> Message (Path, b) (Either a b)
forall a b. a -> Message a b
Low (Path
p,b
e))
Direction
R:Path
p -> Either (Message (Path, b) (Either a b)) (Either a (Path, b))
-> Maybe
(Either (Message (Path, b) (Either a b)) (Either a (Path, b)))
forall a. a -> Maybe a
Just (Either (Message (Path, b) (Either a b)) (Either a (Path, b))
-> Maybe
(Either (Message (Path, b) (Either a b)) (Either a (Path, b))))
-> Either (Message (Path, b) (Either a b)) (Either a (Path, b))
-> Maybe
(Either (Message (Path, b) (Either a b)) (Either a (Path, b)))
forall a b. (a -> b) -> a -> b
$ Either a (Path, b)
-> Either (Message (Path, b) (Either a b)) (Either a (Path, b))
forall a b. b -> Either a b
Right ((Path, b) -> Either a (Path, b)
forall a b. b -> Either a b
Right (Path
p,b
e))
Path
_ -> LayoutHint
-> (Path, b)
-> Maybe
(Either (Message (Path, b) (Either a b)) (Either a (Path, b)))
-> Maybe
(Either (Message (Path, b) (Either a b)) (Either a (Path, b)))
forall a1 a2. Show a1 => LayoutHint -> a1 -> a2 -> a2
ctrace LayoutHint
"drop" (Path
p,b
e) (Maybe
(Either (Message (Path, b) (Either a b)) (Either a (Path, b)))
-> Maybe
(Either (Message (Path, b) (Either a b)) (Either a (Path, b))))
-> Maybe
(Either (Message (Path, b) (Either a b)) (Either a (Path, b)))
-> Maybe
(Either (Message (Path, b) (Either a b)) (Either a (Path, b)))
forall a b. (a -> b) -> a -> b
$ Maybe
(Either (Message (Path, b) (Either a b)) (Either a (Path, b)))
forall a. Maybe a
Nothing
pre (Left (Low a
c)) = Either (Message (Path, b) (Either a b)) (Either a (Path, b))
-> Maybe
(Either (Message (Path, b) (Either a b)) (Either a (Path, b)))
forall a. a -> Maybe a
Just (Either (Message (Path, b) (Either a b)) (Either a (Path, b))
-> Maybe
(Either (Message (Path, b) (Either a b)) (Either a (Path, b))))
-> Either (Message (Path, b) (Either a b)) (Either a (Path, b))
-> Maybe
(Either (Message (Path, b) (Either a b)) (Either a (Path, b)))
forall a b. (a -> b) -> a -> b
$ Either a (Path, b)
-> Either (Message (Path, b) (Either a b)) (Either a (Path, b))
forall a b. b -> Either a b
Right (a -> Either a (Path, b)
forall a b. a -> Either a b
Left a
c)
pre (Right (High b
m)) = Either (Message (Path, b) (Either a b)) (Either a (Path, b))
-> Maybe
(Either (Message (Path, b) (Either a b)) (Either a (Path, b)))
forall a. a -> Maybe a
Just (Either (Message (Path, b) (Either a b)) (Either a (Path, b))
-> Maybe
(Either (Message (Path, b) (Either a b)) (Either a (Path, b))))
-> Either (Message (Path, b) (Either a b)) (Either a (Path, b))
-> Maybe
(Either (Message (Path, b) (Either a b)) (Either a (Path, b)))
forall a b. (a -> b) -> a -> b
$ Message (Path, b) (Either a b)
-> Either (Message (Path, b) (Either a b)) (Either a (Path, b))
forall a b. a -> Either a b
Left (Either a b -> Message (Path, b) (Either a b)
forall a b. b -> Message a b
High (b -> Either a b
forall a b. b -> Either a b
Right b
m))
pre (Left (High a
m)) = Either (Message (Path, b) (Either a b)) (Either a (Path, b))
-> Maybe
(Either (Message (Path, b) (Either a b)) (Either a (Path, b)))
forall a. a -> Maybe a
Just (Either (Message (Path, b) (Either a b)) (Either a (Path, b))
-> Maybe
(Either (Message (Path, b) (Either a b)) (Either a (Path, b))))
-> Either (Message (Path, b) (Either a b)) (Either a (Path, b))
-> Maybe
(Either (Message (Path, b) (Either a b)) (Either a (Path, b)))
forall a b. (a -> b) -> a -> b
$ Message (Path, b) (Either a b)
-> Either (Message (Path, b) (Either a b)) (Either a (Path, b))
forall a b. a -> Either a b
Left (Either a b -> Message (Path, b) (Either a b)
forall a b. b -> Message a b
High (a -> Either a b
forall a b. a -> Either a b
Left a
m))
loopCompThroughRightF :: (F (Either (Either a b) c) (Either (Either c d) a)) -> F b d
loopCompThroughRightF :: F (Either (Either a b) c) (Either (Either c d) a) -> F b d
loopCompThroughRightF F (Either (Either a b) c) (Either (Either c d) a)
w =
let post :: Either (Either b b) a -> Either (Either (Either a b) b) b
post (Left (Left b
x)) = Either (Either a b) b -> Either (Either (Either a b) b) b
forall a b. a -> Either a b
Left (b -> Either (Either a b) b
forall a b. b -> Either a b
Right b
x)
post (Left (Right b
x)) = b -> Either (Either (Either a b) b) b
forall a b. b -> Either a b
Right b
x
post (Right a
x) = Either (Either a b) b -> Either (Either (Either a b) b) b
forall a b. a -> Either a b
Left (Either a b -> Either (Either a b) b
forall a b. a -> Either a b
Left (a -> Either a b
forall a b. a -> Either a b
Left a
x))
pre :: Either (Either (Either a b) b) b -> Either (Either a b) b
pre (Left Either (Either a b) b
x) = Either (Either a b) b
x
pre (Right b
x) = Either a b -> Either (Either a b) b
forall a b. a -> Either a b
Left (b -> Either a b
forall a b. b -> Either a b
Right b
x)
in F (Either (Either (Either a b) c) b)
(Either (Either (Either a b) c) d)
-> F b d
forall a b c. F (Either a b) (Either a c) -> F b c
loopLeftF ((Either (Either (Either a b) c) b -> Either (Either a b) c)
-> (Either (Either c d) a -> Either (Either (Either a b) c) d)
-> F (Either (Either a b) c) (Either (Either c d) a)
-> F (Either (Either (Either a b) c) b)
(Either (Either (Either a b) c) d)
forall hi b c ho. (hi -> b) -> (c -> ho) -> F b c -> F hi ho
prepostMapHigh Either (Either (Either a b) c) b -> Either (Either a b) c
forall a b b.
Either (Either (Either a b) b) b -> Either (Either a b) b
pre Either (Either c d) a -> Either (Either (Either a b) c) d
forall b b a b.
Either (Either b b) a -> Either (Either (Either a b) b) b
post F (Either (Either a b) c) (Either (Either c d) a)
w)
loopCompThroughLeftF :: (F (Either a (Either b c)) (Either b (Either a d))) -> F c d
loopCompThroughLeftF :: F (Either a (Either b c)) (Either b (Either a d)) -> F c d
loopCompThroughLeftF F (Either a (Either b c)) (Either b (Either a d))
f =
F (Either (Either b c) a) (Either (Either a d) b) -> F c d
forall a b c d.
F (Either (Either a b) c) (Either (Either c d) a) -> F b d
loopCompThroughRightF ((Either (Either b c) a -> Either a (Either b c))
-> (Either b (Either a d) -> Either (Either a d) b)
-> F (Either a (Either b c)) (Either b (Either a d))
-> F (Either (Either b c) a) (Either (Either a d) b)
forall hi b c ho. (hi -> b) -> (c -> ho) -> F b c -> F hi ho
prepostMapHigh Either (Either b c) a -> Either a (Either b c)
forall b a. Either b a -> Either a b
swapEither Either b (Either a d) -> Either (Either a d) b
forall b a. Either b a -> Either a b
swapEither F (Either a (Either b c)) (Either b (Either a d))
f)
loopOnlyF :: F a a -> F a b
loopOnlyF :: F a a -> F a b
loopOnlyF F a a
f = F (Either a a) (Either a b) -> F a b
forall a b c. F (Either a b) (Either a c) -> F b c
loopLeftF ((Either a a -> a)
-> (a -> Either a b) -> F a a -> F (Either a a) (Either a b)
forall hi b c ho. (hi -> b) -> (c -> ho) -> F b c -> F hi ho
prepostMapHigh Either a a -> a
forall p. Either p p -> p
stripEither a -> Either a b
forall a b. a -> Either a b
Left F a a
f)
loopF :: F a a -> F a a
loopF :: F a a -> F a a
loopF F a a
f = F (Either a a) (Either a a) -> F a a
forall a b c. F (Either a b) (Either a c) -> F b c
loopLeftF (SP a (Either a a)
forall b. SP b (Either b b)
toBothSPSP a (Either a a) -> F a a -> F a (Either a a)
forall a b e. SP a b -> F e a -> F e b
>^^=<F a a
fF a (Either a a)
-> (Either a a -> a) -> F (Either a a) (Either a a)
forall c d e. F c d -> (e -> c) -> F e d
>=^<Either a a -> a
forall p. Either p p -> p
stripEither)