@@ -0,0 +1,40 @@
1+{-# LANGUAGE DataKinds, TypeOperators, GADTs, FlexibleInstances, MultiParamTypeClasses #-}
3+module ExtEff.HTTP where
6+import Control.Eff.Extend
9+type HttpM = Eff '[HTTP, Lift IO]
12+ Open :: String -> HTTP ()
14+ Post :: String -> HTTP String
17+open' :: String -> HttpM ()
23+post' :: String -> HttpM String
29+instance Handle HTTP r b (Eff e b) where
30+ handle h q req = case req of
31+ Open _s -> h (q ^$ ())
33+ Post s -> h (q ^$ ("posted " <> s))
34+ HGet -> h (q ^$ "contents")
36+doHttp :: Eff (HTTP ': e) b -> Eff e b
37+doHttp = fix (handle_relay pure)
39+runHttp :: HttpM a -> IO a
40+runHttp = runLift . doHttp