Creatable a => a -> IO b

Haskellと数学とちょびっと音楽

状態の合成比較:モナド変換子 vs Eff vs Classy

前回の記事について、実際に他の方法と比較してみたいという声を頂いたので、それぞれ同じような事をするためのコードを書き下してみました。

オーバーヘッドとかそのへんのパフォーマンス周りについては調べてないです。 きっと誰かがやってくれるさ。

モナド変換子の場合

module Main where
import Control.Monad.State

data Foo = Foo
  { foostr :: String
  , fooint :: Int
  } deriving Show

data Bar = Bar
  { barstr :: String
  , barint :: Int
  } deriving Show

----

changeFoo :: State Foo () 
changeFoo = modify $ \foo -> foo { foostr = "NYAN" }

changeFooBar :: StateT Foo (State Bar) ()
changeFooBar = do
  modify $ \foo -> execState changeFoo foo
  lift . modify $ \bar -> bar { barint = 100 }
    
main = do
  let foo = Foo { foostr = "hoge", fooint = 1 }
  let bar = Bar { barstr = "piyo", barint = 2 }
  print (foo, bar)
  print $ execState changeFoo foo
  print $ runState (execStateT changeFooBar foo) bar

こうしてみると、State同士をモナド変換子で合成するのはとても良い設計とは言えない感じ。

changeFooBar関数の中でexecStateを実行しなくちゃいけないのもダサいですし、なにより、liftが付きまとうのは辛いですね・・・。状態の数が3つ以上になったら、一旦一つの型にまとめたほうが良さそうです。4つとか5つくらいのStateモナドを合成して扱うなんてなったら、脳みそが付いていける自信無い・・・。

Extensible Effects

{-# LANGUAGE FlexibleContexts, DeriveDataTypeable #-}
module Main where
import Data.Typeable
import Control.Eff
import Control.Eff.State.Lazy

data Foo = Foo
  { foostr :: String
  , fooint :: Int
  } deriving (Show, Typeable)

data Bar = Bar
  { barstr :: String
  , barint :: Int
  } deriving (Show, Typeable)

----

changeFoo :: (Member (State Foo) r) => Eff r ()
changeFoo = modify $ \foo -> foo { foostr = "NYAN" }

changeFooBar :: (Member (State Foo) r, Member (State Bar) r) => Eff r ()
changeFooBar = do
  changeFoo
  modify $ \bar -> bar { barint = 100 }

main = do
  let foo = Foo { foostr = "hoge", fooint = 1 }
  let bar = Bar { barstr = "piyo", barint = 2 }
  print (foo, bar)
  print . run $ execState foo changeFoo
  print . run $ runState foo (execState bar changeFooBar)

モナド変換子のlift地獄解決のために作られたみたいなライブラリです。 あるモナドアクションが合成されたどのモナドのものなのかは、そのアクションの型で決定されるので、liftが不要になります。 ただし、型シグネチャがお伊達にも分かりやすいとは言えないほか、mtlとの互換性が全くないのはどうなんだろう・・・。

ブラックボックスの範囲の話をすると、いちおう圏論的なアプローチで作られてはいるようですが、数学的な背景がHask圏に収まっていないっぽくて、メタな部分で超絶技巧な事をしてたりします。 あとlensと組み合わせて使えるか今のところわかんないので、いずれやってみてまだブログ書きます。

Classy

{-# LANGUAGE TemplateHaskell #-}
module Main where
import Control.Lens
import Control.Monad.State

data Foo = Foo
  { _foostr :: String
  , _fooint :: Int
  } deriving Show

data Bar = Bar
  { _barstr :: String
  , _barint :: Int
  } deriving Show

makeClassy ''Foo
makeClassy ''Bar

----

data FooBar = FooBar
  { _foobarFoo :: Foo
  , _foobarBar :: Bar
  } deriving Show

makeLenses ''FooBar

instance HasFoo FooBar where
  foo = foobarFoo
instance HasBar FooBar where
  bar = foobarBar

----

changeFoo :: HasFoo a => State a ()
changeFoo = foostr .= "NYAN"

changeFooBar :: (HasFoo a, HasBar a) => State a ()
changeFooBar = do
  changeFoo
  barint .= 100

main = do
  let foo = Foo { _foostr = "hoge", _fooint = 1 }
  let foobar = FooBar 
                 { _foobarFoo = foo 
                 , _foobarBar = Bar { _barstr = "piyo", _barint = 2 }
                 }
  print foobar
  print $ execState changeFoo foo 
  print $ execState changeFooBar foobar

モナド変換子とEffが「モナドの合成」なのに対し、こっちは「型の合成」になります。一旦型を宣言してしまえば、純粋な関数でもlensを通して使えます。 「型を作る」というアプローチであるが故に、型宣言の量が多くなってしまうのは難点ですが、その分、実際の処理部分は一番わかりやすいです。

ようは、「単純に複数の状態を一気に扱いたいだけなら、モナドの合成なんてややこしい事しないで、型を一つにまとめちゃえば良いでしょ?」という形での代案なので、List/Maybeモナドを代表とする、非決定計算を扱うモナドの代用は出来ないです。 Effとlensの組み合わせが出来るようであれば、Effと一緒に使ってみても良いかもしれないですね。

lensのmakeClassyで型を合成する

はいはい、とんとご無沙汰しとります。ちゅーんさんです。

HaskellではStateモナド等を使って、状態を扱う事ができます。 また、モナドの合成にはモナド変換子がよく使われますが、 モナド変換子は階層構造になっているため、複数の状態系モナドを、 組み合わせて使うような、よくある場合に適さないという問題があります。

で、

この解決方法には、例えばOleg先生のextensible-effects 等、いろいろと考えだされています。

個人的にEffは超絶技巧のわりにはあまり分かりやすいイメージもなく、 既存のモナドをすべて置き換えなくてはいけないため、あまり好きではないのです。 そこで、単純に複数のレコードを一つに纏めあげたいだけの場合は、 lensライブラリmakeClassy というTHを使って型を作成するのをおすすめします。

導入

まず、以下のような2つの型を考えましょう。

data Foo = Foo
  { foostr :: String
  , fooint :: Int
  }

data Bar = Bar
  { barstr :: String
  , barint :: Int
  }

単純に、これらの型をまとめ上げた、FooBar型を考えます。

data FooBar
  { foobarFoo :: Foo
  , foobarBar :: Bar
  }

そしてこれを単純にStateモナドで扱う事を考えます。

proc :: State FooBar ()
proc = do
  base <- get
  let foo = foobarFoo base
  put $ base { foobarFoo = foo { fooint = 100 }  } 

main = do
  foobar <- return $ FooBar 
    { foobarFoo = Foo { foostr = "hoge", fooint = 1 }
    , foobarBar = Bar { barstr = "piyo", barint = 2 }
    }
  print $ runState proc foobar

proc関数を読んでみましょう。

なんというかこう

とてもつらい

lensとState

MonadStateのインスタンスになっているモナドで状態の一部を変更したりという事を頻繁に行うのであれば、 状態に用いる方をlensにしてしまうのが良いです。

data Foo = Foo
  { _foostr :: String
  , _fooint :: Int
  } deriving Show

data Bar = Bar
  { _barstr :: String
  , _barint :: Int
  } deriving Show

data FooBar = FooBar
  { _foobarFoo :: Foo
  , _foobarBar :: Bar
  } deriving Show

makeLenses ''Foo
makeLenses ''Bar
makeLenses ''FooBar

lensのアクセサによって値の操作がぐっと楽になります。

proc :: State FooBar ()
proc = do
  foobarFoo.foostr .= "HOGE"
  foobarBar.barint *= 100

さて、予めFooに対し、次のような関数が用意されていた場合を考えてみましょう。

changeFoo :: State Foo ()
changeFoo = do
  foostr .= "NYAN"
  fooint .= 1000

この関数をFooBar型のStateに使うためには、execStateしなくてはいけません。 あんまり格好良くないですね。

proc :: State FooBar ()
proc = do
  tmp <- use foobarFoo
  foobarFoo .= execState changeFoo tmp

型クラスの作成と型の合成

先ほど上げたような問題は、Foo型、Bar型それぞれの型クラスを作成する事によって解決できる気がします。 しかしlensの型はややこしいため、それらを自力で実装するのはあまり良い考えではなさそうです。

素晴らしい事に、任意の型をlensで扱えるようにすると同時に、 そのアクセサが定義された型クラスを自動的に生成するTHの実装が用意されています。 それが、makeClassyです。

試しに、Foo型をmakeClassyで扱ってみましょう。

data Foo = Foo
  { _foostr :: String
  , _fooint :: Int
  } deriving Show

makeClassy ''Foo

このFoo型は普通にlensで扱える(※多相な型の場合等、makeLensesと違って制限があるようです)他、 ある型がXを内包している事を表すHasXという型クラスが実装されます。

ghci> :i HasFoo
class HasFoo c_a1YO where
  foo :: Functor f => (Foo -> f Foo) -> c0 -> f c0
  fooint :: Functor f => (Int -> f Int) -> c0 -> f c0
  foostr :: Functor f => (String -> f String) -> c0 -> f c0
    -- Defined at Main.hs:54:1
instance HasFoo Foo -- Defined at Main.hs:54:1

このうち、実装が必要なのはfoo関数のみで、これはある型が内包するfoo関数へのアクセサを設定すればOKです。 実際に、FooとBarをmakeClassyを使って合成してみましょう。

まず、FooとBarに対しmakeClassy、FooBarに対しmakeLensesを実行します。

data Foo = Foo
  { _foostr :: String
  , _fooint :: Int
  } deriving Show

data Bar = Bar
  { _barstr :: String
  , _barint :: Int
  } deriving Show

makeClassy ''Foo
makeClassy ''Bar

data FooBar = FooBar
  { _foobarFoo :: Foo
  , _foobarBar :: Bar
  } deriving Show

makeLenses ''FooBar

さらに、FooBarをHasFoo、HasBarそれぞれの型クラスにします。

instance HasFoo FooBar where
  foo = foobarFoo
instance HasBar FooBar where
  bar = foobarBar

最後に、changeFoo関数の型定義を次のように変更すれば、FooBar型に対しても、changeFoo関数による操作が出来るようになります。

changeFoo :: HasFoo a => State a ()
changeFoo = do
  foostr .= "NYAN"
  fooint .= 1000

コード全体

{-# LANGUAGE TemplateHaskell #-}
module Main where
import Control.Lens
import Control.Monad.State

data Foo = Foo
  { _foostr :: String
  , _fooint :: Int
  } deriving Show

data Bar = Bar
  { _barstr :: String
  , _barint :: Int
  } deriving Show

makeClassy ''Foo
makeClassy ''Bar

data FooBar = FooBar
  { _foobarFoo :: Foo
  , _foobarBar :: Bar
  } deriving Show

makeLenses ''FooBar

instance HasFoo FooBar where
  foo = foobarFoo
instance HasBar FooBar where
  bar = foobarBar

----

changeFoo :: HasFoo a => State a ()
changeFoo = do
  foostr .= "NYAN"
  fooint .= 1000

proc :: State FooBar ()
--proc :: (HasFoo a, HasBar a) => State a () --型定義はこのほうが良いかも
proc = do
  --FooBarはFoo, Barそれぞれのインスタンスなので
  --次のような書き方も出来る
  foostr .= "FOO!"
  fooint .= 123
  barstr .= "BAR!"
  barint .= 321

main = do
  foobar <- return $ FooBar 
    { _foobarFoo = Foo { _foostr = "hoge", _fooint = 1 }
    , _foobarBar = Bar { _barstr = "piyo", _barint = 2 }
    }
  print foobar
  print $ runState changeFoo foobar
  print $ runState proc foobar

Haskell-rerational-recordでDB操作するのが楽しすぎる件〜その1〜

どーも、いつものちゅーんさんです。

一ヶ月くらい前に、もくもくHaskell会というハッカソンで日比野さん(@khibino)とご一緒したので、 日比野さんの開発したhaskell-rerational-record(以下HRR)というライブラリを(色々教わりまくりつつ)いじいじしていました。 お仕事のちゅーんさんはわりとゴリゴリSQLを書くわけですけど、あの、あれですよ、辛いんです。 もくもく会でも日比野さんと只管愚痴りまくってましたけど、SQLとかね、こんなもの人間の書くものじゃないです。

ね?

そんなわけで、Haskellを用いて如何に苦しまず楽しくRDBと戯れるか、というのが本日のお題です。

HRRの特徴

基本的にはSQLをモナディックに生成するためのライブラリで。 普通のアプリケーションで必要になるようなほとんどのクエリはこれだけで書く事ができます。 HRRには、ざっと次のような特徴があります。

強い静的型付け

他のこの手のライブラリをご存知の型は解ると思いますが、SQLの構文に型を付けるのってものすごい難しいです。
その点HRRは業務で良く書くようなSQLはほぼ型安全に書くことができ、 実行時に構文や型のエラーを悩ます心配はありません。

THによる自動的なデータ型生成

テーブルの定義は、TemplateHaskellによってコンパイル時に自動的にスキーマ情報を読みに行き、 勝手に生成してくれます。
そのため、DB上でテーブル定義が変更され、プログラムとの整合性が取れなくなった場合は、 即座にコンパイルエラーが発生するようになります。

高い再利用性

複雑なSQLを書く場合、同じサブクエリを何度も書かなくてはいけない事が多々あります。 HRRは一度書いたクエリを再利用する事が出来るので、複雑なクエリもDRYを意識しながら効率的に作成して行く事ができます。

HRRのインストールとか

RDBといっても色々ありますが、もともとPostgresをターゲットにしたライブラリなので、Postgresqlが圧倒的に導入が楽です。 いちお、MySQLとかのドライバもあるっぽいですが、インストールにつらみが溜まったので、素直にPostgresqlに乗り換えました。 MySQLに出会って約半年、たいして使わなかったし、未練なんてねーしな!!

で、Postgresqlの環境作りが一通り終わったら、以下のチュートリアルを元にちょこちょこインストール。

https://github.com/khibino/haskell-relational-record/wiki/%E3%83%81%E3%83%A5%E3%83%BC%E3%83%88%E3%83%AA%E3%82%A2%E3%83%AB

Hackageには上がっていないそうなので、githubリポジトリをcloneしてcabal installするのが基本。
基本的にこの通りにやれば動かせるようになってる・・・はず。

テーブルの準備

CreateしてInsert

まず、練習用に適当なデータを作ってやります。

DROP TABLE TUTORIAL.product;
CREATE TABLE TUTORIAL.product (
  id int primary key,
  name varchar(10) not null,
  price int not null
);
INSERT INTO TUTORIAL.product VALUES (1, 'Apple', 100);
INSERT INTO TUTORIAL.product VALUES (2, 'Grape', 200);
INSERT INTO TUTORIAL.product VALUES (3, 'Orange', 300);
INSERT INTO TUTORIAL.product VALUES (4, 'Banana', 400);
INSERT INTO TUTORIAL.product VALUES (5, 'Pineapple', 500);

DROP TABLE TUTORIAL.marketHistory;
CREATE TABLE TUTORIAL.marketHistory (
  id int primary key,
  product int not null,
  quantity int not null
);
INSERT INTO TUTORIAL.marketHistory VALUES (1, 1, 10);
INSERT INTO TUTORIAL.marketHistory VALUES (2, 1, 5);
INSERT INTO TUTORIAL.marketHistory VALUES (3, 1, 3);
INSERT INTO TUTORIAL.marketHistory VALUES (4, 1, 6);
INSERT INTO TUTORIAL.marketHistory VALUES (5, 2, 6);
INSERT INTO TUTORIAL.marketHistory VALUES (6, 2, 5);
INSERT INTO TUTORIAL.marketHistory VALUES (7, 2, 8);
INSERT INTO TUTORIAL.marketHistory VALUES (8, 2, 4);
INSERT INTO TUTORIAL.marketHistory VALUES (10, 3, 3);
INSERT INTO TUTORIAL.marketHistory VALUES (11, 3, 5);
INSERT INTO TUTORIAL.marketHistory VALUES (12, 3, 4);
INSERT INTO TUTORIAL.marketHistory VALUES (13, 3, 9);
INSERT INTO TUTORIAL.marketHistory VALUES (14, 4, 10);
INSERT INTO TUTORIAL.marketHistory VALUES (15, 4, 14);
INSERT INTO TUTORIAL.marketHistory VALUES (16, 4, 12);
INSERT INTO TUTORIAL.marketHistory VALUES (17, 4, 11);
INSERT INTO TUTORIAL.marketHistory VALUES (18, 5, 1);
INSERT INTO TUTORIAL.marketHistory VALUES (19, 5, 3);
INSERT INTO TUTORIAL.marketHistory VALUES (20, 5, 2);
INSERT INTO TUTORIAL.marketHistory VALUES (21, 5, 4);

THに型を生成させる

チュートリアルに書かれているのそのまんまです。
フィールドの定義とか書かなくても、コンパイル時に勝手にDBにアクセスしてテーブル情報を持ってきてくれるので、 スキーマ名とテーブル名だけ指定してやればおk

productという関数がPreludeに定義されていて、名前が被ってしまうため、 Product.hsではPreludeからShowのみImportしています。

Product.hs

{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances #-}
module Product where
import Database.HDBC.Query.TH (defineTableFromDB)
import Database.HDBC.Schema.PostgreSQL (driverPostgreSQL)
import Database.Record.TH (derivingShow)

import DataSource (connect)
import Prelude (Show)

defineTableFromDB connect driverPostgreSQL "TUTORIAL" "product" [derivingShow]

MarketHistory.hs

{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances #-}
module MarketHistory where
import Database.HDBC.Query.TH (defineTableFromDB)
import Database.HDBC.Schema.PostgreSQL (driverPostgreSQL)
import Database.Record.TH (derivingShow)

import DataSource (connect)

defineTableFromDB connect driverPostgreSQL "TUTORIAL" "marketHistory" [derivingShow]

簡単なSelect文を書いてみる

クエリを作成する

基本的な書き方はチュートリアルにもありますし、仕組みを理解してるワケでは無いので、 詳細な説明は割愛します。(実装理解したらそのうち解説記事とか書くかも)
最初は見様見真似でも、モナドの型のあわせ方とかが解っていれば大体コンパイル通せるようになります。

Query.hs

module Query where 
import Database.Relational.Query 
import GHC.Int 

import Product (Product) 
import qualified Product as P 

selectProduct :: Relation () Product
selectProduct = relation $ query P.product

で、これをShowすると、生成されたSQL文を見る事ができます。

*Query> selectProduct
SELECT ALL T0.id AS f0, T0.name AS f1, T0.price AS f2 FROM TUTORIAL.product T0

exsampleとかチュートリアルとか見ると、(><)とかいう演算子(勝手に「女子力演算子」って呼んでる)を使ってSelectしてたりますが、 これは2引数のタプルを構築していくライブラリなので、結果の型がけっこうダサい事になってたりします。

今は(|$|)と(|*|)とかいう演算子を使って良い感じに描けます。(projectable-applicativeとかいうらしい、よく解ってない) 使い方は基本的に普通のApplicativeと同じような感じ。

Query.hs

module Query where 
import Database.Relational.Query 
import GHC.Int 

import Product (Product) 
import qualified Product as P 

selectProduct :: Relation () (String, Int32)
selectProduct = relation $ do 
  p <- query P.product
  return $ (,) |$| p ! P.name' |*| p ! P.price'

注意点としては、(!)演算子の左辺を忘れない事と、フィールド名の後ろのアポストロフィー(')を忘れない事。
P.nameやP.priceは、生成されたレコード型のフィールド名として生成されているので、わりとややこしい型エラーになります。

*Query> :t P.name
P.name :: Product -> String
*Query> :t P.name'
P.name' :: Pi Product String

生成されたSQL

SELECT ALL 
    T0.name AS f0
  , T0.price AS f1 
FROM 
    TUTORIAL.product T0

作成したクエリを発行する

基本的には先のチュートリアルに書かれていた事そのまんまです。まずDBコネクションを作ってやります。

DataSource.hs

module DataSource(connect) where
import Database.HDBC.PostgreSQL (connectPostgreSQL, Connection)

connect :: IO Connection
connect = connectPostgreSQL "dbname=testdb"

んで、relationQuery関数を使いーの、runQuery関数で作成したクエリを発行します。

DataSource.hs

 DataSource.hs  init.sql  Main.hs  Query.hs  Product.hs  MarketHistory.hs  DataSource.hs                                                         X
module Main where
import Database.Relational.Query (relationalQuery)
import Database.HDBC.Session (withConnectionIO, handleSqlError')
import Database.HDBC.Record.Query (runQuery)

import DataSource (connect)
import Query

main :: IO ()
main = handleSqlError' $ withConnectionIO connect $ \conn -> do
  products <- runQuery conn (relationalQuery selectProduct) ()
  mapM_ print products

実行結果:

("Apple",100)
("Grape",200)
("Orange",300)
("Banana",400)
("Pineapple",500)

クエリの結果を任意の型に格納する

次のように独自の型を使って名称と金額をSelectする事を考えた時、この型をHRRで使うためにいくつかの型クラスのインスタンスにする必要があります。
だだ、それを毎回やるのはだいぶ面倒です。

data ProductAmount = ProductAmount String Int32 deriving (Show, Read, Eq, Ord)

そこで以下のTHを使って、必要な型クラスのインスタンスを自動的に導出してやります。

-- import Database.HDBC.Query.TH しておく
$(makeRecordPersistableDefault ''ProductAmount)

後は、タプルの時と同じように(|$|)とか(|*|)を使って書いてやればおk

selectProduct :: Relation () ProductAmount
selectProduct = relation $ do
  p <- query P.product
  return $ ProductAmount |$| p ! P.name' |*| p ! P.price'

実行結果:

ProductAmount "Apple" 100
ProductAmount "Grape" 200
ProductAmount "Orange" 300
ProductAmount "Banana" 400
ProductAmount "Pineapple" 500

多相な型で扱いたい場合

ただ現状、上記のTHを使ってインスタンスを導出できるのは、単相な型の場合のみらしいです。
どうやら、kindが合わなかったりとか、型変数の型クラス制約とかの関係で、多相な型からインスタンスを導出するのは難しいもよう。

なので、どーしても多相な型を使いたいんだっ! という場合は、自力でProductConstructor、FromSql、ToSqlのインスタンスを書いてやる必要があるみたい。

module Query where
import Control.Applicative
import Database.Record
import Database.Record.ToSql
import Database.Relational.Query
import Database.HDBC (SqlValue)
import Database.HDBC.Query.TH
import Product (Product)
import qualified Product as P
import GHC.Int

data MyTuple a b c = MyTuple a b c deriving (Show, Read, Eq, Ord)
instance ProductConstructor (a -> b -> c -> MyTuple a b c) where
  productConstructor = MyTuple

instance (FromSql SqlValue a, FromSql SqlValue b, FromSql SqlValue c)
         => FromSql SqlValue (MyTuple a b c) where
  recordFromSql = MyTuple <$> recordFromSql <*> recordFromSql <*> recordFromSql

instance (ToSql SqlValue a, ToSql SqlValue b, ToSql SqlValue c)
         => ToSql SqlValue (MyTuple a b c) where
  recordToSql = createRecordToSql (\(MyTuple a b c) -> fromRecord a ++ fromRecord b ++ fromRecord c)

selectProduct'' :: Relation () (MyTuple Int32 String Int32)
selectProduct'' = relation $ do
  p <- query P.product
  return $ MyTuple |$| p ! P.id' |*| p ! P.name' |*| p ! P.price'

実行結果:

MyTuple 1 "Apple" 100
MyTuple 2 "Grape" 200
MyTuple 3 "Orange" 300
MyTuple 4 "Banana" 400
MyTuple 5 "Pineapple" 500

3要素のタプルとか4要素のタプルとか

デフォルトで上記インスタンスになってて欲しいところですが、現状は無いらしい(無くてもどうにでもなりますし)ので、 自分で書く必要がありました。近々実装されるっぽいです。

instance ProductConstructor (a -> b -> c -> (a, b, c)) where
  productConstructor = (,,) 
 
instance (FromSql SqlValue a, FromSql SqlValue b, FromSql SqlValue c)
         => FromSql SqlValue (a, b, c) where
  recordFromSql = (,,) <$> recordFromSql <*> recordFromSql <*> recordFromSql
 
instance (ToSql SqlValue a, ToSql SqlValue b, ToSql SqlValue c)
         => ToSql SqlValue (a, b, c) where
  recordToSql = createRecordToSql (\(a, b, c) -> fromRecord a ++ fromRecord b ++ fromRecord c)

selectProduct' :: Relation () (Int32, String, Int32)
selectProduct' = relation $ do 
  p <- query P.product
  return $ (,,) |$| p ! P.id' |*| p ! P.name' |*| p ! P.price'

JOINは楽ちん

単純に参照しに行くテーブルを増やせば、勝手にJOIN句を生成してくれます。
Monadic join styleと言うらしいです。

selectHistory :: Relation () (Product, MarketHistory) 
selectHistory = relation $ do  
  p <- query P.product 
  m <- query M.marketHistory  
  return $ (,) |$| p |*| m 

生成されたSQL

SELECT ALL 
    T0.id AS f0
  , T0.name AS f1
  , T0.price AS f2
  , T1.id AS f3
  , T1.product AS f4
  , T1.quantity AS f5 
FROM 
        TUTORIAL.product T0 
    INNER JOIN 
        TUTORIAL.markethistory T1 
            ON (0=0)

ON句の書き方

ON句を指定したい場合はon関数を使います。
この時、ONがどのJOIN句にくっつくかは、on関数の書かれた位置によって決まるらしい。

selectHistory :: Relation () (Product, MarketHistory)
selectHistory = relation $ do
  p <- query P.product
  m <- query M.marketHistory
  on $ p ! P.id' .=. m ! M.product'
  return $ (,) |$| p |*| m

生成されたSQL

SELECT ALL 
    T0.id AS f0
  , T0.name AS f1
  , T0.price AS f2
  , T1.id AS f3
  , T1.product AS f4
  , T1.quantity AS f5 
FROM 
        TUTORIAL.product T0 
    INNER JOIN 
        TUTORIAL.markethistory T1 
            ON (T0.id = T1.product)

比較演算子は両側にコロンが付いたものが用意されています。ANDはon演算子を書き連ねていけば良いっぽい。

*Query> :t (.=.)
(.=.)
  :: (SqlProjectable p, ProjectableShowSql p) =>
     p ft -> p ft -> p (Maybe Bool)
*Query> :t (.<.)
(.<.)
  :: (SqlProjectable p, ProjectableShowSql p) =>
     p ft -> p ft -> p (Maybe Bool)
*Query> :t (.>.)
(.>.)
  :: (SqlProjectable p, ProjectableShowSql p) =>
     p ft -> p ft -> p (Maybe Bool)
*Query> :t (.<=.)
(.<=.)
  :: (SqlProjectable p, ProjectableShowSql p) =>
     p ft -> p ft -> p (Maybe Bool)
*Query> :t (.>=.)
(.>=.)
  :: (SqlProjectable p, ProjectableShowSql p) =>
     p ft -> p ft -> p (Maybe Bool)
*Query> :t (.<>.)
(.<>.)
  :: (SqlProjectable p, ProjectableShowSql p) =>
     p ft -> p ft -> p (Maybe Bool)
*Query> :t (.||.)
(.||.)
  :: (Data.String.IsString a, SqlProjectable p,
      ProjectableShowSql p) =>
     p a -> p a -> p a

四則演算とかもありますね。

*Query> :t (.+.)
(.+.)
  :: (Num a, SqlProjectable p, ProjectableShowSql p) =>
     p a -> p a -> p a
*Query> :t (.-.)
(.-.)
  :: (Num a, SqlProjectable p, ProjectableShowSql p) =>
     p a -> p a -> p a
*Query> :t (.*.)
(.*.)
  :: (Num a, SqlProjectable p, ProjectableShowSql p) =>
     p a -> p a -> p a
*Query> :t (./.)
(./.)
  :: (Num a, SqlProjectable p, ProjectableShowSql p) =>
     p a -> p a -> p a

WHERE句の書き方

WHERE句はwheres関数。 この後さらにJOINしたりとかしようとすると、副問い合わせになるっぽい?

selectHistory :: Relation () (Product, MarketHistory)
selectHistory = relation $ do
  p <- query P.product
  m <- query M.marketHistory
  wheres $ p ! P.id' .=. m ! M.product'
  return $ (,) |$| p |*| m

生成されたSQL

SELECT ALL 
    T0.id AS f0
  , T0.name AS f1
  , T0.price AS f2
  , T1.id AS f3
  , T1.product AS f4
  , T1.quantity AS f5 
FROM 
        TUTORIAL.product T0 
    INNER JOIN 
        TUTORIAL.markethistory T1 
            ON (0=0) 
WHERE 
    (T0.id = T1.product)

OUTER JOINやLEFT/RIGHT JOINもqueryMaybeとかいうの使って簡単に出来ます、が、まだ試してないのでいずれ記事にします。 あと、もうちょっとSQLっぽく書けるDirect Join Styleなんてのもありますが、こっちはあんまり格好よく無いなーとか思ったので割愛。

https://github.com/tokiwoousaka/haskell-relational-record/blob/master/relational-query-HDBC-pgTest/example/1/QueryExample.hs#L75

Group By句の書き方

GroupBy句を書くと、Select出来る要素が変わってくるため、 とは言っても、ほとんど書き方は同じですし、型推論されるので得にその事を意識する必要は無いです。

data MarketHisoryWithNameGrouped = MarketHisoryWithNameGrouped   
  { mhgProductName :: String
  , mhgQuantity :: Maybe Int32
  } deriving (Show, Read, Eq, Ord)
$(makeRecordPersistableDefault ''MarketHisoryWithNameGrouped)

selectHistoryGroupBy :: Relation () MarketHisoryWithNameGrouped
selectHistoryGroupBy = aggregateRelation $ do --relationの代わりにaggregateRelationを使う 
  --Group元のテーブルをSelect
  p <- query P.product
  m <- query M.marketHistory
  on $ p ! P.id' .=. m ! M.product'
  --idとnameでGroup化、nameは後ほど使うので束縛
  groupBy $ p ! P.id'
  g <- groupBy $ p ! P.name'
  --pやmのフィールドは集約関数を適用させないと使えない
  return $ MarketHisoryWithNameGrouped |$| g |*| sum' (m ! M.quantity')

sum'関数はクエリを記述するために用意された集約関数です。 集約関数には以下のようなものがあります。

*Query> :t sum'
sum'
  :: (Num a, SqlProjectable (p ac),
      Database.Relational.Query.ProjectableExtended.AggregatedContext
        ac) =>
     Projection Flat a -> p ac (Maybe a)
*Query> :t sumMaybe
sumMaybe
  :: (Num a, SqlProjectable (p ac),
      Database.Relational.Query.ProjectableExtended.AggregatedContext
        ac) =>
     Projection Flat (Maybe a) -> p ac (Maybe a)
*Query> :t avg
avg
  :: (Fractional b, Num a, SqlProjectable (p ac),
      Database.Relational.Query.ProjectableExtended.AggregatedContext
        ac) =>
     Projection Flat a -> p ac (Maybe b)
*Query> :t avgMaybe
avgMaybe
  :: (Fractional b, Num a, SqlProjectable (p ac),
      Database.Relational.Query.ProjectableExtended.AggregatedContext
        ac) =>
     Projection Flat (Maybe a) -> p ac (Maybe b)
*Query> :t max'
max'
  :: (Ord a, SqlProjectable (p ac),
      Database.Relational.Query.ProjectableExtended.AggregatedContext
        ac) =>
     Projection Flat a -> p ac (Maybe a)
*Query> :t maxMaybe
maxMaybe
  :: (Ord a, SqlProjectable (p ac),
      Database.Relational.Query.ProjectableExtended.AggregatedContext
        ac) =>
     Projection Flat (Maybe a) -> p ac (Maybe a)
*Query> :t min'
min'
  :: (Ord a, SqlProjectable (p ac),
      Database.Relational.Query.ProjectableExtended.AggregatedContext
        ac) =>
     Projection Flat a -> p ac (Maybe a)
*Query> :t minMaybe
minMaybe
  :: (Ord a, SqlProjectable (p ac),
      Database.Relational.Query.ProjectableExtended.AggregatedContext
        ac) =>
     Projection Flat (Maybe a) -> p ac (Maybe a)
*Query> :t every
every
  :: (SqlProjectable (p ac),
      Database.Relational.Query.ProjectableExtended.AggregatedContext
        ac) =>
     Projection Flat (Maybe Bool) -> p ac (Maybe Bool)
*Query> :t any'
any'
  :: (SqlProjectable (p ac),
      Database.Relational.Query.ProjectableExtended.AggregatedContext
        ac) =>
     Projection Flat (Maybe Bool) -> p ac (Maybe Bool)
*Query> :t some'
some'
  :: (SqlProjectable (p ac),
      Database.Relational.Query.ProjectableExtended.AggregatedContext
        ac) =>
     Projection Flat (Maybe Bool) -> p ac (Maybe Bool)

そして、このクエリをShowすると、以下のようなSQLを得る事ができます。

生成されたSQL

SELECT ALL 
    T0.name AS f0
  , SUM (T1.quantity) AS f1 
FROM 
        TUTORIAL.product T0 
    INNER JOIN 
        TUTORIAL.markethistory T1 
            ON (T0.id = T1.product) 
GROUP BY 
    T0.id
  , T0.name

また、今回のクエリの場合、Productテーブルを基底に集約されれば良いので、次のような書き方をする事も出来ます。

selectHistoryGroupBy :: Relation () MarketHisoryWithNameGrouped
selectHistoryGroupBy = aggregateRelation $ do
  p <- query P.product
  m <- query M.marketHistory
  on $ p ! P.id' .=. m ! M.product'
  g <- groupBy p
  return $ MarketHisoryWithNameGrouped |$| g ! P.name' |*| sum' (m ! M.quantity')

生成されたSQL

SELECT ALL 
    T0.name AS f0
  , SUM (T1.quantity) AS f1 
FROM 
        TUTORIAL.product T0 
    INNER JOIN 
        TUTORIAL.markethistory T1 
            ON (T0.id = T1.product) 
GROUP BY 
    T0.id
  , T0.name
  , T0.price

複数のクエリを組み合わせる

以上、HRRによってSELECT文を書く方法を紹介してきました。 ここまでだと単なる型安全なクエリの記法(といっても、型安全である事がとても大きいのですが)ですが、 複数のクエリを組み合わせる事ができるのは、ただのSQLにはないHRRの強みです。

ここでは、先程作ったproductテーブルとmarketHistoryテーブルを結合するクエリを、 再利用する事を考えてみましょう。

selectHistory :: Relation () (Product, MarketHistory)
selectHistory = relation $ do 
  p <- query P.product
  m <- query M.marketHistory 
  on $ p ! P.id' .=. m ! M.product'
  return $ (,) |$| p |*| m

先程から、テーブルを指定する際にquery関数を使用しています。 この関数はRelation型を引数に取る関数です。

*Query> :t query
query
  :: Database.Relational.Query.Monad.Class.MonadQualify
       ConfigureQuery m =>
     Relation () r -> m (Projection Flat r)

もう分かりますね、作成したクエリはRelation型になっているためquery関数によって、 一度作成したクエリを使用する事ができます。

selectHistoryGroupBy'' :: Relation () MarketHisoryWithNameGrouped
selectHistoryGroupBy'' = aggregateRelation $ do
  sh <- query selectHistory'
  g <- groupBy $ sh ! fst'
  return $ MarketHisoryWithNameGrouped |$| g ! P.name' |*| sum' (sh ! snd' ! M.quantity')

生成されたSQL

SELECT ALL 
    T2.f1 AS f0
  , SUM (T2.f5) AS f1 
FROM 
    (SELECT ALL 
        T0.id AS f0
      , T0.name AS f1
      , T0.price AS f2
      , T1.id AS f3
      , T1.product AS f4
      , T1.quantity AS f5 
    FROM 
            TUTORIAL.product T0 
        INNER JOIN 
            TUTORIAL.markethistory T1 
                ON (T0.id = T1.product)
    ) T2 
GROUP BY 
    T2.f0
  , T2.f1
  , T2.f2

この記事を読んでる皆さんならお分かり頂けるかと思いますが、 このような書き方が出来るのが、HRRのシンプルながら強力な所です。

DRYを意識して上手く部品化しながら組み合わせる事によって、 ただのSQLではメンテナンスが困難になってしまうほど複雑なクエリも、 体系的に解りやすく記述する事ができるわけです。

まとめ

というわけで、今回は、

  • HRRの特徴
  • 入手方法
  • SELECT文の書き方
  • クエリの再利用

等を紹介してきました。 次回(いつになるかわかりませんが・・・)は、INSERT文やUPDATE文、Null許容なフィールドの扱い等について、 (調べつつw)書いていこうかと思います。

いじょ

試行錯誤が大切だという話

あ、どうも、最近残業続きで体力的にアレな感じなちゅーんさんです。 そしてですね、実際のとこ、やることいっっっっぱいあるのですが、うふふふ。

こんなツイートを見かけてしまって、考えていたら楽しくなってきて酷い時間になってしまいました。 つまるところ、プログラムに「試行錯誤」させる仕組みを作りたいわけですね。

ではでは、そろそろ寝ないとヤバイのでちゃっちゃと纏めます。 なに、簡単簡単・・・

public class Main {
    private static void procces(boolean success, String procName){
        if(success){
            System.out.println("処理 " + procName + " 成功");
            throw new RuntimeException();
        }
        System.out.println("処理 " + procName + " 失敗。。。");
    }
    
    public static void run(){
        try{
            procces(false, "A");
            procces(true, "B");
            procces(false, "C");
        }catch(Exception ex){
            System.out.println("処理 D 実行");
            return;
        }
        throw new RuntimeException("全部失敗したよ!");
    }
    
    public static void main(String[] args) {
        run();
    }
}

うわあああ!ごめんなさいごめんなさい!嘘です、冗談です!ちょっと思いついちゃったんです出来心です。

はい

@yubaさんのjava8での解答がエレガントなので貼っておきます。ラムダ式が使えれば良いのでC#でもOK。

で、Haskellの場合です。

実際の所、例外機構ってEitherモナドなので、LeftRightをひっくり返して使えば良いのですが(というか上のJavaの例はEitherから思いついた)、それではちょっと解りづらいので、モナド変換子のトレーニングも兼ねて、簡単に再実装してみましょーか。

まず、Control.MonadControl.Monad.Transをインポートしときます。 そしたら、ベースとなるTryモナドを作りましょう。ぶっちゃけEitherそのまんまです。

data Try a b = Success a | Failed b deriving Show
instance Monad (Try a) where
  return x = Failed x
  m >>= k = case m of
    Success x -> Success x
    Failed x -> k x

んで、モナド変換子。 bindは最終的にTryT型を返せば良いので、データコンストラクタにdo構文を食わせてやります。 今まで1から作ったこと無かったので、ほぼMaybeTの写経プログラミングなのはないしょです。

newtype TryT a m b = TryT { runTryT :: m (Try a b) }
instance MonadTrans (TryT a) where
  lift = TryT . liftM Failed
instance Monad m => Monad (TryT a m) where
  return = lift . return
  x >>= f = TryT $ do
    v <- runTryT x
    case v of
      Success y -> return $ Success y 
      Failed y -> runTryT (f y)

モナド変換子の手続き中で成功や失敗を表す関数を書いてやります。 failureって実質returnなんですけどね。

success :: Monad m => a -> TryT a m b
success x = TryT (return $ Success x)

failure :: Monad m => b -> TryT a m b
failure x = TryT (return $ Failed x)

で、入出力を行いたいので、型変数mIOにした型を宣言・・・

type TryIO a b = TryT a IO b
runTryIO :: TryIO a b -> IO (Try a b)
runTryIO = runTryT

あっ、ここはMonadIOにすべきだったorz
http://hackage.haskell.org/package/transformers-0.2.2.0/docs/Control-Monad-IO-Class.html

で、テストー

process :: Bool -> String -> TryIO () ()
process True s = do
  lift . putStrLn $ "Process " ++ s ++ " success!"
  success ()
process False s = do
  lift . putStrLn $ "Process " ++ s ++ " failed!"
  failure ()

main :: IO ()
main = do
  v <- runTryIO $ do
    process False "A"
    process True "B"
    process False "C"
  case v of
    Success x -> putStrLn "Process D to be run!"
    Failed x -> putStrLn "All process failed!"

こんだけ書くのに約1時間。
うええ、まだまだHaskell力が全然足りませぬー。。。

全体はこっち:https://gist.github.com/tokiwoousaka/9786835

あ、あと、Haskellでこういう事したい時は、素直にEitherT使うのが良いかと思いました。まる。

CROSS2014 言語CROSSに登壇して来ました #cross2014 #cross2014e

どーもー、玄米茶無しでは生きられない20代男子、ちゅーんさんです。

はい。

普段あまりWeb関係の技術とは関わりが無かったのですが、@Lost_dog_さんにご依頼頂き、 2014/1/17 に開催されたCROSS2014(http://www.cross-party.com)にて、言語CROSSというセッションに登壇して来ました。 基本的Haskellについて語りたくてしょうがない人なので、こういうお話があれば喜んで飛んでいきます。

Google Groupでやりとりしながら準備し、当日直前に顔合わせというわりとドタバタとした感じではありましたが、 普段関わりの薄いジャンルの勉強をしている人達と直接顔をあわせて情報交換するのは、とても良い刺激になりました。 多分、本イベント内で2番目くらいに異色を放っていたセッションだったんじゃ無いでしょうか。


というわけで、僕はHaskellを紹介させてもらったんですが。うーん、いまいち魅力とか伝えきれなかったカモシレナイ

具体的にどんな内容だったかとかは、誰かが書くでしょうし、各々USTとか見て頂ければ良いかと思いますので、 本記事では各言語について、個人的に感じた事とか考えたこととか、つらつらと書いて行こうかと思います。

Delphi (@pikさん担当)

リッチなGUIじゃんけんゲームで会場を沸かせたのが、セッションオーナーでもある@pikさんによるDelphiの紹介でした。 IDE等の環境周りが充実していて・・・いや、実際GUIの開発はVisualStudioよりも良さげな雰囲気を感じました。

ちょっと興味持って触ってみた時(10年近く前の話)はWindowsアプリケーション作るのに使える、VBみたいな開発環境くらいに思ってたのですが、 今はWindowsはもちろん、iOS/Android双方に対応したネイティブアプリの開発が出来たりするのですね。
今回紹介された言語の中では一番とっつきやすいものだと思います。言語自体も明快で余計なものがついて無さそうな所が好感度高いです。

開発環境はEmbarcaderoのページから購入できるっぽいですよー。
http://www.embarcadero.com/jp

Clojure (@eseharaさん担当)

@eseharaさんによるLisp方言Clojureの紹介。プレゼンが面白かったで賞大賞を授与します。

Clojure使いはClojureが無くなったら皆LispじゃなくてHaskellやります。」
「論理型言語の事忘れてませんかっ!?」

と、色々と予想の斜め上を行く発言で楽しませて頂いて・・・あっ、もちろん、Clojureの紹介もバッチリでしたよ!!
JVM上で動作し、Javaの膨大な資産使いたい放題の時点で既にそうですが、関数名であるとか名付けであるとか、随所に「実用性」への意識が見られる、異色のLispという印象を受けました。

(当店では「Lispは実用言語だ!」みたいなそういうマサカリは受け付けておりません。)

ポール・グレアムさんのエッセイ、僕は大好きですし、Lispは魅力的な言語だと思うのですが、 もう一息、あえてGroovyでなくScalaでなくClojureを使うべき理由!のようなアピールがあると良かったかなぁと思いました。

Clojureの導入は以下が参考になりそうです。
http://clojure.org/getting_started

F# (@igetaさん担当)

Haskellガチ勢としては無視できないのがこちら、OCamlをベースにして作られた.NET Framework向けの関数型/オブジェクト指向プログラミング言語です。@igetaさんが紹介して下さいました。 言語としてのアプローチは今回の言語の中では一番Haskellに近く、強い型付けや関数プログラミングによる安全性をベースとして、 .NET上の資産使いたい放題というのが強みでは無いでしょうか。

何よりマイクロソフトによって開発が勧められ、MSDN2012以降には標準搭載というのが素晴らしいです。 やはりVisualStudioは優れていますし、とにかくめちゃくちゃ普及したIDEなので、 今後大きく流行る可能性のあるプログラミング言語という事で、とても注目しています。

MSDNをさくっと購入できる方は良いのですが、無料で使いたい!という方も多いかと思います。 導入方法が書かれたブログを見つけたのでペタっと貼っておきますねー。
http://d.hatena.ne.jp/Nobuhisa/20100905/1283678443

う、Ubuntuの場合はどうするのが一番良いですかっ?

Smalltalk(@umejavaさん担当)

オブジェクト指向の本家本元と言えばこちら、Smalltalkです。 本セッションは、@umejavaさんによるSmalltalkの紹介が一人勝ち状態でしたね・・・。

すいません、ちゅーんさん実際、オブジェクト指向ナメてました。
OOって、環境の中にオブジェクトを配置してメッセージをやり取りさせる、というイメージが先行していたのですが、 Smalltalkは「環境の中に飛び込んでそこからオブジェクトを構築する」というイメージだそうで、 何度も会場を沸かせた超動的なプログラミング環境は、本当に必見ですお。

いじってみたい人は、以下を参考にすれば良さそうな感じー。
http://msugai.fc2web.com/pgm/smalltalk.html

Haskell (誰が担当だって?俺だよ、俺)

はい、んで、向かって右から二番目の席でHaskellの話をモニョモニョしていた冴えないにーちゃんがちゅーんさんです。 Trifectaという、Pasecをベースにしたパーサライブラリを使って、「ドヤァ」とかしたかったのですが、 時間とかの関係でパーサコンビネータのApplicativeスタイルの説明とかほとんどマトモに出来てなかった希ガス・・・げふんげふん

まぁ、色々と言い訳はあるのですが、Haskellの良さってやっぱり、純粋さや型付けによって得られる安全性を維持しつつ、 強力な抽象力や柔軟性を得ている部分にあると思うのですよ。
なので、やっぱり書いて感じて頂けるのが一番なのかなぁ、とか思ったります。

最初は硬いけど、噛めば噛むほど味が出る、スルメのような言語、Haskellを、是非是非使ってみてくらはい!
http://www.haskell.org/platform/

反省点

僕の出した数式パーサーの問題もそうですが、一つ一つのお題がハードになってしまったため、 時間等々の関係で解法の紹介で踏み込んだ話ができなかったのは惜しかった気がします。(それでもやり切れなかったですし)
本番の事考えると、数行で作れるような簡単なお題のほうが、ブログとかにも手軽に載せられたりしますし、良かったかもしれませんね・・・。

セッションの性質上、やっぱりIDE等の環境周りで「見せ」られるDelphiやSamlltalkが強かった印象。 言語そのものや思想の差まで踏み込んだ議論ができなかったのはHaskellerとしては残念だったかも。

紹介やお題はほどほどにして、さまざまなテーマでディスカッションをする時間を作れるともっと面白くなっていたかもしれませんね。

マイナー言語って言うな!

Haskellはマイナー言語じゃねぇ!!と言いたいのはHaskeller達の心の叫びではあったりして・・・ 実際、登壇の依頼を受けた時、心の中で思ったりとかしたんですが、えーと?

やはり、仕事を通して知ってる人には、あまり会う事が無いですし、ツイッターのTLでも知ってるけど使ってない人、多いです。 この辺は、5言語何れにも当てはまる問題なので、セッション中に出来ると盛り上がっていたかもしれないお話。

実際の開発に導入しようとかいう話になってくると、技術者が少ない事がネックになってしまうのですよね、 偉い人達にしてみれば「出来上がったシステムを誰がメンテするの?あんた一生面倒見てくれる?」という事になってしまうのです。

Haskellでも例えば、ある程度権限のある人だったら積極的に導入を進めたりとかしているようです。 あとはやっぱり、コミュニティを通して広めていくしか無いのでしょう。


とまぁ、こんな感じで、なんやかや無事に言語CROSSを終える事ができました。 冒頭でも書きましたが、普段関わりの薄いジャンルや言語の人達とお話できたのはとても良い経験となりました。

得に、何度も書きますがSmalltalkは、「動的」という言葉の意味について色々と考えさせてくれました。ちょっといじってみようと思います。

ではでは、楽しい時間をありがとうございましたm(_ _)m

法事なので忌日表作ります

FuniSaya Advent Calendar 2013 21日目です。昨日はだまんさんの穴を掘る、池を作るでした。

つい先日、身内に不幸がありまして、海外のコメディドラマ顔負けのドタバタを繰り広げたりしていたわけですけども ・・・あ、ドラマとかはあんま見ないんですが。 そんなドタバタも一段落ついて、n年ぶりくらいに母ゆっくりとした時間を過ごしたりとか過ごしてなかったりとかする今日このごろです。

ども、凝り固まった背中にフェルビナクがよく効きます。おっさん化の著しいちゅーんさんです。

最近ちょいとしたブログネタを仕入れたのもあり、さっきまでゴニョゴニョと関連資料を読み漁ったりしていたのですが、 ふとツイッターを見ると、我らがさっちゃん(@ne_sachirou)からリプライを貰っていた事に気がついたのです。

ええ、すっかり忘れてました、アドベントカレンダーです。
今書こうと思ってるネタはどう考えても今日中に記事にできそうな感じでは無いですし、さてどうしましょう。

ネタ決め

  • 俺「wsでrftgyふじこlp;@
  • 母「どうした息子よ
  • 俺「ネタが無い
  • 母「何の
  • 俺「アドベントカレンダー
  • 母「アドベントカレンダー?それは何だ、食えるのか
  • 俺「食えないよ。かくかくしかじか。
  • 母「そうか、じゃぁネタをやろう
  • 俺「うおお、かあちゃんの背後に後光が見える
  • 母「かあちゃんはまだ健在だ。ホレ
  • 俺「これは何だ
  • 母「忌日表
  • 俺「はぁ
  • 母「これを作ってブログに書けば良いじゃない、直ぐできそうだしタイムリーだし面白い記事が書けそうだろ?
  • 俺「なるほど、そうする。

全然関係ない話ですが、「忌日表」の読みが安定しません。母は「きじつひょう」と呼んでいたけど、ググってみたら「きにちひょう」とか「きんちひょう」 の方が正しそうです。まぁ、僕は男の子なので細かいことは気にしないでおきましょう。

Haskellでは日付を扱うのにtimeパッケージのData.Timeとかいうモジュールをがあるのですが、 そういえば、使ったことが無かったので、練習がてら、命日を入力すると忌日表を作成するようなツールを作ってみます。

どうしてこうなった。

Data.Timeモジュールの使い方

Data.TimeモジュールはData.Time.Calenderというモジュールをエクスポートしており、その中にDayという型が定義されています。
Dayの定義は以下のようになっており、データコンストラクタModifiedJulianDayに修正ユリウス通日を指定すれば得ることができます。

*Main> :i Day
newtype Day = ModifiedJulianDay {toModifiedJulianDay :: Integer}
    -- Defined in `time-1.4.0.1:Data.Time.Calendar.Days'
instance Enum Day
  -- Defined in `time-1.4.0.1:Data.Time.Calendar.Days'
instance Eq Day
  -- Defined in `time-1.4.0.1:Data.Time.Calendar.Days'
instance Ord Day
  -- Defined in `time-1.4.0.1:Data.Time.Calendar.Days'
instance Read Day
  -- Defined in `time-1.4.0.1:Data.Time.Format.Parse'
instance Show Day
  -- Defined in `time-1.4.0.1:Data.Time.Calendar.Gregorian'
instance ParseTime Day
  -- Defined in `time-1.4.0.1:Data.Time.Format.Parse'
instance FormatTime Day -- Defined in `Data.Time.Format'

修正ユリウス通日とか良くわからないですが、適当な数値を入れまくって探してみた所、今日は1858年11月17日から56647日目なんだそうです。へーすごい。
ちなみに計算の仕方とかはWikipediaに色々書いてあるっぽいです。面倒くさいのでちゃんと見てないですが。

*Main> ModifiedJulianDay 56647
2013-12-21

単純にshowすればグレゴリオ暦で表示してくれるのですが、データとしてグレゴリオ暦に変換したり、グレゴリオ暦からDay型の値を取得したい場合、 toGregorian関数、fromGregorian関数を使えば良いっぽいです。

*Main> toGregorian $ ModifiedJulianDay 56647
(2013,12,21)
*Main> toModifiedJulianDay $ fromGregorian 2013 12 21
56647

日数を加算するにはaddDays関数、二つのDay型の値から経過日数を計算するにはdiffDays関数を使います。

*Main> addDays 11 $ fromGregorian 2013 12 21
2014-01-01
*Main> diffDays (fromGregorian 2014 1 1) (fromGregorian 2013 12 21)
11

年/年単位で加減算するにはaddGregolianMonths*関数およびaddGregolianYears*関数を使います。 日が溢れた場合の処理によって使い分けが必要みたい。

*Main> addGregorianYearsClip 1 $ fromGregorian 2016 2 29
2017-02-28
*Main> addGregorianYearsRollOver 1 $ fromGregorian 2016 2 29
2017-03-01
*Main> addGregorianMonthsClip 1 $ fromGregorian 2016 3 31
2016-04-30
*Main> addGregorianMonthsRollOver 1 $ fromGregorian 2016 3 31
2016-05-01

この辺の作りの自明さはとてもHaskellっぽくて好きです。ではさっそく、忌日表を計算するプログラムを書いていきましょう。

作る

とりあえず何も考えずに手元にある生忌日表を元に忌日のデータを作ってきます。

type Kinchi = (String, (Integer, Integer, Integer))
kinchis :: [Kinchi]
kinchis =
  [ ("七七忌" , (0 ,0 ,48))
  , ("1周忌"  , (1 ,0 ,0 ))
  , ("3回忌"  , (2 ,0 ,0 ))
  , ("7回忌"  , (6 ,0 ,0 ))
  , ("13回忌" , (12,0 ,0 ))
  , ("17回忌" , (16,0 ,0 ))
  , ("23回忌" , (22,0 ,0 ))
  , ("27回忌" , (26,0 ,0 ))
  , ("33回忌" , (32,0 ,0 ))
  , ("37回忌" , (36,0 ,0 ))
  , ("50回忌" , (49,0 ,0 ))
  ]

なんか、ちゃんと作ろうとすると法要の日数の数え方って命日の前日から数える場合と当日から数える場合とあるっぽいです。
今日は面倒なので手元にある忌日表そのまんま出せるように作ってきます。Haskellなので改修には強いですし、うるう年の扱いとかもとりあえずいいや。

で、計算処理をぽちぽち・・・

calcKinchi :: Kinchi -> Day -> (String, Day)
calcKinchi (n, (y, m, d)) = (,) n . addDays d . addGregorianMonthsClip m . addGregorianYearsClip y

calcKinchis :: [Kinchi] -> Day -> [(String, Day)]
calcKinchis ks d = map (flip calcKinchi d) ks

main関数実装。 例外処理?なにそれ美味しいの?

printKinchis :: [(String, Day)] -> IO ()
printKinchis = mapM_ putStrLn . map (\(n, d) -> n ++ " - " ++ show d)
  
main :: IO ()
main = do
  putStrLn "命日を入力してちょ(\"yyyy-mm-dd\")"
  meinichi <- return . read =<< getLine
  printKinchis $ calcKinchis kinchis meinichi

出来た!

命日を入力してちょ("yyyy-mm-dd")
2013-12-21
七七忌 - 2014-02-07
1周忌 - 2014-12-21
3回忌 - 2015-12-21
7回忌 - 2019-12-21
13回忌 - 2025-12-21
17回忌 - 2029-12-21
23回忌 - 2035-12-21
27回忌 - 2039-12-21
33回忌 - 2045-12-21
37回忌 - 2049-12-21
50回忌 - 2062-12-21

え、戒名?知るかっ!

まとめ

あー、なんと言いますか。
びっくりするほど技術的に面白いこと無いです。
多分実装するのにかかった時間より、この記事をおもしろおかしくするのにかかった労力のほうが大きいんじゃないかとか、そんな気もします。

まぁ、人生いつ何があるかわかりませんし、こういったものを用意しておくと役に立つ事も・・・

無いかな(´・ω・`)

次回はYoshiaki Kurekawaさんです。

蛇足

英語できない

Haskellerがふか〜いネストと戦う話

書きたいネタは色々あるのですが、どれもこれもやたら重くてなかなか筆が(キーボードが)進まないので、
今日は軽く、仕事で思いつきで作ってみたものの話をします。

モダンな言語を使ったシャレオツな設計に慣れてしまうと、なんというか、 下請けプログラマ特有のあのなんとも言えないコードを読むのが苦痛に感じてしまうものです。

ましてやHaskellerにとって、5000行のクラスの中の600行のメソッドだとか、その中のループと分岐と例外処理が入り乱れた11重ネストはもう、 苦行以外の何物でもなく、「なんなの?マジなんなのこれ?罰なの?Sガストの竜田揚げに備え付けのポン酢ではなく、 醤油と七味唐辛子をかけて食べた罪に対する天罰なの?」と、意味もなく天を仰いで祈りを捧げたり捧げなかったりとかするわけです。

えー・・・つまりですね、

こんなん読めるかボケェ(╯°□°)╯︵ ┻━┻

と、こういう事が言いたいわけです。はい。

プログラマがコードを読めないというのは色々とアレなアレがアレとは申しますが、とにかく辛いのでできれば読みたく無いのです、が、 そんな事言っているうちに障害管理表には項目が増えていく一方なので、とりあえずなんかこう、なんか、どうにかしようと思ったわけですよ、はい。

何がどーなれば良いのか

結局の所、いわゆるスパゲティだかラーメンだかと呼ばれているアレの問題は、全体の構造がまったくつかめない事にあるので、 とにかく、ネストだとか関数呼び出しだとかの階層の地図を描きたいわけです。 勿論、世の中にはそういうのを上手いことやってくれちゃう凄いソフトがあったりもするのかもしれませんが、 自分の周りに使ってる人とか居ないし、ちょっとググった感じだと見つけられなかったので、結局自力でなんとかする事にします。

感覚としては、自然言語混じりの擬似言語のようなもので、プログラムの何処で何をやっているか、 という事をメモ取りながら読み進めていくとわりと整理しやすいのですが、スケールや目的によって欲しい粒度だとかが全然違う事になったり、 同じコードのメモを何度も取るハメになったり、そもそも長期的な記録としては役に立たないとか色々と悩ましい問題があったりします。

そういったのを直感的に記述していって、かつ自在にスケールしたり、必要な情報だけ抽出できるようにしたいワケです。 プログラムでプログラムの情報を柔軟に扱うためには、構文木そのものをデータとして保持するのが良いのですが、 大抵の言語の場合、木のデータを作ってもそれを構築するための手段が無かったりするのですよね。

構文木と言えばFree

木のような代数的な構造を扱う問題に対して、Haskellはかなり優秀です。

今回のように、インタプリタコンパイラを作るわけではないけどとにかく「構文木」が欲しい場合、Freeモナドが便利です。 (Operationalというヤバイモナドもありますが、 構文木そのものを柔軟に扱うのが目的なので操作しやすいFreeを使います。)

早速基礎となるデータ構造を作り、モナドとして使えるようにしてやりましょう。

data PTreeData a
  = PSummary String a
  | PIf String (PTree ()) a
  | PLoop String (PTree ()) a
  deriving (Show, Read, Eq, Ord, Functor)

type PTree a = Free PTreeData a

psum :: String -> PTree ()
psum s = liftF $ PSummary s ()

pif :: String -> PTree () -> PTree ()
pif s t = liftF $ PIf s t ()

ploop :: String -> PTree () -> PTree ()
ploop s t = liftF $ PLoop s t ()

Freeモナドにすれば、後はdo記法で普通に手続きプログラムのように書いていけば良いだけなので、 レガシーを元に、メモを取る感覚で要約しながら写経すれば良いだけです。簡単簡単。

ためしに、次のようなデータを作って、ghciで構文木が組み立てられている事を確認してみましょう。
(プログラムに意味は無いです)

test :: PTree ()
test = do
  psum "初期化処理"
  pif "データAが0件でない場合" $ do
    ploop "データA全件走査" $ do
      pif "データBが0件でない場合" $ do
        ploop "データB全件走査" $ do
          pif "データAとデータBが等しい場合" $ do
            psum "データCにデータAとデータBのリンク情報を追加する"
      pif "データBが0件の場合" $ do
        psum "データAののループを抜ける"
  ploop "データC全件走査" $ do
    psum "データCの情報を画面に出力する"
  psum "終了処理"
*Main> test
Free (PSummary "\21021\26399\21270\20966\29702" (Free (PIf "\12487\12540\12479A\12364\&0\20214\12391\12394\12356\22580\21512" (Free (PLoop "\12487\12540\12479A\20840\20214\36208\26619" (Free (PIf "\12487\12540\12479B\12364\&0\20214\12391\12394\12356\22580\21512" (Free (PLoop "\12487\12540\12479B\20840\20214\36208\26619" (Free (PIf "\12487\12540\12479A\12392\12487\12540\12479B\12364\31561\12375\12356\22580\21512" (Free (PSummary "\12487\12540\12479C\12395\12487\12540\12479A\12392\12487\12540\12479B\12398\12522\12531\12463\24773\22577\12434\36861\21152\12377\12427" (Pure ()))) (Pure ()))) (Pure ()))) (Free (PIf "\12487\12540\12479B\12364\&0\20214\12398\22580\21512" (Free (PSummary "\12487\12540\12479A\12398\12398\12523\12540\12503\12434\25244\12369\12427" (Pure ()))) (Pure ()))))) (Pure ()))) (Free (PLoop "\12487\12540\12479C\20840\20214\36208\26619" (Free (PSummary "\12487\12540\12479C\12398\24773\22577\12434\30011\38754\12395\20986\21147\12377\12427" (Pure ()))) (Free (PSummary "\32066\20102\20966\29702" (Pure ()))))))))

一行にダラダラダラーと出力されてしまい、しかも文字列が残念な感じになってしまうのでとても解りづらいですが、 ちゃんとtest関数を元に擬似プログラムのデータができていそうです。

出力処理を作る

実際に使う際にはは、呼び出し範囲の広い変数の宣言や使用箇所を記述したり、例外処理を記述できるようにしたり、メソッド呼び出し等の構文を追加すると良いでしょう。

これで、例外を除いた単純の処理構造を抽出したり、ループだけ抜き出してオーダー計算に活用したりと、プログラムから好きに操作できるようになりました。
問題は、このままではせっかく整えたデータが恐ろしく読みづらい(というか読めない)という事です。

ので、綺麗に整えて表示する関数をちゃちゃっと作ってやります。

printPTree :: PTree () -> IO ()
printPTree = mapM_ putStrLn . layoutPTree 0
    
layoutPTree :: Int -> PTree () ->  [String]
layoutPTree c  (Pure ()) =  []
layoutPTree c (Free (PSummary s n)) = (makeIndent c ++ "// " ++ s) : layoutPTree c n 
layoutPTree c (Free (PIf s t n)) =  layoutPTree' c "If" s t n
layoutPTree c (Free (PLoop s t n)) =  layoutPTree' c "Loop" s t n

layoutPTree' :: Int -> String -> String -> PTree () -> PTree () -> [String]
layoutPTree' c s1 s2 t n 
  = concat [makeIndent c, s1, " `", s2, "'"] : layoutPTree (c + 1) t ++ layoutPTree c n

makeIndent :: Int -> String
makeIndent = flip replicate ' ' . (4*)

んで、出来上がった構文木printPTreeに渡してやれば、綺麗に整えられて出力される。とゆーわけ。ね、簡単でしょ?

*Main> printPTree test
// 初期化処理
If `データAが0件でない場合'
    Loop `データA全件走査'
        If `データBが0件でない場合'
            Loop `データB全件走査'
                If `データAとデータBが等しい場合'
                    // データCにデータAとデータBのリンク情報を追加する
        If `データBが0件の場合'
            // データAののループを抜ける
Loop `データC全件走査'
    // データCの情報を画面に出力する
// 終了処理

終わりに

これって、二重管理じゃね?って言われると返す言葉無いわけですよ(´・ω・`)
本当はこんな事しなくても良いように作り変えられれば良いのですが、既に稼働している大規模システムだとそーもいかず・・・

どうせ負の資産を増やすならばなるべく(自分が)扱いやすい形で、という事を考えたら結果こうなりました。

あ、もしレガシーコード(C#ダヨー)の中を自由に泳ぎ回れるようなすんごいツールあったら教えてくらはい。多分喜びのあまり泣きます。