Typed, bidirectional stream transducers

Server.hs

{-# Language GADTs, Rank2Types #-}

module Server where

data Server li lo ri ro where
  Request :: lo a -> (forall b . li b -> Server li lo ri ro) -> Server li lo ri ro
  Respond :: ro a -> (forall b . ri b -> Server li lo ri ro) -> Server li lo ri ro
  Stop :: Server li lo ri ro 

(|>) :: Server li lo ri ro -> Server ro ri ri2 ro2 -> Server li lo ri2 ro2
(Request send1 recv1) |> r                     = Request send1 $ \x -> recv1 x |> r
(Respond send1 recv1) |> (Request send2 recv2) = recv1 send2 |> recv2 send1
r                     |> (Respond send2 recv2) = Respond send2 $ \x -> r |> recv2 x
Stop                  |> (Request send2 recv2) = Stop 
_                     |> Stop                  = Stop