diff --git a/cabal.project b/cabal.project index dca91894..e4b0ef72 100644 --- a/cabal.project +++ b/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/ diff --git a/doc/cookbook/cabal.project b/doc/cookbook/cabal.project index 1855771a..5a459079 100644 --- a/doc/cookbook/cabal.project +++ b/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 diff --git a/doc/cookbook/index.rst b/doc/cookbook/index.rst index d58e4842..2c5603ba 100644 --- a/doc/cookbook/index.rst +++ b/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 diff --git a/doc/cookbook/using-custom-monad/UsingCustomMonad.lhs b/doc/cookbook/using-custom-monad/UsingCustomMonad.lhs new file mode 100644 index 00000000..6a250685 --- /dev/null +++ b/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"] +``` \ No newline at end of file diff --git a/doc/cookbook/using-custom-monad/using-custom-monad.cabal b/doc/cookbook/using-custom-monad/using-custom-monad.cabal new file mode 100644 index 00000000..867bf671 --- /dev/null +++ b/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