実は persistent のスキーマ定義で、テーブル名の横に json と書くだけで ToJSON, FromJSON が定義されることが判明

な、なんだってー (AA略
きっかけは昨日の yesod 勉強会での @ffu_ さんの発表 https://speakerdeck.com/u/fujimura/p/scotty-aeson-persistentjson-web-api
詳しくはスライドを見てもらうとして、要約すると persistent で自動的にテーブル定義に対応して生成されるデータ型を ToJSON, FromJSON のインスタンスにしてやれば RESTful な JSON API が簡単に作れるよねという感じだろうか。
しかし、いちいち ToJSON, FromJSON のインスタンスにしてやるのは大変面倒なので、 どうせなら TemplateHaskell で自動的に生成できたら嬉しいんじゃないかという話になった。
そんなこんなでつらつらと persistent のソースコードを眺めていたら、 mkJSON などという関数を発見してしまったわけです。 発見した当初は驚きのあまり現行のバージョンだとまだモジュールからエクスポートされていないので、 使えない実験的な機能なのかと誤読してましたが、実は現行のバージョンで既に使えることが判明。
使い方は簡単。テーブル名の横に json と書き加えるだけ。

share [mkPersist sqlSettings] [persist|

Person json

  name Text

|]

これだけで、Person は ToJSON, FromJSON のインスタンスになる。 こんな機能ドキュメントや yesod blog とかで見た記憶はないのですが……
せっかくなので実装をちょっとだけ追ってみます。

GNU screen ユーザから見た tmux の良いところ

screen(だけ)の時代は終わり。tmuxでリモートコンソールを便利に使うTips - アシアルブログ によると GNU screen の時代は終わってしまったようです。しかしブックマークコメントあたりでも指摘されているように、この記事で挙げられている大体のことは screen でも実現可能なので乗り換える理由としては微妙です。開発版の screen であれば縦分割やマウス操作もできます。開発版 screen については これからの「GNU Screen」の話をしよう - Keep It Simple, Stupid を参考にすると良いでしょう。
かといって、GNU screen だけ使いつづけていると老害の誹りを受けかねないので、ちょっとだけ tmux 入門して気にいったところを紹介していきます (つづく？)

show-environment

X11 forwarding や SSH agent forwarding をしてログインした際に screen のセッションにアタッチすると、DISPLAY や SSH_AUTH_SOCK といった環境変数が引き継がれずに困ることがあります。私の場合、screen を使う際に環境変数を書き出すスクリプトを用意して必要に応じて読み込んでいましたが、tmux だと show-environment / update-environment という機能があることを知りました。

tmux は、tmux サーバが起動されたときの環境変数をグローバル環境変数に格納するのに加えて、セッション毎にもセッション環境変数を管理しています。新しいウインドウを作る(C-b c)際には、これらの環境がマージされたものが環境変数として子プロセスに渡されます。セッション環境変数を確認するには tmux show-environment を使います。

$ tmux show-environment
DISPLAY=:0.0
SSH_AGENT_PID=6527
-SSH_ASKPASS
SSH_AUTH_SOCK=/tmp/keyring-TohlaR/ssh
-SSH_CONNECTION
WINDOWID=81788933
XAUTHORITY=/var/run/gdm3/auth-for-hogefuga-Rp6XuK/database

セッション環境変数として保存する環境変数は update-environment オプションで指定することができます。デフォルトでは DISPLAY SSH_ASKPASS SSH_AUTH_SOCK SSH_AGENT_PID SSH_CONNECTION WINDOWID XAUTHORITY が保存されます。

セッション環境変数はセッション毎に管理されるので、例えば複数のマシンから同時に ssh -X して tmux にアタッチしている場合にも tmux show-environment は、それぞれのマシンの DISPLAY の値を出力してくれます。tmux の中にいるかどうかは TMUX_PANE 環境変数の有無などで確認できるので、zsh の precmd などで tmux show-environment から環境変数へ反映させるようにしておくと良いでしょう。

ペーストバッファがスタック

けつろん

けっきょく慣れ親しんだ screen しか使ってません。自分の環境で安定してる方を使えば良いんじゃないでしょうか。他に tmux のこんなところが便利というのがあったら教えてください。

僕のあとで読むをおまえが読め

screen / tmux 使いはここらへん見ると幸せになれるかもしれません。

• ターミナルマルチプレクサ Advent Calendar 2011 : ATND
• Keep It Simple, Stupid: screen

作ってみよう Enumerator - http-enumerator で Twitter API ぺろぺろ

これは Haskell Advent Calendar 2011 17 日目の参加記事です。
Iteratee 戦国時代らしいですね。Iteratee like なパッケージは現時点でも既に iteratee、 enumerator、 iterIO の三つがあり、それに加えて、 最近 Conduit が新たに作られ、現在も積極的に開発が進んでいるようです。
Iteratee の概念や Iteratee like なライブラリの作り方については

• Lazy I/O must go! - Iteratee: 列挙ベースのI/O - 純粋関数型雑記帳
• Enumerator Package – Yet Another Iteratee Tutorial : Preferred Research
• iterateeとは何か、何が良いのか - www.kotha.netの裏

を、具体的な使い方については

• 使ってみよう Enumerator - あどけない話
• Enumeratorは終了条件の検査からの解放だ - あどけない話

を見ると良いと思います。Haskell Advent Calendar 2011 でも [twitter:@melponn] (id:melpon) さんが記事を書いていますので参考にしてください。
今回は、enumerator パッケージをベースに Twitter API ぺろぺろするライブラリを作りつつ、 Iteratee の使い方を覚えようという話をしようと思います。

概要

Twitter API の lists/members などの API には一度に取得できるデータ件数には上限があり、 それ以上のデータが必要な場合には、取得したデータの中に残りのデータをを取得するための next_cursorというパラメータが含まれているので、 その next_cursor を cursor パラメーターとして指定して GET リクエストを送信、次のページの cursor を取得という作業を繰り返します。 それ以上データが無い場合には next_cursor は 0 になるので、0 になったらそこで終了するようにします。
この、データ取得を繰り返す部分を Enumerator として抽象化して、 必要に応じてデータを取得するようにしたいと思います。
例えば、ユーザ thimura の haskell リストから、最初の 40 個を取得したい場合

lst <- run_ $ listsMenbers "thimura" "haskell" $$ EL.take 40

のように使えるようなライブラリを作ってみましょう。
今回は、enumerator パッケージの他に、http-enumerator パッケージと、 authenticate パッケージ、 aeson パッケージを使います。

下準備

まず、足周りの部分から作りましょう。 twitter の OAuth トークンや、HTTP の接続を管理する Manager は ReaderT モナドに保持させることにします。

type TW = ReaderT TWEnv IO

data TWEnv = TWEnv
             { twOAuth :: OAuth
             , twCredential :: Credential
             , twManager :: Maybe Manager
             }

runTW :: TWEnv -> TW a -> IO a
runTW env st =
  case twManager env of
    Nothing -> withManager $ \mgr -> runReaderT st $ env { twManager = Just mgr }
    Just _ -> runReaderT st env

Twitter API へのアクセスはこの TW モナドの中で行ないます。 次に、この TW モナドの中で Twitter API にアクセスする関数たちを定義します。 Iteratee の内部のモナドとして先ほど定義した TW モナドを利用します。 型 a を入力として受けとり、型 b の結果を返す Iteratee の型は

Iteratee a TW b

となります。これを run_ した場合の戻り値は TW b 型になります。
http-enumerator パッケージの Network.HTTP.Enumerator.http 関数をラッピングする httpMgr 関数を次のように定義します。

httpMgr :: Request IO
        -> (HT.Status
            -> HT.ResponseHeaders
            -> Iteratee ByteString IO a)
        -> Iteratee ByteString TW a
httpMgr req iter = do
  mgr <- lift . asks $ twManager
  liftTrans $ http req iter mgr

http 関数は MonadIO 型クラスのインスタンスであれば IO 以外でも使えますが、 authenticate パッケージの signOAuth 関数の型が

signOAuth :: OAuth -> Credential -> Request IO -> IO (Request IO)

になっているため httpMgr では Request IO 型を受け取るように定義にしています。 そのため http req iter mgr の型が

Iteratee ByteString IO a

となるため Iteratee の基盤のモナドを IO から持ち上げてやる操作が必要になります。 Iteratee は liftTrans を使うと持ち上げが可能です。
今作った httpMgr 関数を使って API へのアクセスを行なう関数を定義します。

api :: String -> HT.Query -> Iteratee ByteString IO a -> Iteratee ByteString TW a
api url query iter = do
  req <- lift $ apiRequest url query
  httpMgr req (handleError iter)
  where
    handleError iter' st@(HT.Status sc _) _ =
      if 200 <= sc && sc < 300
      then iter'
      else throwError $ HTTPStatusCodeException st

signOAuthTW :: Request IO -> TW (Request IO)
signOAuthTW req = do
  oa <- getOAuth
  cred <- getCredential
  liftIO $ signOAuth oa cred req

apiRequest :: String -> HT.Query -> TW (Request IO)
apiRequest uri query = do
  req <- liftIO $ parseUrl uri >>= \r -> return $ r { queryString = query }
  signOAuthTW req

ここで、ライブラリが投げる例外を次のように定義しておきます。

data TwitterException = HTTPStatusCodeException HT.Status
                      | PerserException SomeException [ByteString]
                      | TwitterErrorMessage T.Text Value
                      deriving (Show, Typeable)
instance Exception TwitterException

HTTPStatusCodeException は既に api 関数で使っているように、HTTP ステータスコードが 200 番台以外の場合に投げられる例外です。 他に、Twitter から送られてきた JSON のパースに失敗した場合の PerserException と、 Twitter がエラーメッセージを送ってきた場合に利用する TwitterErrorMessage を定義しています。

Cursor をパースする

冒頭でも書きましたが、 lists/members.json を含むいくつかの API は、全てのデータが必要な場合には cursor パラメータを指定する必要があります。
Twitter からは

    {
      "previous_cursor": 0,
      "previous_cursor_str": "0",
      "next_cursor": 0,
      "next_cursor_str": "0"
      "users": [ ...(略)... ],
    }

のような JSON が返ってきます。JSON のパースには aeson パッケージを使うことにします。
まず、

data Cursor a =
  Cursor
  { cursorCurrent :: [a]          -- ^ データを格納する
  , cursorNext :: Maybe Integer   -- ^ 次のデータを取得するための cursor
  } deriving (Show, Eq)

のように Cursor 型を定義しておきます。
通常 aeson を使う場合は Data.Aeson が便利すぎる件 - melpon日記 - HaskellもC++もまともに扱えないへたれのページ にもあるように Cursor a を FromJSON 型クラスのインスタンスにしますが、 データを格納している JSON のフィールド名は、"users" 以外にも "ids" などの場合があるので、 応用が効くように通常の関数として次のように定義します。

parseCursor :: FromJSON a => T.Text -> Value -> AE.Parser (Cursor a)
parseCursor key (Object o) =
  checkError o
  <|>
  Cursor <$> o .: key <*> o .:? "next_cursor"
parseCursor _ v@(Array _) = return $ Cursor (maybe [] id $ AE.parseMaybe parseJSON v) Nothing
parseCursor _ o = fail $ "Error at parseCursor: unknown object " ++ show o

checkError :: Object -> AE.Parser a
checkError o = do
  err <- o .:? "error"
  case err of
    Just msg -> throw $ TwitterErrorMessage msg (Object o)
    Nothing -> mzero

リクエストに問題がある場合には error フィールドを持つ JSON が返されるので、 それをパースして例外を送出する checkError 関数を定義しておきます。 checkError 関数はエラー以外の場合は mzero を返すように定義しているので、 エラーではない場合の処理と Alternative (<|>) で自然に連結することができます。
いま定義した parseCursor を使って Cursor をパースする Iteratee を定義します。

iterCursor' :: (Monad m, FromJSON a) => T.Text -> Iteratee Value m (Maybe (Cursor a))
iterCursor' key = do
  ret <- EL.head
  case ret of
    Just v -> return . AE.parseMaybe (parseCursor key) $ v
    Nothing -> return Nothing

iterCursor :: (Monad m, FromJSON a) => T.Text -> Iteratee ByteString m (Maybe (Cursor a))
iterCursor key = enumLine =$ enumJSON =$ iterCursor' key

ここで enumLine , enumJSON は Enumeratee で、

enumJSON :: Monad m => Enumeratee ByteString Value m a
enumJSON = E.sequence $ iterParser json

enumLine :: Monad m => Enumeratee ByteString ByteString m a
enumLine = EB.splitWhen newline
  where newline x = (x == 10) || (x == 13)

のように定義してあります。 E.sequence は Iteratee を引数に与えると、入力をその Iteratee に与え、 その結果を次の Iteratee に渡す Enumeratee を作る関数です。

Iteratee のエラー処理をする

さきほどの iterCursor の定義でも十分動作するのですが、 aeson が JSON のパースに失敗した場合に返すエラーは分かりづらく、 パースに失敗したときの入力内容もわかりません。
そこで、iterCursor を変更して、JSON のパースに失敗した場合、 パースに失敗したときの入力内容をエラーに含めるようにします。

iterCursor :: (Monad m, FromJSON a) => T.Text -> Iteratee ByteString m (Maybe (Cursor a))
iterCursor key = enumLine =$ handleParseError (enumJSON =$ iterCursor' key)
    
handleParseError :: Monad m => Iteratee ByteString m b -> Iteratee ByteString m b
handleParseError iter = iter `catchError` hndl
  where
    getChunk = continue return
    hndl e = getChunk >>= \x -> case x of
      Chunks xs -> throwError $ PerserException e xs
      _ -> throwError $ PerserException e []

catchError は Iteratee がエラーを返した場合、第二引数に渡された handler を呼びだし、 handler が返した Iteratee に処理をまかせます。
私はちょっと悩みましたが、エラーを起こした場合の入力が必要な場合には、 handler が「入力をひとつだけ受けとってエラーを返す Iteratee」を返すことで達成することができます。

list を取得する Enumerator を作ってみる

下準備も済んだので、いよいよ今回の目的の Enumerator 部分を作ります。
cursor を返す API をラッピングして、Enumerator にする apiCursor を次のように定義します。

apiCursor
  :: (FromJSON a, Show a) 
  => String      --- ^ API の endpoint
  -> HT.Query    --- ^ QueryString
  -> T.Text      --- ^ データが格納されている JSON のフィールド名
  -> Integer     --- ^ 初期の cursor
  -> Enumerator a TW b
apiCursor uri query cursorKey initCur =
  checkContinue1 go initCur
  where
    go loop cursor k = do
      let query' = insertQuery "cursor" (Just . B8.pack . show $ cursor) query
      res <- lift $ run_ $ api uri query' (iterCursor cursorKey)
      case res of
        Just r -> do
          let nextCur = cursorNext r
              chunks = Chunks . cursorCurrent $ r
          case nextCur of
            Just 0  -> k chunks
            Just nc -> k chunks >>== loop nc
            Nothing -> k chunks
        Nothing -> k EOF

insertQuery :: ByteString -> Maybe ByteString -> HT.Query -> HT.Query
insertQuery key value = mk
  where mk = M.toList . M.insert key value . M.fromList

この apiCursor を使えば、lists/members.json にアクセスする Enumerator は簡単に作ることができます。 apiCursor はちょっと複雑なので解説は後回しにして、先に API にアクセスするインターフェースを作ってしまいましょう。

listsMembers :: ByteString -> ByteString -> Enumerator User TW a
listsMembers user listname = apiCursor "https://api.twitter.com/1/lists/members.json" query "users" (-1)
  where query = [("owner_screen_name", Just user), ("slug", Just listname)]

ここでは Enumerator が出力する型は User 型としています。

data User =
  User
  { userId              :: UserId
  , userName            :: UserName
  , userScreenName      :: ScreenName
  , userDescription     :: T.Text
  , userLocation        :: T.Text
  , userProfileImageURL :: Maybe URLString
  , userURL             :: Maybe URLString
  , userProtected       :: Maybe Bool
  , userFollowers       :: Maybe Int
  } deriving (Show, Eq)

instance FromJSON User where
  parseJSON (Object o) = checkError o <|>
    User <$> o .:  "id"
         <*> o .:  "name"
         <*> o .:  "screen_name"
         <*> o .:  "description"
         <*> o .:  "location"
         <*> o .:? "profile_image_url"
         <*> o .:? "url"
         <*> o .:? "protected"
         <*> o .:? "followers_count"
  parseJSON _ = mzero

他の細かい型の定義は省略しますが、任意の FromJSON の型クラスのインスタンスの型が使えるので、 parseCursor や apiCursor は lists/members 以外の API にも使いまわすことができます。
JSON の型である Value 型自体も FromJSON のインスタンスなので、 もし User 型などでラップせずに生の情報が欲しい場合は型シグネチャを変更するだけで実現できます。

listsMembersRaw :: ByteString -> ByteString -> Enumerator Value TW a
listsMembersRaw user listname = apiCursor "https://api.twitter.com/1/lists/members.json" query "users" (-1)
  where query = [("owner_screen_name", Just user), ("slug", Just listname)]

Enumerator のハラワタの中を見る

では、apiCursor の中身を見てみましょう。
Enumerator を作る場合、 checkContinue0 や、引数を取る場合の checkContinue1 を用いて定義することがほとんどです。 はじめに、簡単な方の checkContinue0 を見てみましょう。checkContinue0 は次のように定義されています

checkContinue0 :: Monad m
               => (Enumerator a m b
                   -> (Stream a -> Iteratee a m b)
                   -> Iteratee a m b)
               -> Enumerator a m b
checkContinue0 inner = loop where
	loop (Continue k) = inner loop k
	loop step = returnI step

checkContinue0 は、 Enumerator と合成された Iteratee がまだデータを受けとる状態である Continue である場合はループし、 これ以上データを受けとらずに値を返す Yield や、エラー状態 Error の場合には終了する Enumerator を作ります。 checkContinue0 のリファレンスにもあるように、ある値を永久に Iteratee に流し込む Enumerator は checkContinue0 を使うと

repeat :: Monad m => a -> Enumerator a m b
repeat x = checkContinue0 $ \loop k -> k (Chunks [x]) >>== loop

のように書くことができます。 ここでの k の型は Stream a -> Iteratee a m b ですので、 入力 Chunk a もしくは EOF を受けとって Iteratee を返す関数です。
ここで、Iteratee の定義を復習しておきます。

newtype Iteratee a m b = Iteratee
	{ runIteratee :: m (Step a m b)
	}

data Step a m b
	= Continue (Stream a -> Iteratee a m b)
	| Yield b (Stream a)
	| Error Exc.SomeException

Iteratee の実体は m (Step a m b) で、runIteratee してやれば中身を取りだせることがわかります。 Step は Continue, Yield, Error のどれかの状態を保持しています。
(>>==) は、Iteratee と Enumerator を合成し、新たな Iteratee を返す演算子で、その定義を見てやると

(>>==) :: Monad m
       => Iteratee a m b
       -> (Step a m b -> Iteratee a' m b')
       -> Iteratee a' m b'
i >>== f = Iteratee (runIteratee i >>= runIteratee . f)

となっています。(>>==) の中で使われている (>>=) 演算子は Iteratee a m b の基盤のモナド m の bind です。 したがって、Enumerator と Iteratee が合成され、基盤のモナド m の処理に落しこんでいるのは Enumerator 側で行なわれていると見なせます。 したがって、Enumerator 側では、基盤となるモナド m のエラー処理を意識し、ファイルハンドルやロックなどの資源管理を適切に行なう必要があります。
今回の例では Enumerator 側では特に資源管理を意識する必要はありませんが、 実際にファイルなどの資源を管理する必要がある場合は enumFile の実装を参考にすると良いと思います。
apiCursor の実装に使っている checkContinue1 の型を見ると一見複雑に見えますが、 checkContinue0 の違いは状態を保持するための引数を渡すか否かの違いしかありません。

checkContinue1 :: Monad m
               => ((s1 -> Enumerator a m b)
                -> s1
                -> (Stream a -> Iteratee a m b)
                -> Iteratee a m b)
               -> s1
               -> Enumerator a m b
checkContinue1 inner = loop where
	loop s (Continue k) = inner loop s k
	loop _ step = returnI step

結合する Iteratee が終了しているかの判定は checkContinue1 が見てくれるので、 後は checkContinue1 の引数である inner の実装をするだけです。 apiCursor の実装では go が該当します。

go loop cursor k = do
  let query' = insertQuery "cursor" (Just . B8.pack . show $ cursor) query
  res <- lift $ run_ $ api uri query' (iterCursor cursorKey)
  case res of
    Just r -> do
      let nextCur = cursorNext r
          chunks = Chunks . cursorCurrent $ r
      case nextCur of
        Just 0  -> k chunks
        Just nc -> k chunks >>== loop nc
        Nothing -> k chunks
    Nothing -> k EOF

引数として与えられた cursor を使ってクエリを生成し API にアクセスします。 res には Maybe (Cursor a) 型の値が入っているので、 これが Just の場合は中のデータを k :: Stream a -> Iteratee a m b に渡して処理を行なった後、 nextCursor が存在し、その値が 0 でない場合は loop し、 それ以外の場合はデータを Iteratee に手渡して終了する形になっていることがわかると思います。

使ってみる

完成した listMembers を実際に使ってみましょう。 以下にサンプルを示しました。
tokens の中の oauthConsumerKey, oAuthConsumerSecret は適切なものに置き換えてください。
もし、OAuth の Consumer key などが無い場合は https://dev.twitter.com/apps/new から作成してください。

main :: IO ()
main = do
  (username:listname:_) <- getArgs
  withCred $ do
    run_ $ listsMembers (B8.pack username) (B8.pack listname) $$ EL.mapM_ (liftIO . putStrLn . userScreenName)

tokens :: OAuth
tokens = OAuth { oauthServerName = "twitter"
               , oauthRequestUri = "http://twitter.com/oauth/request_token"
               , oauthAccessTokenUri = "http://twitter.com/oauth/access_token"
               , oauthAuthorizeUri = "http://twitter.com/oauth/authorize"
               , oauthConsumerKey = "Consumer Key を取得して入力してください"
               , oauthConsumerSecret = "Consumer Secret を取得して入力してください"
               , oauthSignatureMethod = OA.HMACSHA1
               , oauthCallback = Nothing
               }


withCred :: TW a -> IO a
withCred task = do
  cred <- authorize tokens getPIN
  let env = TWEnv { twOAuth = tokens
                  , twCredential = cred
                  , twManager = Nothing
                  }
  runTW env task
  where
    getPIN url = do
      putStrLn $ "browse URL: " ++ url
      putStr "> what was the PIN twitter provided you with? "
      hFlush stdout
      getLine

authorize :: OAuth -> (String -> IO String) -> IO Credential
authorize oauth getPIN = do
  cred <- OA.getTemporaryCredential oauth
  let url = OA.authorizeUrl oauth cred
  pin <- getPIN url
  OA.getAccessToken oauth $ OA.insert "oauth_verifier" (B8.pack pin) cred

api 関数に print デバッグを仕込んで十分大きなリストを取得してみると、 必要に応じてデータが取得されている様子が分かるでしょう。

まとめ

ちょっと駆け足でしたが、Iteratee の理解するには実際に作ってみるのが一番だと思います。 最近は Conduit の開発が活発なので、これも機会があれば紹介したいです。誰かが Haskell Advent Calendar 2011 で書いてくれないかなー （ちらっ）。

今回作ったプログラムのソースコードは https://gist.github.com/1493378 にアップロードしてあります。
あと、今回作ったライブラリは twitter-enumerator という名前で Hackage に登録しています。 まだまだ開発の途中なので意見などがあれば github リポジトリ や [twitter:@thimura] 宛にでもどしどし送ってください。
明日は Template Haskell マスターこと [twitter:@mr_konn] (id:mr_konn) さんです!

persistent で JOIN

persistent という、Haskell で永続データを扱うためのライブラリがあります。基本的には non-relational なのですが、どうやら 0.5 以降の persistent では JOIN が一応取り扱えるようになっているようなので試してみました*1。この記事では、現時点での最新版 http://hackage.haskell.org/package/persistent-0.6.4 に準拠しています。

persistent の基本的な使い方は http://www.yesodweb.com/book/persistent を参照してください。

• サンプル https://gist.github.com/1379792

selectOneMany は、SelectOneMany 型を作る関数で、その中身は

selectOneMany filts get' = SelectOneMany [] [] [] [] filts get' False

data SelectOneMany backend one many = SelectOneMany
    { somFilterOne :: [Filter one]
    , somOrderOne :: [SelectOpt one]
    , somFilterMany :: [Filter many]
    , somOrderMany :: [SelectOpt many]
    , somFilterKeys :: [Key backend one] -> Filter many
    , somGetKey :: many -> Key backend one
    , somIncludeNoMatch :: Bool
    }

となっています。

selectOneMany の型は

selectOneMany
  :: ([Key backend one] -> Filter many)
     -> (many -> Key backend one)
     -> SelectOneMany backend one many

ですが、これだけ見ていてもあまり参考にはなりません。というのも、第一引数の [Key backend one] -> Filter many は単に JOIN で結合するカラム名を指定するための型情報を得るためだけに使われているようです。実際の処理を見れば一目瞭然で、[Key backend one] に対しては undefined が渡されています。

runJoin (SelectOneMany oneF oneO manyF manyO eq _getKey isOuter) = do
    conn <- SqlPersist ask
    liftM go $ withStmt (sql conn) (getFiltsValues conn oneF ++ getFiltsValues conn manyF) $ loop id
  where
    {- ... snip ... -}
    sql conn = pack $ concat
        [ "SELECT "
        , intercalate "," $ colsPlusId conn one ++ colsPlusId conn many
        , " FROM "
        , escapeName conn $ rawTableName $ entityDef one
        , if isOuter then " LEFT JOIN " else " INNER JOIN "
        , escapeName conn $ rawTableName $ entityDef many
        , " ON "
        , escapeName conn $ rawTableName $ entityDef one
        , ".id = "
        , escapeName conn $ rawTableName $ entityDef many
        , "."
        , escapeName conn $ RawName $ filterName $ eq undefined
        , filts
        , if null ords
            then ""
            else " ORDER BY " ++ intercalate ", " ords
        ]

実例を挙げながら説明します。データベースのスキーマが

share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persist|
Image
  name String
Tag
  name String
ImageTag
  imageId ImageId
  tagId TagId
|]

のように定義されている場合を考えます。ここで

	SELECT * FROM Image INNER JOIN ImageTag ON Image.id = ImageTag.imageId WHERE ImageTag.tagId = ?

のようなクエリを投げる場合は、

do
  Just (k, _) <- selectFirst [TagName ==. "tag1"] []
  results <- runJoin (selectOneMany (ImageTagImageId <-.) imageTagImageId)
    { somFilterMany = [ImageTagTagId ==. k]
    }

とすれば results に検索結果が [((ImageId, Image), [(ImageTagId, ImageTag)])] 型で格納されます。
順番に見ていくと、まずはじめに Tag.name の値が "tag1" と等しい列をひとつ取ってきて、そのキーを k に束縛しています。k の型は Key backend Tag です。
次に selectOneMany (ImageTagImageId <-.) imageTagImageId として SelectOneMany 型の値を作成します。この場合は One が Image, Many が ImageTag にそれぞれ対応するので、第一引数に [Key backend Image] -> Filter ImageTag 型の値を指定します。第二引数は ON で指定されている ImageTag.imageId カラムに対応する imageTagImageId を指定します。
WHERE 節を指定するには SelectOneMany の somFilterOne, somFilterMany に [Filter a] 型の値を指定します。ここでは tagId が k と等しいの物を取得するためレコード構文を用いて somFilterMany に[ImageTagTagId ==. k] を指定しています。
最後に、(selectOneMany (ImageTagImageId <-.) imageTagImageId) { somFilterMany = [ImageTagTagId ==. k] } を runJoin に渡せばクエリが実行されます。

M:N はいまのところ対応していないようですし、今回紹介した方法も Yesod Book にも書かれていないようなので、まだまだこれからといったところでしょう。
また、今回の例にある ImageTag テーブルには、Image や Tag テーブルと同じく primary key として暗黙の id カラムが生成されていることに注意が必要です。

*1:いまのところ、selectOneMany という名前の通り 1:N の関係しか扱えないようです

Haskell on Heroku

Heroku で Yesod が動かせると聞いたので、やや今さらな感もありますが、最近注目を集めている PaaS 型のクラウドプラットフォーム Heroku で Yesod を動かすまでのメモ。

Boost.Build @ AIX + IBM XL C/C++ (vacpp)

既に id:Cryolite 先生が http://d.hatena.ne.jp/Cryolite/20110901#p1 でやっているように、Boost.Build において、各ターゲットの種類に対してビルドプロパティの値が具体的にどのようなコマンドラインオプションに対応するかを、AIX + IBM XL C/C++ (vacpp) の場合において図示するという、やはり、私以外の誰も得をしないし、そもそも他に理解できる人が居るのかすら怪しい表を私も作ってみることにしました。

id:Cryolite 先生の表自体は私がとても便利に使わせていただきました。ありがとうございます。

基本的な見方は http://d.hatena.ne.jp/Cryolite/20110901#p1 の場合と一緒で、基本コマンド + 各ビルドプロパティに対応するオプション が実際に走るコマンドになります。
こんな表を作っておいてなんですが、$BOOST_ROOT/tools/build/v2/tools/vacpp.jam は比較的読みやすいのでわざわざこの表を参照しなくても……。

vacpp の場合、<threading> プロパティによって使うコマンドが変わります。

基本コマンド
feature	value	obj(C++)	obj(C)	lib (built shared)	lib (built static)	exe	run
threading	single	xlC -qcpluscmt -qfuncsect -c -o "target" "source"	xlc -qcpluscmt -c -o "target" "source"	xlC_r -G -o "target" "sources"	ar ru "target" "sources"	xlC -o "target" "sources"
	multi	xlC_r -qcpluscmt -qfuncsect -c -o "target" "source"	xlc_r -qcpluscmt -c -o "target" "source"			xlC_r -o "target" "sources"
オプション
feature	value	obj(C++)	obj(C)	lib (built shared)	lib (built static)	exe	run
link	shared			-bnoipath	N/A	-brtl -bnoipath
	static			N/A
runtime-link	shared
	static
runtime-debugging	on
	off
optimization	off	-qNOOPTimize
	speed	-O3 -qstrict
	space	-O2 -qcompact
profiling	off
	on	-pg		-pg		-pg
inlining (not recommended)	off	-qnoinline
	on	-qinline
	full
rtti	on	-qrtti
	off	-qnortti
exception-hadnling	on	-qeh
	off	-qnoeh
asynch-exceptions	on
	off
extern-c-nothrow	on
	off
debug-symbols	on	-g -qfullpath		-g -qfullpath		-g -qfullpath
	off			-s		-s
strip	on
	off
define	value	-Dvalue
undef	value	-Uvalue
include	path	-I"path"
sysinclude	path	-I"path"
cflags	value	value
cxxflags	value	value
fflags	value
asmflags	value
linkflags	value			value		value
arflags	value				value
version	value
flags	value
location-prefix	value
use	target
dependency	target
implicit-dependency	target
warnings	all
	on
	off
warnings-as-errors	on
	off
c++-template-depth	n
source	target
library	target
file	target
find-shared-library	value			-lvalue		-lvalue
find-static-library	value			-lvalue		-lvalue
library-path	path			-Lpath		-Lpath
name	value
tag	value
search	path
location	path
dll-path	path						LIBPATH 環境変数 (LD_LIBRARY_PATH に相当) に path を追加
hardcode-dll-paths	true					*意味無し*
	false
xdll-path	path					*意味無し*	LIBPATH 環境変数 (LD_LIBRARY_PATH に相当) に path を追加
def-file	target
suppress-import-lib	true
	false
allow	value
address-model
	32
	64	-q64		-q64	-X 64
c++abi
contditional	value
build	yes
	no
user-interface	console
	gui
	wince
	native
	auto

注意事項

ライブラリ検索パスの埋め込み

通常 Boost.Build は プログラムにライブラリ検索パスを埋め込みますが*1、AIX の場合はライブラリ検索の挙動が Linux などとは異なるため、bjam ではパスの埋め込みを行わないようです。
AIX の linker には GNU linker の -lrpath/-lrpath-link オプションと一見よく似た -blibpath オプションが存在します。しかし、このオプション指定した場合 LIBPATH (LD_LIBRARY_PATH に相当する) やシステムのデフォルトのライブラリ検索パスが無視され、-blibpath で指定したパスのみから探索が行なわれることになるようです(あってる？)。そのため、生成された実行ファイルをインストールせずに直接実行した場合は依存するライブラリが見付からず実行に失敗します。run rule から実行するか、自分で LIBPATH 環境変数を適切に設定してください。
(この記事作った理由はこれが言いたいだけだったり)

*1:install rule では <hardcode-dll-paths> feature が明示的に false にされているため埋め込みは起こりません。

LaTeX で出力に含めるか否かの切り替えができる environment を作る

TeX でノートを作る際、途中計算などを備忘録として詳しく書いておく版と、省略する版を分けて管理するのは面倒。
そんな場合に重宝するのが以下のマクロ。\begin{note} 〜 \end{note} で囲んだ部分の出力を切り替えることができる。\shownote を true にした場合は notecolor に指定した色で出力され、false にすれば出力されない。

\usepackage{color}
\usepackage{comment}

\def\shownote{false}   % この部分を true にすれば出力される
\definecolor{notecolor}{rgb}{0.3,0.3,0.5} % 出力する色

\csname if\shownote \endcsname
\newenvironment{note}{\color{notecolor}\bgroup}{\egroup}
\else
\excludecomment{note}
\fi