module MapstateMsg(mapLow, mapHigh, mapstateLow, mapstateHigh) where
import Message(Message(..))
--import SP(SP)
import Spops
import HbcUtils(apSnd)

mapstateHigh :: (t -> t -> (t, [b])) -> t -> SP (Message a t) (Message a b)
mapstateHigh t -> t -> (t, [b])
p t
s =
    let ms :: t -> Message a t -> (t, [Message a b])
ms t
s' (Low a
msg) = (t
s', [forall a b. a -> Message a b
Low a
msg])
        ms t
s' (High t
msg) = forall {t} {b} {a}. (t -> b) -> (a, t) -> (a, b)
apSnd (forall a b. (a -> b) -> [a] -> [b]
map forall a b. b -> Message a b
High) (t -> t -> (t, [b])
p t
s' t
msg)
    in  forall {t} {a} {b}. (t -> a -> (t, [b])) -> t -> SP a b
mapstateSP forall {a}. t -> Message a t -> (t, [Message a b])
ms t
s

mapstateLow :: (t -> t -> (t, [a])) -> t -> SP (Message t b) (Message a b)
mapstateLow t -> t -> (t, [a])
p t
s =
    let ms :: t -> Message t b -> (t, [Message a b])
ms t
s' (High b
msg) = (t
s', [forall a b. b -> Message a b
High b
msg])
        ms t
s' (Low t
msg) = forall {t} {b} {a}. (t -> b) -> (a, t) -> (a, b)
apSnd (forall a b. (a -> b) -> [a] -> [b]
map forall a b. a -> Message a b
Low) (t -> t -> (t, [a])
p t
s' t
msg)
    in  forall {t} {a} {b}. (t -> a -> (t, [b])) -> t -> SP a b
mapstateSP forall {b}. t -> Message t b -> (t, [Message a b])
ms t
s

mapHigh :: (t -> [a]) -> SP (Message a t) (Message a a)
mapHigh t -> [a]
p =
    let ms :: Message a t -> [Message a a]
ms (High t
msg) = forall a b. (a -> b) -> [a] -> [b]
map forall a b. b -> Message a b
High (t -> [a]
p t
msg)
        ms (Low a
msg) = [forall a b. a -> Message a b
Low a
msg]
    in  forall {t} {b}. (t -> [b]) -> SP t b
concmapSP forall {a}. Message a t -> [Message a a]
ms

mapLow :: (t -> [a]) -> SP (Message t b) (Message a b)
mapLow t -> [a]
p =
    let ms :: Message t b -> [Message a b]
ms (Low t
msg) = forall a b. (a -> b) -> [a] -> [b]
map forall a b. a -> Message a b
Low (t -> [a]
p t
msg)
        ms (High b
msg) = [forall a b. b -> Message a b
High b
msg]
    in  forall {t} {b}. (t -> [b]) -> SP t b
concmapSP forall {b}. Message t b -> [Message a b]
ms