Go to Qiita Advent Calendar 2024 Top
LoginSignup
4
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 3 years have passed since last update.

@sand(sand mypress)

【Servant】(10) SQLite

Last updated at Posted at 2020-03-01

【Servant】(1) Wai - Qiita
【Servant】(2) Servantチュートリアル - Qiita
【Servant】(3) エンドポイントを増やす - Qiita
【Servant】(4) URLパラメータをハンドラの引数とする - Qiita
【Servant】(5) JSON - Qiita
【Servant】(6) HTML - Qiita
【Servant】(7) Post Data - Qiita
【Servant】(8) Another Monad - Qiita
【Servant】(9) Handlerモナド - Qiita
【Servant】(10) SQLite - Qiita
【Servant】(11) Servant-Client - Qiita
【Servant】(12) Basic 認証 - Qiita

前回はHandlerで、IOモナドが使えることをみました。今回はIOモナドとしてDB(SQLite)を使ってみます。以下のドキュメントを利用します。

SQLite database - Servant documentation

またWindowsへのSQLiteのインストールは以下の記事を参考にさせていただきました。
SQLite 3.27.1 をインストールして使ってみる（Windows 上）

1. 全ソース

まず全ソースを掲載し、後に説明を入れます。

Sqlit.hs
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}

module Sqlite
    ( runServant
    ) where

import Control.Monad.IO.Class
import Database.SQLite.Simple
import Network.Wai.Handler.Warp
import Servant


type Message = String

type API = "message" :> ReqBody '[JSON] Message :> Post '[JSON] NoContent
      :<|> "message" :> Get '[JSON] [Message]

api :: Proxy API
api = Proxy



initDB :: FilePath -> IO ()
initDB dbfile = withConnection dbfile $ \conn ->
  execute_ conn
    "CREATE TABLE IF NOT EXISTS messages (msg text not null)"


server :: FilePath -> Server API
server dbfile = postMessage :<|> getMessages

  where postMessage :: Message -> Handler NoContent
        postMessage msg = do
          liftIO . withConnection dbfile $ \conn ->
            execute conn
                    "INSERT INTO messages VALUES (?)"
                    (Only msg)
          return NoContent

        getMessages :: Handler [Message]
        getMessages = fmap (map fromOnly) . liftIO $
         withConnection dbfile $ \conn ->
            query_ conn "SELECT msg FROM messages"

runServant :: IO ()
runServant = do
    let dbname="mydb"
    initDB dbname
    run 4000 (serve api $ server dbname)

メイン

Main.hs
module Main where

import qualified HtmlContent       as T1
import qualified PostData          as T2
import qualified CustomPostData    as T3
import qualified AnotherMonad      as T4
import qualified Sqlite            as T5

main :: IO ()
main = T5.runServant

使用するパッケージ

package.yaml
dependencies:
- base >= 4.7 && < 5
- servant
- servant-server
- aeson
- time
- wai
- warp
- http-media
- bytestring
- mtl
- sqlite-simple

2. 説明

FilePathは以下のようにStringで定義してあります。

FilePath
type FilePath = String

SQLiteへの接続はsqlite-simpleを使います。
sqlite-simple: Mid-Level SQLite client library

import Database.SQLite.Simple

sqlite-simpleは使いやすくて、simpleシリーズはpostgresql-simpleなど他のDBへの横展開もされており、使い慣れておくと便利です。

mainでサーバ起動時に以下の関数でテーブル初期化を行っています。messages は1個のtextフィールドで構成される簡単なものです。

initDB
initDB :: FilePath -> IO ()
initDB dbfile = withConnection dbfile $ \conn ->
  execute_ conn
    "CREATE TABLE IF NOT EXISTS messages (msg text not null)"

APIはPOSTとGETを用意します。

API
type API = "message" :> ReqBody '[JSON] Message :> Post '[JSON] NoContent
      :<|> "message" :> Get '[JSON] [Message]

POSTとGETに対応するHandlerは以下のようになります。それぞれテーブルへのINSERTとSELECTを実行する役割になります。NoContentはcontent-bodyのないレスポンスです。

server
server :: FilePath -> Server API
server dbfile = postMessage :<|> getMessages

  where postMessage :: Message -> Handler NoContent
        postMessage msg = do
          liftIO . withConnection dbfile $ \conn ->
            execute conn
                    "INSERT INTO messages VALUES (?)"
                    (Only msg)
          return NoContent

        getMessages :: Handler [Message]
        getMessages = fmap (map fromOnly) . liftIO $
         withConnection dbfile $ \conn ->
            query_ conn "SELECT msg FROM messages"

値ConstructorのOnlyは以下のように定義されます。使われ方はIdentity型に等しいですが、意味するところは1-tuple型の表現です。（Haskellには1-tupleが存在しないことを思い出してください。）

Only
newtype Only a = Only { fromOnly :: a }

sqlite-simpleでは「Haskell Data <--> sqlite table」の変換に、ToRowとFromRowクラスを用います。それぞれのインスタンスになるためには、toRow関数とfromRow関数の提供が要求されます。

getMessagesを見ます。以下の定義により、(Only a)がFromRow のインスタンスとなり、queryで得られたrowのfieldから (Only a)型のdataが得られます。最終的にはfromOnlyで値ConstructorのOnlyを除き、a型の値のみを取り出し提案す。

Only
instance (FromField a) => FromRow (Only a) where
    fromRow = Only <$> field

postMessage をみます。(Only a)はToRowのインスタンスでもあります。値として(Only msg)をinsertしています。

3. 実行結果

まずPOSTで「Hello」というmessageを挿入します。

$ curl -v -H "Content-Type:application/json" -d "\"Hello\"" http://127.0.0.1:4000/message
*   Trying 127.0.0.1:4000...
* TCP_NODELAY set
  % Total    % Received % Xferd  Average Speed   Time    Time     Time  Current
                                 Dload  Upload   Total   Spent    Left  Speed
  0     0    0     0    0     0      0      0 --:--:-- --:--:-- --:--:--     0* Connected to 127.0.0.1 (127.0.0.1) port 4000 (#0)
> POST /message HTTP/1.1
> Host: 127.0.0.1:4000
> User-Agent: curl/7.67.0
> Accept: */*
> Content-Type:application/json
> Content-Length: 7
>
} [7 bytes data]
* upload completely sent off: 7 out of 7 bytes
* Mark bundle as not supporting multiuse
< HTTP/1.1 200 OK
< Transfer-Encoding: chunked
< Date: Sun, 01 Mar 2020 00:19:43 GMT
< Server: Warp/3.3.5
< Content-Type: application/json;charset=utf-8
<

次にPOSTで「World」というmessageを挿入します。

$ curl -v -H "Content-Type:application/json" -d "\"World\"" http://127.0.0.1:4000/message
*   Trying 127.0.0.1:4000...
* TCP_NODELAY set
  % Total    % Received % Xferd  Average Speed   Time    Time     Time  Current
                                 Dload  Upload   Total   Spent    Left  Speed
  0     0    0     0    0     0      0      0 --:--:-- --:--:-- --:--:--     0* Connected to 127.0.0.1 (127.0.0.1) port 4000 (#0)
> POST /message HTTP/1.1
> Host: 127.0.0.1:4000
> User-Agent: curl/7.67.0
> Accept: */*
> Content-Type:application/json
> Content-Length: 7
>
} [7 bytes data]
* upload completely sent off: 7 out of 7 bytes
* Mark bundle as not supporting multiuse
< HTTP/1.1 200 OK
< Transfer-Encoding: chunked
< Date: Sun, 01 Mar 2020 00:20:54 GMT
< Server: Warp/3.3.5
< Content-Type: application/json;charset=utf-8
<
{ [5 bytes data]
100     7    0     0  100     7      0     61 --:--:-- --:--:-- --:--:--    61

現在のSQLite DBの中身を確認します。

$ sqlite3 mydb
SQLite version 3.31.1 2020-01-27 19:55:54
Enter ".help" for usage hints.
sqlite> .tables
messages
sqlite> select * from messages;
Hello
World

ちゃんと「Hello」と「World」が入っていますので、OKです。

最後にGETでDBにアクセスしてみます。

$ curl -v http://127.0.0.1:4000/message                                         *   Trying 127.0.0.1:4000...
* TCP_NODELAY set
  % Total    % Received % Xferd  Average Speed   Time    Time     Time  Current
                                 Dload  Upload   Total   Spent    Left  Speed
  0     0    0     0    0     0      0      0 --:--:-- --:--:-- --:--:--     0* Connected to 127.0.0.1 (127.0.0.1) port 4000 (#0)
> GET /message HTTP/1.1
> Host: 127.0.0.1:4000
> User-Agent: curl/7.67.0
> Accept: */*
>
* Mark bundle as not supporting multiuse
< HTTP/1.1 200 OK
< Transfer-Encoding: chunked
< Date: Sun, 01 Mar 2020 00:21:29 GMT
< Server: Warp/3.3.5
< Content-Type: application/json;charset=utf-8
<
{ [30 bytes data]
100    17    0    17    0     0   8500      0 --:--:-- --:--:-- --:--:-- 17000
["Hello","World"]   ### 取り出した値

ちゃんと["Hello","World"]と表示されました。

今回は以上です

4
1
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
Sign upLogin
4
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?