SerCompF.hs

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 f1) (F f2) = layoutHintF serHint (F{-ff-} $ serCompF' f1 f2)

serCompF' :: FSP a b -> FSP c a -> FSP c b
serCompF' f1 f2 =
    let post (Left (High x)) = High x
        post (Left (Low tcmd)) = compTurnLeft tcmd
        post (Right tcmd) = compTurnRight tcmd
        mid (Left ltev) = Left ltev
        mid (Right (Low tcmd)) = Right tcmd
        mid (Right (High x)) = Left (High x)
        pre (High x) = [Right (High x)]
        pre (Low ([], _)) = []
        pre (Low tev) = compPath tev [] (:[])
    in  serCompSP (postMapSP post
                             (serCompSP (idRightSP f1)
                                        (postMapSP mid (idLeftSP f2))))
                  (concmapSP pre)

serCompRightToLeftF :: (F (Either a b) (Either c a)) -> F b c
serCompRightToLeftF (F sp) =
    let post (Low x) = Right (Low x)
        post (High (Left x)) = Right (High x)
        post (High (Right x)) = Left x
        pre (Right (Low x)) = Low x
        pre (Right (High x)) = High (Right x)
        pre (Left xs) = High (Left xs)
    in F{-ff-} $ loopLeftSP (prepostMapSP pre post sp)

serCompLeftToRightF :: (F (Either a b) (Either b c)) -> F a c
serCompLeftToRightF (F sp) =
    let post (Low x) = Right (Low x)
        post (High (Right x)) = Right (High x)
        post (High (Left x)) = Left x
        pre (Right (Low x)) = Low x
        pre (Right (High x)) = High (Left x)
        pre (Left xs) = High (Right xs)
    in F{-ff-} $ loopLeftSP (prepostMapSP pre post sp)

idRightF :: (F a b) -> F (Either a c) (Either b c)
--and idRightF w = w:+:idF
idRightF w = compF w idF

idLeftF w = compF idF w

absF :: (SP a b) -> F a b
absF sp =
    let pre (High x) = [x]
        pre (Low y) = []
    in F{-ff-} $ serCompSP (postMapSP High sp) (concmapSP pre)

concatMapF = absF . concatMapSP
mapF = absF . mapSP
mapstateF f x = absF (mapstateSP f x)

idF = mapF id

toBothF = concatMapF (\x -> [Left x, Right x])

throughF w = serCompF (idRightF w) toBothF

--and throughF w = idRightF w:==:toBothF
bypassF :: (F a a) -> F a a
bypassF f = postMapHigh stripEither (throughF f)

stubF :: F a b -> F c d
stubF f = serCompF (serCompF nullF f) nullF