module Loops(loopF, loopThroughRightF, loopCompThroughRightF, loopCompThroughLeftF, loopRightF, loopLeftF, loopOnlyF) where
import Maptrace(ctrace) -- debugging -- syntax error if you put this is last in the import list. TH 960428
--import Command(Command(..))
import CompFfun(prepostMapHigh)
--import CompSP(prepostMapSP)
import CompOps
--import Event(Event(..))
import Fudget
import Loop
--import Message(Message(..))
--import Path(Path(..))
--import SP
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 {-layoutHintF loopHint-} (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 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) = 
   --loopThroughRightSP (prepostMapSP pre post (idRightSP m)) s where
   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{-ff-} (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 --error "Dno in loopThroughRightF"
   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)