@@ -0,0 +1,117 @@
1+# Using a custom monad
2+
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`.
5+
6+We start with a pretty standard set of imports and definition of the model:
7+
8+``` haskell
9+{-# LANGUAGE DataKinds #-}
10+{-# LANGUAGE DeriveGeneric #-}
11+{-# LANGUAGE TypeOperators #-}
12+
13+import Control.Concurrent (forkIO, killThread)
14+import Control.Concurrent.STM.TVar (TVar, newTVar, readTVar,
15+ writeTVar)
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,
23+ newManager)
24+import Network.Wai.Handler.Warp (run)
25+
26+import Servant
27+import Servant.Client
28+
29+newtype Book = Book String deriving (Show, Generic)
30+instance ToJSON Book
31+instance FromJSON Book
32+```
33+
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.
36+
37+``` haskell
38+type GetBooks = Get '[JSON] [Book]
39+type AddBook = ReqBody '[JSON] Book :> PostCreated '[JSON] Book
40+type BooksAPI = "books" :> (GetBooks :<|> AddBook)
41+
42+api :: Proxy BooksAPI
43+api = Proxy
44+```
45+
46+Next, we define the state and the monad to run our handlers
47+
48+``` haskell
49+data State = State
50+ { books :: TVar [Book]
51+ }
52+
53+type AppM = ReaderT State Handler
54+```
55+
56+Note that we can't use `State` monad here, because state will not be shared between requests.
57+
58+We can now define handlers in terms of `AppM`...
59+
60+```haskell
61+server :: ServerT BooksAPI AppM
62+server = getBooks :<|> addBook
63+ where getBooks :: AppM [Book]
64+ getBooks = do
65+ State{books = p} <- ask
66+ liftIO $ atomically $ readTVar p
67+
68+ addBook :: Book -> AppM Book
69+ addBook book = do
70+ State{books = p} <- ask
71+ liftIO $ atomically $ readTVar p >>= writeTVar p . (book :)
72+ return book
73+
74+```
75+
76+...and transform `AppM` to `Handler` by simply using `runReaderT`
77+
78+``` haskell
79+nt :: State -> AppM a -> Handler a
80+nt s x = runReaderT x s
81+
82+app :: State -> Application
83+app s = serve api $ hoistServer api (nt s) server
84+```
85+
86+Finally, we end up with the following program
87+
88+``` haskell
89+main :: IO ()
90+main = do
91+ let port = 8080
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
99+ _ <- printBooks
100+ _ <- addBookClient $ Book "Harry Potter and the Order of the Phoenix"
101+ _ <- printBooks
102+ _ <- addBookClient $ Book "To Kill a Mockingbird"
103+ _ <- printBooks
104+ _ <- addBookClient $ Book "The Picture of Dorian Gray"
105+ printBooks
106+ return ()
107+```
108+
109+When run, it outputs the following:
110+
111+```
112+Running cookbook-using-custom-monad...
113+[]
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"]
117+```