git.iko.soy/typeable/servant
on master help sign in
genericServeT and docs on using a custom monad with generics
commitc1e15ef4c335c733ad019dd1c5fd148b2133bda7 authorKostiantyn Rybnikov <k-bx@k-bx.com> dateSat 20 Oct 2018, 20:48 (8 years ago) parent56c2f4e
2 files changed+84−1
compare with master
unifiedsplit
doc/cookbook/generic/Generic.lhs+42−1 servant-server/src/Servant/Server/Generic.hs+42
doc/cookbook/generic/Generic.lhs+42−1
@@ -5,7 +5,7 @@
55{-# LANGUAGE DeriveGeneric #-}
66{-# LANGUAGE RankNTypes #-}
77{-# LANGUAGE TypeOperators #-}
8−module Main (main, api, getLink, routesLinks, cliGet) where
8+module Main (main, api, getLink, routesLinks, cliGet, mainMyMonad) where
99
1010import Control.Exception (throwIO)
1111import Data.Proxy (Proxy (..))
@@ -104,3 +104,44 @@ main = do
104104 run 8000 app
105105 _ -> putStrLn "To run, pass 'run' argument: cabal new-run cookbook-generic run"
106106```
107+
108+## Using generics together with a custom monad
109+
110+If your app uses a custom monad, here's how you can combine it with
111+generics.
112+
113+```haskell
114+data AppCustomState =
115+ AppCustomState
116+
117+type AppM = ReaderT AppCustomState Handler
118+
119+apiMyMonad :: Proxy (ToServantApi Routes)
120+apiMyMonad = genericApi (Proxy :: Proxy Routes)
121+
122+getRouteMyMonad :: Int -> AppM String
123+getRouteMyMonad = return . show
124+
125+putRouteMyMonad :: Int -> AppM Bool
126+putRouteMyMonad = return . odd
127+
128+recordMyMonad :: Routes (AsServerT AppM)
129+recordMyMonad = Routes {_get = getRouteMyMonad, _put = putRouteMyMonad}
130+
131+-- natural transformation
132+nt :: AppCustomState -> AppM a -> Handler a
133+nt s x = runReaderT x s
134+
135+appMyMonad :: AppCustomState -> Application
136+appMyMonad state = genericServeT (nt state) recordMyMonad
137+
138+mainMyMonad :: IO ()
139+mainMyMonad = do
140+ args <- getArgs
141+ case args of
142+ ("run":_) -> do
143+ putStrLn "Starting cookbook-generic at http://localhost:8000"
144+ run 8000 (appMyMonad AppCustomState)
145+ _ ->
146+ putStrLn "To run, pass 'run' argument: cabal new-run cookbook-generic run"
147+```
servant-server/src/Servant/Server/Generic.hs+42
@@ -2,6 +2,7 @@
22{-# LANGUAGE DataKinds #-}
33{-# LANGUAGE FlexibleContexts #-}
44{-# LANGUAGE KindSignatures #-}
5+{-# LANGUAGE RankNTypes #-}
56{-# LANGUAGE ScopedTypeVariables #-}
67{-# LANGUAGE TypeFamilies #-}
78{-# LANGUAGE TypeOperators #-}
@@ -11,6 +12,8 @@ module Servant.Server.Generic (
1112 AsServerT,
1213 AsServer,
1314 genericServe,
15+ genericServeT,
16+ genericServeT',
1417 genericServer,
1518 genericServerT,
1619 ) where
@@ -38,6 +41,45 @@ genericServe
3841 => routes AsServer -> Application
3942genericServe = serve (Proxy :: Proxy (ToServantApi routes)) . genericServer
4043
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+genericServeT'
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+genericServeT' 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+
4183-- | Transform record of endpoints into a 'Server'.
4284genericServer
4385 :: GenericServant routes AsServer