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 :: forall a b c. 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) = 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 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 {-layoutHintF loopHint-} (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} {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 :: forall a b c. F (Either a b) (Either c b) -> F a c
loopRightF F (Either a b) (Either c b)
f = forall a b c. F (Either a b) (Either a c) -> F b c
loopLeftF (forall {hi} {b} {c} {ho}.
(hi -> b) -> (c -> ho) -> F b c -> F hi ho
prepostMapHigh forall {b} {a}. Either b a -> Either a b
swapEither 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 :: forall a b c d. 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
   forall a b. LayoutHint -> F a b -> F a b
layoutHintF LayoutHint
loopHint forall a b. (a -> b) -> a -> b
$
   forall hi ho. FSP hi ho -> F hi ho
F{-ff-} forall a b. (a -> b) -> a -> b
$
   forall {a1} {b1} {a2} {b2}.
SP (Either a1 b1) (Either a2 b2) -> SP a2 a1 -> SP b1 b2
loopThroughRightSP
      (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 forall {t} {b} {a}. (t -> b) -> SP a t -> SP a b
`postMapSP` (forall {a1} {a2} {b}. SP a1 a2 -> SP (Either a1 b) (Either a2 b)
idRightSP FSP (Either a b) (Either c d)
m) forall {a1} {b} {a2}. SP a1 b -> SP a2 a1 -> SP a2 b
`serCompSP` forall {t} {b}. (t -> Maybe b) -> SP t b
mapFilterSP 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)) = forall a b. b -> Either a b
Right (forall {b1} {b2}. (Path, b1) -> Message (Path, b1) b2
compTurnLeft (Path, b1)
c)
   post (Right (Left (Path, b1)
c)) = forall a b. b -> Either a b
Right (forall {b1} {b2}. (Path, b1) -> Message (Path, b1) b2
compTurnRight (Path, b1)
c)
   post (Right (Right a
e)) = forall a b. a -> Either a b
Left (forall a b. a -> Message a b
Low a
e)
   post (Left (High (Left b
m))) = forall a b. a -> Either a b
Left (forall a b. b -> Message a b
High b
m)
   post (Left (High (Right b2
m))) = forall a b. b -> Either a b
Right (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 -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (forall a b. a -> Message a b
Low (Path
p,b
e))
       Direction
R:Path
p -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (forall a b. b -> Either a b
Right (Path
p,b
e))
       Path
_   -> forall {a1} {a2}. Show a1 => LayoutHint -> a1 -> a2 -> a2
ctrace LayoutHint
"drop" (Path
p,b
e) forall a b. (a -> b) -> a -> b
$ forall a. Maybe a
Nothing --error "Dno in loopThroughRightF"
   pre (Left (Low a
c)) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (forall a b. a -> Either a b
Left a
c)
   pre (Right (High b
m)) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (forall a b. b -> Message a b
High (forall a b. b -> Either a b
Right b
m))
   pre (Left (High a
m)) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (forall a b. b -> Message a b
High (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 :: forall a b c d.
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)) = forall a b. a -> Either a b
Left (forall a b. b -> Either a b
Right b
x)
        post (Left (Right b
x)) = forall a b. b -> Either a b
Right b
x
        post (Right a
x) = forall a b. a -> Either a b
Left (forall a b. a -> Either a b
Left (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) = forall a b. a -> Either a b
Left (forall a b. b -> Either a b
Right b
x)
    in  forall a b c. F (Either a b) (Either a c) -> F b c
loopLeftF (forall {hi} {b} {c} {ho}.
(hi -> b) -> (c -> ho) -> F b c -> F hi ho
prepostMapHigh forall {a} {b} {b}.
Either (Either (Either a b) b) b -> Either (Either a b) b
pre 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 :: forall a b c d.
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 =
    forall a b c d.
F (Either (Either a b) c) (Either (Either c d) a) -> F b d
loopCompThroughRightF (forall {hi} {b} {c} {ho}.
(hi -> b) -> (c -> ho) -> F b c -> F hi ho
prepostMapHigh forall {b} {a}. Either b a -> Either a b
swapEither 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 :: forall a b. F a a -> F a b
loopOnlyF F a a
f = forall a b c. F (Either a b) (Either a c) -> F b c
loopLeftF (forall {hi} {b} {c} {ho}.
(hi -> b) -> (c -> ho) -> F b c -> F hi ho
prepostMapHigh forall {a}. Either a a -> a
stripEither forall a b. a -> Either a b
Left F a a
f)

loopF :: F a a -> F a a
loopF :: forall a. F a a -> F a a
loopF F a a
f = forall a b c. F (Either a b) (Either a c) -> F b c
loopLeftF (forall {b}. SP b (Either b b)
toBothSPforall a b e. SP a b -> F e a -> F e b
>^^=<F a a
fforall c d e. F c d -> (e -> c) -> F e d
>=^<forall {a}. Either a a -> a
stripEither)