計算機科学のブログ

実践Haskell のデータベースの使用 データの作成、接続、execute関数、ツールの追加

入門Haskellプログラミング (Will Kurt(著)、株式会社クイープ(監修、翻訳)、翔泳社)のUNIT7(実践Haskell)、LESSON 41(Haskellでのデータベースの使用)、41.9(練習問題)Q41-1の解答を求めてみる。

コード

{-# LANGUAGE OverloadedStrings #-}
import Data.Time

import Database.SQLite.Simple

data Tool = Tool { toolId :: Int
                 , name :: String
                 , description :: String
                 , lastReturned :: Day
                 , timesBorrowed :: Int}

instance FromRow Tool where
    fromRow = Tool <$> field <*> field <*> field <*> field <*> field

instance Show Tool where
    show tool = mconcat [ show $ toolId tool , ".) "
                        , name tool
                        , "\n description: "
                        , description tool
                        , "\n last returned: "
                        , show $ lastReturned tool
                        , "\n times borrowed: "
                        , show $ timesBorrowed tool
                        , "\n"]

withConn :: String -> (Connection -> IO ()) -> IO ()
withConn dbName action = do
    conn <- open dbName
    action conn
    close conn

addTool :: String -> String -> IO ()
addTool name description = 
    withConn "tools.db"
             (\conn -> do
                 execute conn
                         (mconcat ["INSERT INTO tools"
                                 , "(name, description, lastReturned, timesBorrowed)"
                                 , "VALUES (?, ?, ?, ?)"])
                         (name, description, "2021-10-06" :: String, 0 :: Int)
                 print "tool added")


printToolQuery :: Query -> IO ()
printToolQuery q = withConn "tools.db" $ \conn -> do
    resp <- query_ conn q :: IO [Tool]
    mapM_ print resp

printTools :: IO ()
printTools = printToolQuery "SELECT * FROM tools;"

main :: IO ()
main = do
    addTool "test name" "test description"
    printTools

入出力結果(Terminal, Zsh)

% runghc sample1.hs 
"tool added"
1.) hammer
 description: hits stuff
 last returned: 2017-01-01
 times borrowed: 0

2.) saw
 description: cuts stuff
 last returned: 2017-01-01
 times borrowed: 0

3.) test name
 description: test description
 last returned: 2021-10-06
 times borrowed: 0


%