Skip to content

Instantly share code, notes, and snippets.

@abailly
Created May 8, 2018 08:18
Show Gist options
  • Save abailly/d9adbdec3db4dedde7f9e3af56e06e71 to your computer and use it in GitHub Desktop.
Save abailly/d9adbdec3db4dedde7f9e3af56e06e71 to your computer and use it in GitHub Desktop.
A sample Servant + freer Effects server
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-| Sample code struggling with reader Eff
uses code from https://github.com/TaktInc/freer
-}
module TestServer where
import Control.Concurrent.Async
import Eff
import Eff.Exc
import Eff.Exc.Pure
import Eff.Reader
import Eff.Reader.Pure
import Network.HTTP.Client hiding (Proxy)
import qualified Network.Wai.Handler.Warp as Warp
import Protolude hiding (Reader, ask, local, runReader)
import Servant
import Servant.Client
-- * Effect
-- | A dummy `Eff`ect's GADT definition
data MyEff a where
Frobnicate :: Int -> MyEff Text
-- | Helper function
frobnicate:: (Member MyEff r) => Int -> Eff r Text
frobnicate = send . Frobnicate
-- | Sample `MyEff` interpreter
-- Will `show` whatever argument is passed to `Frobnicate`.
runMyEff :: (Member (Reader Env) r)
=> Eff (MyEff ': r) a -> Eff r a
runMyEff = handleRelay pure ( \ (Frobnicate i) -> (>>=) $ do
e <- theenv <$> ask
pure (e <> show i))
-- * Servant
-- | Basic API Type definition
type API = Header "tracing-id" Text :> "foo" :> Capture "bar" Int :> Get '[JSON] Text
api :: Proxy API
api = Proxy
-- | Holds some "local" environment which is dependent upon a request's parameter
data Env = Env { theenv :: Text }
-- | Partial interpreter for standard effects
-- This function is the key to move from the `Eff` world to the `Handler` world
-- expected by Servant. It is a natural transformation from the `Eff r` functor to
-- the `Handler` functor. In servant pre-0.12, it used to be packed into an actual
-- `m ~> n` type provided by @natural-transformations@ package but it is now simply
-- a polymorphic function.
effToHandler :: forall x . Eff '[Exc ServantErr, IO] x -> Handler x
effToHandler = Handler . ExceptT . runM . runError
-- | Server implementation
-- Uses `hoistServer` from Servant 0.13 to interpret handlers into the Servant world
server = serve api (hoistServer api effToHandler handlers)
where
-- We define a local handler to be able to inject a custom `Reader` environment
-- for each request. This is useful for example, when propagating tracing ids
-- across a distributed services network
runHandlers :: forall r x . Env -> Eff (MyEff : Reader Env : r) x -> Eff r x
runHandlers env = runReader env . runMyEff
-- Simple handlers definition.
-- We need to wrap each handler into `runHandlers` to ensure environment is local
-- and available for all interpreters run in that context
handlers (Just t) i = runHandlers (Env t) $ frobnicate i
handlers Nothing i = runHandlers (Env "") $ frobnicate i
-- | Basic Servant Client
foobar :: Maybe Text -> Int -> ClientM Text
foobar = client api
test :: IO ()
test = do
s <- async $ Warp.run 8888 server
env <- ClientEnv <$> newManager defaultManagerSettings <*> pure (BaseUrl Http "localhost" 8888 "")
r <- runClientM (foobar (Just "tid") 12) env
putStrLn ("Right \"tid12\" =?= " <> show r :: [Char])
cancel s
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment