@@ -0,0 +1,99 @@
3+Let's see how we can write a simple web application that uses an
4+[SQLite](https://www.sqlite.org/) database to store simple textual
5+messages. As usual, we start with a little bit of throat clearing.
8+{-# LANGUAGE DataKinds #-}
9+{-# LANGUAGE OverloadedStrings #-}
10+{-# LANGUAGE TypeOperators #-}
11+import Control.Concurrent
12+import Control.Exception (bracket)
13+import Control.Monad.IO.Class
14+import Database.SQLite.Simple
15+import Network.HTTP.Client (newManager, defaultManagerSettings)
16+import Network.Wai.Handler.Warp
21+We will only care about a single type here, the messages. We want to
22+be able to add a new one and retrieve them all, using two different
28+type API = ReqBody '[PlainText] Message :> Post '[JSON] NoContent
29+ :<|> Get '[JSON] [Message]
35+We proceed with a simple function for creating a table
36+for holding our messages if it doesn't already exist.
39+initDB :: FilePath -> IO ()
40+initDB dbfile = withConnection dbfile $ \conn ->
42+ "CREATE TABLE IF NOT EXISTS messages (msg text not null)"
45+Next, our server implementation. It will be parametrised (take as
46+argument) by the name of the file that contains our SQLite database.
47+The handlers are straighforward. One takes care of inserting a new
48+value in the database while the other fetches all messages and returns
49+them. We also provide a function for serving our web app given an
50+SQLite database file, which simply calls servant-server's `serve` function.
53+server :: FilePath -> Server API
54+server dbfile = postMessage :<|> getMessages
56+ where postMessage :: Message -> Handler NoContent
58+ liftIO . withConnection dbfile $ \conn ->
60+ "INSERT INTO messages VALUES (?)"
64+ getMessages :: Handler [Message]
65+ getMessages = fmap (map fromOnly) . liftIO $
66+ withConnection dbfile $ \conn ->
67+ query_ conn "SELECT msg FROM messages"
69+runApp :: FilePath -> IO ()
70+runApp dbfile = run 8080 (serve api $ server dbfile)
73+Let's also derive some clients for our API and use them to
74+insert two messages and retrieve them in `main`.
77+postMsg :: Message -> ClientM NoContent
78+getMsgs :: ClientM [Message]
79+postMsg :<|> getMsgs = client api
83+ -- you could read this from some configuration file,
84+ -- environment variable or somewhere else instead.
85+ let dbfile = "test.db"
87+ mgr <- newManager defaultManagerSettings
88+ bracket (forkIO $ runApp dbfile) killThread $ \_ -> do
89+ ms <- flip runClientM (ClientEnv mgr (BaseUrl Http "localhost" 8080 "")) $ do
96+This program prints `Right ["hello","world"]` the first time it is executed,
97+`Right ["hello","world","hello","world"]` the second time and so on.
99+The entire source for this example is available [here](...).