Added new cookbook recipe for using custom monad
This commit is contained in:
parent
68bc41b41d
commit
f1911f390d
5 changed files with 153 additions and 0 deletions
|
@ -7,6 +7,7 @@ packages: servant/
|
||||||
doc/tutorial/
|
doc/tutorial/
|
||||||
doc/cookbook/basic-auth/
|
doc/cookbook/basic-auth/
|
||||||
doc/cookbook/db-postgres-pool/
|
doc/cookbook/db-postgres-pool/
|
||||||
|
doc/cookbook/using-custom-monad/
|
||||||
doc/cookbook/db-sqlite-simple/
|
doc/cookbook/db-sqlite-simple/
|
||||||
doc/cookbook/jwt-and-basic-auth/
|
doc/cookbook/jwt-and-basic-auth/
|
||||||
doc/cookbook/file-upload/
|
doc/cookbook/file-upload/
|
||||||
|
|
|
@ -2,6 +2,11 @@ packages:
|
||||||
basic-auth/
|
basic-auth/
|
||||||
db-sqlite-simple/
|
db-sqlite-simple/
|
||||||
db-postgres-pool/
|
db-postgres-pool/
|
||||||
|
using-custom-monad/
|
||||||
|
jwt-and-basic-auth/
|
||||||
|
file-upload/
|
||||||
|
structuring-apis/
|
||||||
|
https/
|
||||||
../../servant
|
../../servant
|
||||||
../../servant-server
|
../../servant-server
|
||||||
../../servant-client-core
|
../../servant-client-core
|
||||||
|
|
|
@ -21,6 +21,7 @@ you name it!
|
||||||
https/Https.lhs
|
https/Https.lhs
|
||||||
db-sqlite-simple/DBConnection.lhs
|
db-sqlite-simple/DBConnection.lhs
|
||||||
db-postgres-pool/PostgresPool.lhs
|
db-postgres-pool/PostgresPool.lhs
|
||||||
|
using-custom-monad/UsingCustomMonad.lhs
|
||||||
basic-auth/BasicAuth.lhs
|
basic-auth/BasicAuth.lhs
|
||||||
jwt-and-basic-auth/JWTAndBasicAuth.lhs
|
jwt-and-basic-auth/JWTAndBasicAuth.lhs
|
||||||
file-upload/FileUpload.lhs
|
file-upload/FileUpload.lhs
|
||||||
|
|
117
doc/cookbook/using-custom-monad/UsingCustomMonad.lhs
Normal file
117
doc/cookbook/using-custom-monad/UsingCustomMonad.lhs
Normal file
|
@ -0,0 +1,117 @@
|
||||||
|
# Using a custom monad
|
||||||
|
|
||||||
|
In this section we will create and API for a book shelf without any backing DB storage.
|
||||||
|
We will keep state in memory and share it between requests using `Reader` monad and `STM`.
|
||||||
|
|
||||||
|
We start with a pretty standard set of imports and definition of the model:
|
||||||
|
|
||||||
|
``` haskell
|
||||||
|
{-# LANGUAGE DataKinds #-}
|
||||||
|
{-# LANGUAGE DeriveGeneric #-}
|
||||||
|
{-# LANGUAGE TypeOperators #-}
|
||||||
|
|
||||||
|
import Control.Concurrent (forkIO, killThread)
|
||||||
|
import Control.Concurrent.STM.TVar (TVar, newTVar, readTVar,
|
||||||
|
writeTVar)
|
||||||
|
import Control.Exception (bracket)
|
||||||
|
import Control.Monad.IO.Class (liftIO)
|
||||||
|
import Control.Monad.STM (atomically)
|
||||||
|
import Control.Monad.Trans.Reader (ReaderT, ask, runReaderT)
|
||||||
|
import Data.Aeson (FromJSON, ToJSON)
|
||||||
|
import GHC.Generics (Generic)
|
||||||
|
import Network.HTTP.Client (defaultManagerSettings,
|
||||||
|
newManager)
|
||||||
|
import Network.Wai.Handler.Warp (run)
|
||||||
|
|
||||||
|
import Servant
|
||||||
|
import Servant.Client
|
||||||
|
|
||||||
|
newtype Book = Book String deriving (Show, Generic)
|
||||||
|
instance ToJSON Book
|
||||||
|
instance FromJSON Book
|
||||||
|
```
|
||||||
|
|
||||||
|
Now, let's define the API for book storage.
|
||||||
|
For the sake of simplicity we'll only have methods for getting all books and adding a new one.
|
||||||
|
|
||||||
|
``` haskell
|
||||||
|
type GetBooks = Get '[JSON] [Book]
|
||||||
|
type AddBook = ReqBody '[JSON] Book :> PostCreated '[JSON] Book
|
||||||
|
type BooksAPI = "books" :> (GetBooks :<|> AddBook)
|
||||||
|
|
||||||
|
api :: Proxy BooksAPI
|
||||||
|
api = Proxy
|
||||||
|
```
|
||||||
|
|
||||||
|
Next, we define the state and the monad to run our handlers
|
||||||
|
|
||||||
|
``` haskell
|
||||||
|
data State = State
|
||||||
|
{ books :: TVar [Book]
|
||||||
|
}
|
||||||
|
|
||||||
|
type AppM = ReaderT State Handler
|
||||||
|
```
|
||||||
|
|
||||||
|
Note that we can't use `State` monad here, because state will not be shared between requests.
|
||||||
|
|
||||||
|
We can now define handlers in terms of `AppM`...
|
||||||
|
|
||||||
|
```haskell
|
||||||
|
server :: ServerT BooksAPI AppM
|
||||||
|
server = getBooks :<|> addBook
|
||||||
|
where getBooks :: AppM [Book]
|
||||||
|
getBooks = do
|
||||||
|
State{books = p} <- ask
|
||||||
|
liftIO $ atomically $ readTVar p
|
||||||
|
|
||||||
|
addBook :: Book -> AppM Book
|
||||||
|
addBook book = do
|
||||||
|
State{books = p} <- ask
|
||||||
|
liftIO $ atomically $ readTVar p >>= writeTVar p . (book :)
|
||||||
|
return book
|
||||||
|
|
||||||
|
```
|
||||||
|
|
||||||
|
...and transform `AppM` to `Handler` by simply using `runReaderT`
|
||||||
|
|
||||||
|
``` haskell
|
||||||
|
nt :: State -> AppM a -> Handler a
|
||||||
|
nt s x = runReaderT x s
|
||||||
|
|
||||||
|
app :: State -> Application
|
||||||
|
app s = serve api $ hoistServer api (nt s) server
|
||||||
|
```
|
||||||
|
|
||||||
|
Finally, we end up with the following program
|
||||||
|
|
||||||
|
``` haskell
|
||||||
|
main :: IO ()
|
||||||
|
main = do
|
||||||
|
let port = 8080
|
||||||
|
mgr <- newManager defaultManagerSettings
|
||||||
|
initialBooks <- atomically $ newTVar []
|
||||||
|
let runApp = run port $ app $ State initialBooks
|
||||||
|
bracket (forkIO runApp) killThread $ \_ -> do
|
||||||
|
let getBooksClient :<|> addBookClient = client api
|
||||||
|
let printBooks = getBooksClient >>= liftIO . print
|
||||||
|
_ <- flip runClientM (ClientEnv mgr (BaseUrl Http "localhost" port "")) $ do
|
||||||
|
_ <- printBooks
|
||||||
|
_ <- addBookClient $ Book "Harry Potter and the Order of the Phoenix"
|
||||||
|
_ <- printBooks
|
||||||
|
_ <- addBookClient $ Book "To Kill a Mockingbird"
|
||||||
|
_ <- printBooks
|
||||||
|
_ <- addBookClient $ Book "The Picture of Dorian Gray"
|
||||||
|
printBooks
|
||||||
|
return ()
|
||||||
|
```
|
||||||
|
|
||||||
|
When run, it outputs the following:
|
||||||
|
|
||||||
|
```
|
||||||
|
Running cookbook-using-custom-monad...
|
||||||
|
[]
|
||||||
|
[Book "Harry Potter and the Order of the Phoenix"]
|
||||||
|
[Book "To Kill a Mockingbird",Book "Harry Potter and the Order of the Phoenix"]
|
||||||
|
[Book "The Picture of Dorian Gray",Book "To Kill a Mockingbird",Book "Harry Potter and the Order of the Phoenix"]
|
||||||
|
```
|
29
doc/cookbook/using-custom-monad/using-custom-monad.cabal
Normal file
29
doc/cookbook/using-custom-monad/using-custom-monad.cabal
Normal file
|
@ -0,0 +1,29 @@
|
||||||
|
name: cookbook-using-custom-monad
|
||||||
|
version: 0.1
|
||||||
|
synopsis: Using custom monad to pass a state between handlers
|
||||||
|
homepage: http://haskell-servant.readthedocs.org/
|
||||||
|
license: BSD3
|
||||||
|
license-file: ../../../servant/LICENSE
|
||||||
|
author: Servant Contributors
|
||||||
|
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||||
|
build-type: Simple
|
||||||
|
cabal-version: >=1.10
|
||||||
|
|
||||||
|
executable cookbook-using-custom-monad
|
||||||
|
if impl(ghc < 7.10.1)
|
||||||
|
buildable: False
|
||||||
|
main-is: UsingCustomMonad.lhs
|
||||||
|
build-depends: base == 4.*
|
||||||
|
, aeson >= 1.2
|
||||||
|
, servant
|
||||||
|
, servant-client
|
||||||
|
, servant-server
|
||||||
|
, warp >= 3.2
|
||||||
|
, wai >= 3.2
|
||||||
|
, http-client >= 0.5
|
||||||
|
, markdown-unlit >= 0.4
|
||||||
|
, stm >= 2.4
|
||||||
|
, transformers >= 0.4
|
||||||
|
default-language: Haskell2010
|
||||||
|
ghc-options: -Wall -pgmL markdown-unlit
|
||||||
|
build-tool-depends: markdown-unlit:markdown-unlit
|
Loading…
Reference in a new issue