Last active

Embed URL

HTTPS clone URL

SSH clone URL

You can clone with HTTPS or SSH.

Download Gist

Van Laarhoven pipes

View VLPipes.hs
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48
{-# LANGUAGE RecordWildCards #-}
import Control.Monad
import Control.Monad.Trans.Class
import Data.Void
 
data ProxyOps a' a b' b m = Ops { req :: a' -> m a, resp :: b -> m b' }
 
newtype Proxy a' a b' b m r = Proxy { runProxy :: ProxyOps a' a b' b m -> m r }
 
run :: ProxyOps a' a b' b m -> Proxy a' a b' b m r -> m r
run = flip runProxy
 
instance Monad m => Monad (Proxy a' a b' b m) where
return = lift . return
Proxy m >>= f = Proxy $ \ops -> m ops >>= run ops . f
instance MonadTrans (Proxy a' a b' b) where
lift mr = Proxy $ \_ -> mr
runEffect :: Monad m => Proxy Void () () Void m r -> m r
runEffect = run Ops{ req = absurd, resp = absurd }
 
reflect :: Monad m => Proxy a' a b' b m r -> Proxy b b' a a' m r
reflect (Proxy f) = Proxy $ \Ops{..} -> f Ops{ resp = req, req = resp }
 
request :: Monad m => a' -> Proxy a' a y' y m a
request a' = Proxy $ \Ops{..} -> req a'
 
respond :: Monad m => a -> Proxy x' x a' a m a'
respond a = Proxy $ \Ops{..} -> resp a
 
pull :: Monad m => a' -> Proxy a' a a' a m r
pull a' = Proxy $ \Ops{..} -> let go = req >=> resp >=> go in go a'
 
push :: Monad m => a -> Proxy a' a a' a m r
push a = Proxy $ \Ops{..} -> let go = resp >=> req >=> go in go a
 
(//>) :: Monad m
=> Proxy x' x b' b m a'
-> (b -> Proxy x' x c' c m b')
-> Proxy x' x c' c m a'
Proxy p //> fb = Proxy $ \ops -> p ops{ resp = run ops . fb }
 
(>\\) :: Monad m
=> (b' -> Proxy a' a y' y m b)
-> Proxy b' b y' y m c
-> Proxy a' a y' y m c
fb' >\\ Proxy p = Proxy $ \ops -> p ops{ req = run ops . fb' }
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Something went wrong with that request. Please try again.