実践Haskell データベースの使用 追加、読み込み、出力、コマンドライン
入門Haskellプログラミング (Will Kurt(著)、株式会社クイープ(監修、翻訳)、翔泳社)のUNIT7(実践Haskell)、LESSON 41(Haskellでのデータベースの使用)、41.9(練習問題)Q41-2の解答を求めてみる。
コード
{-# LANGUAGE OverloadedStrings #-}
module Main where
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
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;"
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-07" :: String, 0 :: Int)
print "tool added")
promptAndAddTool :: IO ()
promptAndAddTool = do
print "Enter tool name"
name <- getLine
print "Enter tool description"
description <- getLine
addTool name description
performCommand :: String -> IO ()
performCommand command
| command == "tools" = printTools >> main
| command == "addtool" = promptAndAddTool >> main
| command == "quit" = print "bye!"
| otherwise = print "Sorry command not found" >> main
main :: IO ()
main = do
print "Enter a command"
command <- getLine
performCommand command
入出力結果(Terminal, Zsh)
% runghc sample2.hs
"Enter a command"
a
"Sorry command not found"
"Enter a command"
tools
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
"Enter a command"
addtool
"Enter tool name"
test tool name 1
"Enter tool description"
test tool description 1
"tool added"
"Enter a command"
tools
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
4.) test tool name 1
description: test tool description 1
last returned: 2021-10-07
times borrowed: 0
"Enter a command"
quit
"bye!"
%