git.iko.soy/servant
on master help sign in
Merge pull request #1058 from k-bx/1055-custom-monad
79bbcafOleg Grenrus
doc/cookbook/generic/Generic.lhs+39−4
compare with master
unifiedsplit
@@ -7,10 +7,11 @@
7{-# LANGUAGE TypeOperators #-}
7{-# LANGUAGE TypeOperators #-}
8module Main (main, api, getLink, routesLinks, cliGet) where
8module Main (main, api, getLink, routesLinks, cliGet) where
9
9
10−import Control.Exception (throwIO)
10+import Control.Exception (throwIO)
11+import Control.Monad.Trans.Reader (ReaderT, runReaderT)
11−import Data.Proxy (Proxy (..))
12+import Data.Proxy (Proxy (..))
12−import Network.Wai.Handler.Warp (run)
13+import Network.Wai.Handler.Warp (run)
13−import System.Environment (getArgs)
14+import System.Environment (getArgs)
14
15
15import Servant
16import Servant
16import Servant.Client
17import Servant.Client
@@ -102,5 +103,39 @@ main = do
102 ("run":_) -> do
103 ("run":_) -> do
103 putStrLn "Starting cookbook-generic at http://localhost:8000"
104 putStrLn "Starting cookbook-generic at http://localhost:8000"
104 run 8000 app
105 run 8000 app
106+ -- see this cookbook below for custom-monad explanation
107+ ("run-custom-monad":_) -> do
108+ putStrLn "Starting cookbook-generic with a custom monad at http://localhost:8000"
109+ run 8000 (appMyMonad AppCustomState)
105 _ -> putStrLn "To run, pass 'run' argument: cabal new-run cookbook-generic run"
110 _ -> putStrLn "To run, pass 'run' argument: cabal new-run cookbook-generic run"
106```
111```
112+
113+## Using generics together with a custom monad
114+
115+If your app uses a custom monad, here's how you can combine it with
116+generics.
117+
118+```haskell
119+data AppCustomState =
120+ AppCustomState
121+
122+type AppM = ReaderT AppCustomState Handler
123+
124+apiMyMonad :: Proxy (ToServantApi Routes)
125+apiMyMonad = genericApi (Proxy :: Proxy Routes)
126+
127+getRouteMyMonad :: Int -> AppM String
128+getRouteMyMonad = return . show
129+
130+putRouteMyMonad :: Int -> AppM Bool
131+putRouteMyMonad = return . odd
132+
133+recordMyMonad :: Routes (AsServerT AppM)
134+recordMyMonad = Routes {_get = getRouteMyMonad, _put = putRouteMyMonad}
135+
136+-- natural transformation
137+nt :: AppCustomState -> AppM a -> Handler a
138+nt s x = runReaderT x s
139+
140+appMyMonad :: AppCustomState -> Application
141+appMyMonad state = genericServeT (nt state) recordMyMonad
servant-server/src/Servant/Server/Generic.hs+42
@@ -2,6 +2,7 @@
2{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE DataKinds #-}
3{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE FlexibleContexts #-}
4{-# LANGUAGE KindSignatures #-}
4{-# LANGUAGE KindSignatures #-}
5+{-# LANGUAGE RankNTypes #-}
5{-# LANGUAGE ScopedTypeVariables #-}
6{-# LANGUAGE ScopedTypeVariables #-}
6{-# LANGUAGE TypeFamilies #-}
7{-# LANGUAGE TypeFamilies #-}
7{-# LANGUAGE TypeOperators #-}
8{-# LANGUAGE TypeOperators #-}
@@ -11,6 +12,8 @@ module Servant.Server.Generic (
11 AsServerT,
12 AsServerT,
12 AsServer,
13 AsServer,
13 genericServe,
14 genericServe,
15+ genericServeT,
16+ genericServeTWithContext,
14 genericServer,
17 genericServer,
15 genericServerT,
18 genericServerT,
16 ) where
19 ) where
@@ -38,6 +41,45 @@ genericServe
38 => routes AsServer -> Application
41 => routes AsServer -> Application
39genericServe = serve (Proxy :: Proxy (ToServantApi routes)) . genericServer
42genericServe = serve (Proxy :: Proxy (ToServantApi routes)) . genericServer
40
43
44+-- | Transform a record of routes with custom monad into a WAI 'Application',
45+-- by providing a transformation to bring each handler back in the 'Handler'
46+-- monad.
47+genericServeT
48+ :: forall (routes :: * -> *) (m :: * -> *).
49+ ( GenericServant routes (AsServerT m)
50+ , GenericServant routes AsApi
51+ , HasServer (ToServantApi routes) '[]
52+ , ServerT (ToServantApi routes) m ~ ToServant routes (AsServerT m)
53+ )
54+ => (forall a. m a -> Handler a) -- ^ 'hoistServer' argument to come back to 'Handler'
55+ -> routes (AsServerT m) -- ^ your record full of request handlers
56+ -> Application
57+genericServeT f server = serve p $ hoistServer p f (genericServerT server)
58+ where
59+ p = genericApi (Proxy :: Proxy routes)
60+
61+-- | Transform a record of routes with custom monad into a WAI 'Application',
62+-- while using the given 'Context' to serve the application (contexts are typically
63+-- used by auth-related combinators in servant, e.g to hold auth checks) and the given
64+-- transformation to map all the handlers back to the 'Handler' monad.
65+genericServeTWithContext
66+ :: forall (routes :: * -> *) (m :: * -> *) (ctx :: [*]).
67+ ( GenericServant routes (AsServerT m)
68+ , GenericServant routes AsApi
69+ , HasServer (ToServantApi routes) ctx
70+ , ServerT (ToServantApi routes) m ~ ToServant routes (AsServerT m)
71+ )
72+ => (forall a. m a -> Handler a) -- ^ 'hoistServer' argument to come back to 'Handler'
73+ -> routes (AsServerT m) -- ^ your record full of request handlers
74+ -> Context ctx -- ^ the 'Context' to serve the application with
75+ -> Application
76+genericServeTWithContext f server ctx =
77+ serveWithContext p ctx $
78+ hoistServerWithContext p pctx f (genericServerT server)
79+ where
80+ p = genericApi (Proxy :: Proxy routes)
81+ pctx = Proxy :: Proxy ctx
82+
41-- | Transform record of endpoints into a 'Server'.
83-- | Transform record of endpoints into a 'Server'.
42genericServer
84genericServer
43 :: GenericServant routes AsServer
85 :: GenericServant routes AsServer