2012年12月16日日曜日

HaskellのHDBC.MySQLを利用したDBアクセスをこき下ろしてみた

Haskell力を高めるべく、ちょっと頑張ってテーブルデータへのアクセスを考えてみた
PythonやPHPの連想配列的なアクセス方法が使いやすいんじゃないかとおもい、おもむろに
書いてしまったので、良く言う「グズグズ」のコードですが勘弁してください

テーブル構成と初期データ

データ構成は、userが買い物で消費した金額を保持しているのがcostテーブルです
まぁあまりcostはどうでもいいのですが...

SAMPLEDBを作成
cuomo@karky7 ~ $ mysqladmin -u root create SAMPLEDB
cuomo@karky7 ~ $ mysql -u root SAMPLEDB


テーブル構成、userテーブルと、costテーブルを作成
CREATE TABLE `user` (
  `uid` bigint(20) unsigned NOT NULL AUTO_INCREMENT,
  `name` varchar(256) DEFAULT NULL,
  `age` int(11) DEFAULT NULL,
  `addr` text,
  UNIQUE KEY `uid` (`uid`)
) ENGINE=InnoDB DEFAULT CHARSET=utf8;


CREATE TABLE `cost` (
  `cost_id` bigint(20) unsigned NOT NULL AUTO_INCREMENT,
  `reg_date` datetime NOT NULL,
  `cost` int(11) DEFAULT '0',
  `ref_uid` bigint(20) unsigned NOT NULL,
  PRIMARY KEY (`cost_id`),
  UNIQUE KEY `cost_id` (`cost_id`),
  KEY `fk_uid_cost_id` (`ref_uid`),
  CONSTRAINT `fk_user_cost` FOREIGN KEY (`ref_uid`) REFERENCES `user` (`uid`) ON DELETE CASCADE ON UPDATE CASCADE
) ENGINE=InnoDB DEFAULT CHARSET=utf8;


初期データuserとcostの初期値は以下のとおり、INSERTして、すいません
mysql> select * from user;
+-----+------------+------+---------------------+
| uid | name       | age  | addr                |
+-----+--------+------+-------------------------+
|   1 | ユーザー1   |   23 | 住所11               |
|   2 | ユーザー2   |   42 | 住所22               |
|   3 | ユーザー3   |   35 | 住所33               |
|   4 | ユーザー4   |   40 | 住所44               |
+-----+--------+------+-------------------------+
4 rows in set (0.00 sec)

mysql> select * from cost;
+---------+---------------------+-------+---------+
| cost_id | reg_date            | cost  | ref_uid |
+---------+---------------------+-------+---------+
|       1 | 2012-09-16 10:18:23 |  8900 |       1 |
|       2 | 2012-08-09 08:30:32 | 12000 |       1 |
|       3 | 2012-03-12 13:45:32 |  8700 |       1 |
|       4 | 2012-04-08 18:12:12 |  3400 |       2 |
|       5 | 2012-01-05 14:59:13 | 23000 |       2 |
|       6 | 2011-12-31 23:59:13 |  7800 |       3 |
|       7 | 2012-10-29 13:59:13 |  2300 |       3 |
|       8 | 2012-07-15 09:07:08 |  5600 |       3 |
|       9 | 2012-12-15 10:10:10 |  1000 |       3 |
+---------+---------------------+-------+---------+
9 rows in set (0.00 sec)



ファイル配置

ファイル配置は以下のとおり
.
├── DB
│  └── MySQL_Lib.hs
├── Lib
│  └── TableData.hs
└── Main.hs

ソースコード一式

MySQLコネクタ

ファイル: MySQL_Lib.hs
module DB.MySQL_Lib (
       SqlHash,
       getDBConn,
       getInsertLastId
) where

import Control.Monad
import Database.HDBC
import Database.HDBC.MySQL
import qualified Data.Map as Map

type SqlHash = Map.Map String SqlValue

getDBConn :: IO Connection
getDBConn = connectMySQL defaultMySQLConnectInfo {
                mysqlHost = "127.0.0.1",
                mysqlUser = "karky7",
                mysqlPassword = "",
                mysqlDatabase = "SAMPLEDB",
                mysqlPort = 3306,
                mysqlUnixSocket = ""
            }

getInsertLastId :: Connection -> IO Integer
getInsertLastId con = do
    [lastId:_] <- quickQuery con "SELECT LAST_INSERT_ID()" []
    return $ fromSql lastId


テーブル情報へアクセスする為のライブラリ

ファイル: TableData.hs
module Lib.TableData (
       TableData,
       createUser,
       getUserCost,
       getVal,
       setVal,
       getUser,
       saveUser,
       getCostArray
) where

import System.IO
import Control.Monad
import Database.HDBC
import Database.HDBC.MySQL
import DB.MySQL_Lib
import qualified Data.Map as Map

data TableData = TableData { val :: SqlHash } deriving(Show, Eq)

createUser xs = parse_tableData $ map (\(key, val) -> (key, toSql val)) xs

parse_tableData :: [(String, SqlValue)] -> TableData
parse_tableData tb = TableData { val = Map.fromList tb }

getVal :: String -> TableData -> String
getVal key tb = let list = val tb
                    target = Map.lookup key list
                in case target of
                   Just val -> fromSql val
                   Nothing  -> ""

setVal :: String -> String -> TableData -> IO TableData
setVal key value tb = return (TableData { val = Map.insert key (toSql value) (val tb) })

saveUser :: TableData -> IO Integer
saveUser user = do
    let uid = getVal "uid" user
    case isId uid of
        True  -> updateUser user
        False -> insertUser user

updateUser :: TableData -> IO Integer
updateUser user = do
    let uid = getVal "uid" user
    con <- getDBConn
    stm <- prepare con "UPDATE user SET name=?, age=?, addr=? WHERE uid=?"
    ret <- execute stm [toSql $ getVal "name" user, toSql $ getVal "age" user, toSql $ getVal "addr" user, toSql uid ]
    commit con
    return (read uid::Integer)

insertUser :: TableData -> IO Integer
insertUser user = do
    con <- getDBConn
    stm <- prepare con "INSERT user(name, age, addr) VALUES(?, ?, ?)"
    ret <- execute stm [toSql $ getVal "name" user, toSql $ getVal "age" user, toSql $ getVal "addr" user ]
    commit con
    getInsertLastId con


isId :: String -> Bool
isId x = let num = read x::Integer
         in if num == 0
            then False
            else num == toInteger num

getUser :: Integer -> IO(Maybe TableData)
getUser user_id =
            do
                con <- getDBConn
                stm <- prepare con "SELECT * FROM user WHERE uid=?"
                execute stm [toSql user_id]
                row <- fetchRowAL stm
                case row of
                     Just val -> return $ Just $ parse_tableData val
                     Nothing  -> return $ Nothing


getUserCost :: Integer -> IO [TableData]
getUserCost user_id =
        do
            con <- getDBConn
            stm <- prepare con "SELECT * FROM cost WHERE ref_uid=?"
            execute stm [toSql user_id]
            rows <- fetchAllRowsAL stm
            return $ map parse_tableData rows


getCost :: Integer -> IO(Maybe TableData)
getCost user_id =
            do
                con <- getDBConn
                stm <- prepare con "SELECT * FROM cost WHERE uid=?"
                execute stm [toSql user_id]
                row <- fetchRowAL stm
                case row of
                     Just val -> return $ Just $ parse_tableData val
                     Nothing  -> return $ Nothing

getCostArray :: [TableData] -> [Integer]
getCostArray costs = map (\x -> read $ getVal "cost" x :: Integer) costs


メイン処理

ファイル: Main.hs
import System.IO
import System.Environment (getArgs)
import qualified Lib.TableData as T
import qualified DB.MySQL_Lib as MySQL_Lib
import qualified Data.Map as Map
import Database.HDBC
import Database.HDBC.MySQL

main :: IO()
main = do
     args <- getArgs
     let user_id = read (head args)::Integer

     putStrLn "============ ユーザー検索"   
     user <- T.getUser user_id
     case user of
         Just p  -> putUserInfo p
         Nothing -> putStrLn "そのような人は知りません"
     putStrLn ""

     putStrLn "============ ユーザー登録"
     let newUser = T.createUser [("uid" , "0"), ("name" , "ユーザー6"), ("age", "40"), ("addr", "住所55")]
     putUserInfo newUser
     nuid <- T.saveUser newUser
     putStrLn $ "登録uid = " ++ show nuid
     putStrLn ""

     putStrLn "============ ユーザー変更"
     Just user1 <- T.getUser 1
     user1 <- T.setVal "age" "23" user1
     modid <- T.saveUser user1
     putStrLn $ "更新ユーザーID = " ++ show modid


calcPachiTotal :: String -> IO Integer
calcPachiTotal uid =
    do
        costs <- T.getUserCost (read uid::Integer)
        if length costs > 0
        then return $ foldr (+) 0 [cost | cost <- T.getCostArray costs]
        else return 0

putUserInfo :: T.TableData -> IO()
putUserInfo user =
    do
        let uid = T.getVal "uid" user
            username = T.getVal "name" user
            age = T.getVal "age" user
            addr = T.getVal "addr" user
        putStrLn $ "ユーザーID: " ++ uid
        putStrLn $ "ユーザ名:   " ++ username
        putStrLn $ "住所:       " ++ addr
        putStrLn $ "年齢:       " ++ age ++ "歳"
      
        -- 消費金額を計算
        total_price <- calcPachiTotal (T.getVal "uid" user)
        if total_price > 0
        then
            putStrLn $ "使ってしまったお金は: " ++ show total_price ++ "円です\n"
        else
            putStrLn "お金、使ってない、偉いね\n"


処理内容の説明

主処理はMain.hsなのですが、Mainでは3つのことを実行しています

  • ユーザーIDを利用したユーザー情報の取得(ユーザーIDをプログラムの引数から取得)
  • ユーザー情報の新規登録
  • 既に存在するユーザー情報の更新処理(uid=1のageを40〜23へ更新)



実行方法
cuomo@karky7 ~/Code/haskell/mysqlSample4 $ runhaskell Main.hs 3
============ ユーザー検索
ユーザーID: 3
ユーザ名:   ユーザー3
住所:       住所33
年齢:       35歳
使ってしまったお金は: 16700円です


============ ユーザー登録
ユーザーID: 0
ユーザ名:   ユーザー6
住所:       住所55
年齢:       40歳
お金、使ってない、偉いね

登録uid = 9

============ ユーザー変更
更新ユーザーID = 1


今回はTableDataの中にMapデータとして持たせたところが味噌なのですがどうでしょう?
イメージとしては、それぞれのテーブルデータをTableDataへ突っ込んで管理するみたいな感じなのですが。
insert、update、などの関数をテーブル毎に書かなければならないところが気に入らないデスが

アクセスはしやすいかと思いますが、Map k vのからfromSqlで取り出すときがちょっと気になります(すべてString型にしてしまっている)
SqlValueをそのままfromSqlした型で返せないかと頑張ったのですが、どうもうまく出来ませんでした 笑...まぁHTMLとかで使うならこれでもいいと思うのですが

もし、こんなアクセス方法あるよってネタがあったら、何方か、後教授を...適当ですいません...

0 件のコメント:

コメントを投稿