module CompOps where
import CompF(compF)
import ParF(parF)
import CompFfun
import Fudget
import SerCompF(serCompF)
import CompSP(serCompSP,compEitherSP)
import ParSP(parSP)

-- Change priority??
infixl 5 >+<
infixl 5 >*<
infixr 4 >==<
infixr 8 -==-, -+-, -*-
infixr 7 >^^=<
infixr 5 >..=<
infixl 6 >=^^<
infixl 6 >=..<
infixr 7 >^=<
infixr 6 >.=<
infixl 6 >=^<
infixl 6 >=.<

-- Infix operators for common stream processor combinators.

SP a1 b
sp1 -==- :: SP a1 b -> SP a2 a1 -> SP a2 b
-==- SP a2 a1
sp2 = SP a1 b -> SP a2 a1 -> SP a2 b
forall a1 b a2. SP a1 b -> SP a2 a1 -> SP a2 b
serCompSP SP a1 b
sp1 SP a2 a1
sp2
SP a1 a2
sp1 -+- :: SP a1 a2 -> SP a3 b -> SP (Either a1 a3) (Either a2 b)
-+- SP a3 b
sp2 = SP a1 a2 -> SP a3 b -> SP (Either a1 a3) (Either a2 b)
forall a1 a2 a3 b.
SP a1 a2 -> SP a3 b -> SP (Either a1 a3) (Either a2 b)
compEitherSP SP a1 a2
sp1 SP a3 b
sp2
SP a b
sp1 -*- :: SP a b -> SP a b -> SP a b
-*- SP a b
sp2 = SP a b -> SP a b -> SP a b
forall a b. SP a b -> SP a b -> SP a b
parSP SP a b
sp1 SP a b
sp2

-- Infix operators for common fudget combinators.

F a b
w1 >+< :: F a b -> F c d -> F (Either a c) (Either b d)
>+< F c d
w2 = F a b -> F c d -> F (Either a c) (Either b d)
forall a b c d. F a b -> F c d -> F (Either a c) (Either b d)
compF F a b
w1 F c d
w2
F c ho
w1 >*< :: F c ho -> F c ho -> F c ho
>*< F c ho
w2 = F c ho -> F c ho -> F c ho
forall c ho. F c ho -> F c ho -> F c ho
parF F c ho
w1 F c ho
w2
F a1 b
w1 >==< :: F a1 b -> F a2 a1 -> F a2 b
>==< F a2 a1
w2 = F a1 b -> F a2 a1 -> F a2 b
forall a1 b a2. F a1 b -> F a2 a1 -> F a2 b
serCompF F a1 b
w1 F a2 a1
w2

(>^^=<) :: (SP a b) -> (F e a) -> F e b
SP a b
f >^^=< :: SP a b -> F e a -> F e b
>^^=< F e a
w = SP a b -> F e a -> F e b
forall a ho hi. SP a ho -> F hi a -> F hi ho
postProcessHigh SP a b
f F e a
w
(>=^^<) :: (F c d) -> (SP e c) -> F e d
F c d
w >=^^< :: F c d -> SP e c -> F e d
>=^^< SP e c
f = F c d -> SP e c -> F e d
forall c ho hi. F c ho -> SP hi c -> F hi ho
preProcessHigh F c d
w SP e c
f
(>^=<) :: (a -> b) -> (F e a) -> F e b
a -> b
f >^=< :: (a -> b) -> F e a -> F e b
>^=< F e a
w = (a -> b) -> F e a -> F e b
forall a ho hi. (a -> ho) -> F hi a -> F hi ho
postMapHigh a -> b
f F e a
w
(>=^<) :: (F c d) -> (e -> c) -> F e d
F c d
w >=^< :: F c d -> (e -> c) -> F e d
>=^< e -> c
f = F c d -> (e -> c) -> F e d
forall c ho hi. F c ho -> (hi -> c) -> F hi ho
preMapHigh F c d
w e -> c
f

SP TCommand TCommand
f >..=< :: SP TCommand TCommand -> F hi ho -> F hi ho
>..=< F hi ho
w = SP TCommand TCommand -> F hi ho -> F hi ho
forall hi ho. SP TCommand TCommand -> F hi ho -> F hi ho
postProcessLow SP TCommand TCommand
f F hi ho
w
F hi ho
w >=..< :: F hi ho -> SP TEvent TEvent -> F hi ho
>=..< SP TEvent TEvent
f = F hi ho -> SP TEvent TEvent -> F hi ho
forall hi ho. F hi ho -> SP TEvent TEvent -> F hi ho
preProcessLow F hi ho
w SP TEvent TEvent
f
TCommand -> TCommand
f >.=< :: (TCommand -> TCommand) -> F hi ho -> F hi ho
>.=< F hi ho
w = (TCommand -> TCommand) -> F hi ho -> F hi ho
forall hi ho. (TCommand -> TCommand) -> F hi ho -> F hi ho
postMapLow TCommand -> TCommand
f F hi ho
w
F hi ho
w >=.< :: F hi ho -> (TEvent -> TEvent) -> F hi ho
>=.< TEvent -> TEvent
f = F hi ho -> (TEvent -> TEvent) -> F hi ho
forall hi ho. F hi ho -> (TEvent -> TEvent) -> F hi ho
preMapLow F hi ho
w TEvent -> TEvent
f