Merge pull request #882 from ilya-murzinov/docs-another-monad

Added new cookbook recipe for using custom monad

cabal.project

@@ -7,6 +7,7 @@ packages: servant/
   doc/tutorial/
   doc/cookbook/basic-auth/
   doc/cookbook/db-postgres-pool/
+  doc/cookbook/using-custom-monad/
   doc/cookbook/db-sqlite-simple/
   doc/cookbook/jwt-and-basic-auth/
   doc/cookbook/file-upload/

doc/cookbook/cabal.project

@@ -2,6 +2,11 @@ packages:
   basic-auth/
   db-sqlite-simple/
   db-postgres-pool/
+  using-custom-monad/
+  jwt-and-basic-auth/
+  file-upload/
+  structuring-apis/
+  https/
   ../../servant
   ../../servant-server
   ../../servant-client-core

doc/cookbook/index.rst

@@ -21,6 +21,7 @@ you name it!
   https/Https.lhs
   db-sqlite-simple/DBConnection.lhs
   db-postgres-pool/PostgresPool.lhs
+  using-custom-monad/UsingCustomMonad.lhs
   basic-auth/BasicAuth.lhs
   jwt-and-basic-auth/JWTAndBasicAuth.lhs
   file-upload/FileUpload.lhs

doc/cookbook/using-custom-monad/UsingCustomMonad.lhs

@@ -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"]
+```

doc/cookbook/using-custom-monad/using-custom-monad.cabal

@@ -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