Rename one function, run custom monad code from main

This commit is contained in:
Kostiantyn Rybnikov 2018-10-22 14:09:45 +03:00
parent c1e15ef4c3
commit 5620d2d781
2 changed files with 8 additions and 15 deletions

View file

@ -5,7 +5,7 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeOperators #-}
module Main (main, api, getLink, routesLinks, cliGet, mainMyMonad) where
module Main (main, api, getLink, routesLinks, cliGet) where
import Control.Exception (throwIO)
import Data.Proxy (Proxy (..))
@ -102,6 +102,10 @@ main = do
("run":_) -> do
putStrLn "Starting cookbook-generic at http://localhost:8000"
run 8000 app
-- see this cookbook below for custom-monad explanation
("run-custom-monad":_) -> do
putStrLn "Starting cookbook-generic with a custom monad at http://localhost:8000"
run 8000 (appMyMonad AppCustomState)
_ -> putStrLn "To run, pass 'run' argument: cabal new-run cookbook-generic run"
```
@ -134,14 +138,3 @@ nt s x = runReaderT x s
appMyMonad :: AppCustomState -> Application
appMyMonad state = genericServeT (nt state) recordMyMonad
mainMyMonad :: IO ()
mainMyMonad = do
args <- getArgs
case args of
("run":_) -> do
putStrLn "Starting cookbook-generic at http://localhost:8000"
run 8000 (appMyMonad AppCustomState)
_ ->
putStrLn "To run, pass 'run' argument: cabal new-run cookbook-generic run"
```

View file

@ -13,7 +13,7 @@ module Servant.Server.Generic (
AsServer,
genericServe,
genericServeT,
genericServeT',
genericServeTWithContext,
genericServer,
genericServerT,
) where
@ -62,7 +62,7 @@ genericServeT f server = serve p $ hoistServer p f (genericServerT server)
-- while using the given 'Context' to serve the application (contexts are typically
-- used by auth-related combinators in servant, e.g to hold auth checks) and the given
-- transformation to map all the handlers back to the 'Handler' monad.
genericServeT'
genericServeTWithContext
:: forall (routes :: * -> *) (m :: * -> *) (ctx :: [*]).
( GenericServant routes (AsServerT m)
, GenericServant routes AsApi
@ -73,7 +73,7 @@ genericServeT'
-> routes (AsServerT m) -- ^ your record full of request handlers
-> Context ctx -- ^ the 'Context' to serve the application with
-> Application
genericServeT' f server ctx =
genericServeTWithContext f server ctx =
serveWithContext p ctx $
hoistServerWithContext p pctx f (genericServerT server)
where