HaskellでDBバッチ処理

概要

これは Haskell Advent Calendar 2012 の11日目の記事、その2です。
Haskell で DBを使うバッチ処理を書くための記事です。
基本的な文法を把握したらバッチ処理を書くのは簡単だと示すのが目的です。
主な対象読者はプログラミングHaskell かすごいHaskellたのしく学ぼう! を読み、Haskell をより使いたい人です。

バッチ処理の概要

DB定義

persistentパッケージを使ったDB定義の方法は Haskellで便利にデータ設計を読んでください。
今回使うDB定義は以下です。

share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persist|
Person
    name Text
    age  Int
    sex  Sex

NumPerAge
    ageArea AgeArea
    sex     Sex
    number  Int
|]

data Sex = Male | Female
    deriving (Show, Read, Eq, Ord, Enum, Bounded)

data AgeArea = Over0 | Over20 | Over40 | Over60
    deriving (Show, Read, Eq, Ord, Enum, Bounded)

intToAgeArea :: Int -> AgeArea
intToAgeArea n
    | n < 20 = Over0
    | n < 40 = Over20
    | n < 60 = Over40
    | otherwise = Over60

derivePersistField "Sex"
derivePersistField "AgeArea"

バッチ処理の内容

Person テーブルを読んで、年齢層と男女別に人数を集計する処理を書くことにします。

主な処理の関数

まずは主な処理を考えましょう。
DB処理は置いておくとして、Personのデータを入力として、NumPerAgeを出力するのですから、

calculateNumPerAge :: [Person] -> [NumPerAge]

こんな型になるはずです。
処理内容もお決まりの再帰処理を書けばできそうです。
ということで主な処理は簡単そうですね。

DBとのやりとり

DBアクセスのコードは大雑把には以下のように書きます。
今回は SQLite を使うことにします。(他でもだいたい同じ)

main :: IO ()
main = do
    someIOProc
    withSqliteConn "dbname.sqlite" . runSqlConn $ do
        someDBProc
    someIOProc

withSqliteConn の行がお決まりの接続処理だと思ってください。
someDBProc のところに DB処理を書きます。
以下のように書けば今回やりたい DB処理を実行できます。

main :: IO ()
main = do
    someIOProc
    withSqliteConn "dbname.sqlite" . runSqlConn $ do
        personEntities <- selectList [] []
        let persons = map entityVal personEntities
        let numPerAges = calculateNumPerAge persons
        mapM_ insert numPerAges
    someIOProc

insert は1つの要素に対する関数なので、mapM_ でリストに適用しています。
selectList で personEntities にバインドした型は Entity Person です。
この型は次のようになっています。

data Entity Person =
    { entityKey :: PersonId
    , entityVal :: Person
    }

データ型の作成

今回の処理は計算結果を入れるレコード数も定まっています。
なのでそのテーブル用のデータ型も作ってみました。

data AllNumPerAge = AllNumPerAge
    { over0Male :: Int
    , over0Female :: Int
    , over20Male :: Int
    , over20Female :: Int
    , over40Male :: Int
    , over40Female :: Int
    , over60Male :: Int
    , over60Female :: Int
    }
  deriving (Show, Eq, Ord)

fromAllNumPerAge :: AllNumPerAge -> [NumPerAge]
fromAllNumPerAge all
    = NumPerAge Over0  Male   (over0Male    all)
    : NumPerAge Over0  Female (over0Female  all)
    : NumPerAge Over20 Male   (over20Male   all)
    : NumPerAge Over20 Female (over20Female all)
    : NumPerAge Over40 Male   (over40Male   all)
    : NumPerAge Over40 Female (over40Female all)
    : NumPerAge Over60 Male   (over60Male   all)
    : NumPerAge Over60 Female (over60Female all)
    : []

これで後は計算処理を書くだけです。

calculateNumPerAge :: [Person] -> AllNumPerAge
calculateNumPerAge xs = helper xs mempty
  where
    helper :: [Person] -> AllNumPerAge -> AllNumPerAge
    helper [] acc = acc
    helper (p:ps) acc = helper ps (app p acc)
    app p acc = case personSex p of
        Male -> case (intToAgeArea (personAge p)) of
            Over0 -> acc { over0Male = 1 + over0Male acc }
            Over20 -> acc { over20Male = 1 + over20Male acc }
            Over40 -> acc { over40Male = 1 + over40Male acc }
            Over60 -> acc { over60Male = 1 + over60Male acc }
        Female -> case (intToAgeArea (personAge p)) of
            Over0 -> acc { over0Female = 1 + over0Female acc }
            Over20 -> acc { over20Female = 1 + over20Female acc }
            Over40 -> acc { over40Female = 1 + over40Female acc }
            Over60 -> acc { over60Female = 1 + over60Female acc }

main :: IO ()
main = runSqlite $ do
    personEntities <- selectList [] []
    let persons = map entityVal personEntities
    mapM_ insert $ fromAllNumPerAge $ calculateNumPerAge persons

はい、これで簡単なバッチ処理が書けました。

Transaction をちゃんとする

注: 未完

レコード数が大きくなったときのために

注: 未完
TODO: レコード数が大きくなった場合のselectListの挙動確認 TODO: selectSource 使ってやる

並行処理させる

注: 未完
TODO: 並行処理させる

それぞれに計算させた結果を後で足し合わせるために Monoid のインスタンスにする。

instance Monoid AllNumPerAge where
    mempty = AllNumPerAge 0 0 0 0 0 0 0 0
    mappend x y = AllNumPerAge
        (over0Male x    + over0Male y)
        (over0Female x  + over0Female y)
        (over20Male x   + over20Male y)
        (over20Female x + over20Female y)
        (over40Male x   + over40Male y)
        (over40Female x + over40Female y)
        (over60Male x   + over60Male y)
        (over60Female x + over60Female y)

証明できそうな性質もあるのでQuickCheckの出番かも。

Testing

TODO: Testを書く

参考情報

詳しくは今回書いてみたbatch をご覧いただければと思います。

宣伝

技術者を募集しています。
Haskell やら Cloud やらの仕事に興味あればご連絡ください。
もしくは以下の「3.クラウドエンジニア」にご応募ください。
会社の募集ページ

seizans/BATCH.md