Windows 環境にて Haskell から PostgreSQL を扱う

Real World Haskell：21 データベース操作を参考に PostgreSQL をテストしてみました。
PostgreSQL の最新バージョンは 9.0.1 ですが、そのままでは connectPostgreSQL を実行した時点で krb5_32.dll がないと言われます。ファイルの中味を確認すると9.0.1-1から大きく変わっています。 8.4.5-1 では OK です。（psqlodbc_09_00_0200.zipを使えば良いのかも知れません）
データベースの ENCODING は現在のDB(CP932)から移行しても問題の発生しにくい EUC_JP で作りました。

-- pgAdmin の吐き出したコード
CREATE DATABASE test
  WITH OWNER = username
       ENCODING = 'EUC_JP'
       TABLESPACE = pg_default
       LC_COLLATE = 'C'
       LC_CTYPE = 'C'
       CONNECTION LIMIT = -1;

ソースは utf8。Windows は Sjis 、Haskell 内部は Ucs4 であることを踏まえて変換すればおｋ。

-- ghc --make -o sel -LC:\PostgreSQL\8.4\lib select.hs
-- utf8 で記述
import IO
import Database.HDBC
import Database.HDBC.PostgreSQL
import Cinnamon.Ucs             ( ucs4ToSjis, sjisToUcs4)
import Cinnamon.RubyString      (chomp)

main = do
    -- 31.1. データベース接続制御関数
    -- http://www.postgresql.jp/document/current/html/libpq-connect.html
    conn <- connectPostgreSQL "host=localhost port=5432 dbname=test"
    run conn "CREATE TABLE test (id INTEGER NOT NULL, name VARCHAR(80))" []
    run conn "INSERT INTO test (id) VALUES (0)" []
    run conn "INSERT INTO test (id,name) VALUES (123,'hoge')" []
    run conn "INSERT INTO test (id,name) VALUES (234,'日本語')" []
    run conn "INSERT INTO test (id,name) VALUES (456,'内部コード')" []

    -- sjis 文字列のテスト
    sjis <- readFile "./sjis.txt"
    print    sjis             --=> "\131V\131t\131g\131W\131X\n"
    print    $ chomp  sjis    --=> "\131V\131t\131g\131W\131X"
    putStrLn $ chomp  sjis    --=>  シフトジス

    -- sjis 文字列は Ucs4 に変換。toSql で SqlValue 型に変換。
    run conn "INSERT INTO test VALUES (?, ?)" [toSql (999::Integer), toSql $ sjisToUcs4 $ chomp  sjis]
    -- あえて自動コミットははずしてあるので手動コミット
    commit conn

    q    <- quickQuery' conn "SELECT * from test" []
    print q
-- 読み込んだ値は SqlValue 型
{-
-> [[SqlInteger 0,SqlNull],[SqlInteger 123,SqlByteString "hoge"],(snip)
[SqlInteger 999,SqlByteString "\227\130\183\227\131\149\227\131\136\227\130\184\227\130\185"]]
-}
    -- 読み込んだ値は SqlValue なので変換
    let stringRows = map convRow q

    mapM_ putStrLn stringRows
    {-
     =>
     0: NULL
     123: hoge
     234: 日本語
     456: 内部コード
     999: シフトジス
    -}
    disconnect conn
 
    where
          convRow :: [SqlValue] -> String
          convRow [sqlId, sqlDesc] = 
              show intid ++ ": " ++ desc
                  where 
                      -- fromSql は返す型を指定する
                      -- toString  i = (fromSql i)::String
                      -- toInteger i = (fromSql i)::Integer
                      intid = (fromSql sqlId)::Integer
                      desc  = case fromSql sqlDesc of
                                  -- 文字列は ucs4 から Sjis へ変換
                                  Just x  -> ucs4ToSjis x
                                  Nothing -> "NULL"
          convRow x = fail $ "Unexpected result: " ++ show x

• fromSql関数は返す型を指定して使います。(20110512:追記)

> mapM_ (\x->putStrLn ( ucs4ToSjis (fromSql ((q !! 3)!!x) ::String))) [0..1]
123
hoge
> mapM_ (\x->putStrLn ( ucs4ToSjis (fromSql ((q !! 4)!!x) ::String))) [0..1]
234
日本語
> mapM_ (\x->putStrLn ( ucs4ToSjis (fromSql ((q !! 5)!!x) ::String))) [0..1]
456
内部コード

com.exe からは nkf で Sjis に変換して表示。

D:\pgsql> echo select * from test | psql test | nkf -s
 id  |    name
-----+------------
   0 |
 123 | hoge
 234 | 日本語
 456 | 内部コード
 999 | シフトジス
(5 行)