@@ -0,0 +1,117 @@
3+In this section we will create and API for a book shelf without any backing DB storage.
4+We will keep state in memory and share it between requests using `Reader` monad and `STM`.
6+We start with a pretty standard set of imports and definition of the model:
9+{-# LANGUAGE DataKinds #-}
10+{-# LANGUAGE DeriveGeneric #-}
11+{-# LANGUAGE TypeOperators #-}
13+import Control.Concurrent (forkIO, killThread)
14+import Control.Concurrent.STM.TVar (TVar, newTVar, readTVar,
16+import Control.Exception (bracket)
17+import Control.Monad.IO.Class (liftIO)
18+import Control.Monad.STM (atomically)
19+import Control.Monad.Trans.Reader (ReaderT, ask, runReaderT)
20+import Data.Aeson (FromJSON, ToJSON)
21+import GHC.Generics (Generic)
22+import Network.HTTP.Client (defaultManagerSettings,
24+import Network.Wai.Handler.Warp (run)
29+newtype Book = Book String deriving (Show, Generic)
31+instance FromJSON Book
34+Now, let's define the API for book storage.
35+For the sake of simplicity we'll only have methods for getting all books and adding a new one.
38+type GetBooks = Get '[JSON] [Book]
39+type AddBook = ReqBody '[JSON] Book :> PostCreated '[JSON] Book
40+type BooksAPI = "books" :> (GetBooks :<|> AddBook)
46+Next, we define the state and the monad to run our handlers
50+ { books :: TVar [Book]
53+type AppM = ReaderT State Handler
56+Note that we can't use `State` monad here, because state will not be shared between requests.
58+We can now define handlers in terms of `AppM`...
61+server :: ServerT BooksAPI AppM
62+server = getBooks :<|> addBook
63+ where getBooks :: AppM [Book]
65+ State{books = p} <- ask
66+ liftIO $ atomically $ readTVar p
68+ addBook :: Book -> AppM Book
70+ State{books = p} <- ask
71+ liftIO $ atomically $ readTVar p >>= writeTVar p . (book :)
76+...and transform `AppM` to `Handler` by simply using `runReaderT`
79+nt :: State -> AppM a -> Handler a
80+nt s x = runReaderT x s
82+app :: State -> Application
83+app s = serve api $ hoistServer api (nt s) server
86+Finally, we end up with the following program
92+ mgr <- newManager defaultManagerSettings
93+ initialBooks <- atomically $ newTVar []
94+ let runApp = run port $ app $ State initialBooks
95+ bracket (forkIO runApp) killThread $ \_ -> do
96+ let getBooksClient :<|> addBookClient = client api
97+ let printBooks = getBooksClient >>= liftIO . print
98+ _ <- flip runClientM (ClientEnv mgr (BaseUrl Http "localhost" port "")) $ do
100+ _ <- addBookClient $ Book "Harry Potter and the Order of the Phoenix"
102+ _ <- addBookClient $ Book "To Kill a Mockingbird"
104+ _ <- addBookClient $ Book "The Picture of Dorian Gray"
109+When run, it outputs the following:
112+Running cookbook-using-custom-monad...
114+[Book "Harry Potter and the Order of the Phoenix"]
115+[Book "To Kill a Mockingbird",Book "Harry Potter and the Order of the Phoenix"]
116+[Book "The Picture of Dorian Gray",Book "To Kill a Mockingbird",Book "Harry Potter and the Order of the Phoenix"]