読者です 読者をやめる 読者になる 読者になる

関係と代数的データ型との相互変換についての妄想 その3

思い付き その2

class QueryUser ? where
    queryUser :: (?) => Key -> MonadDB User

instance QueryUser ? where
    -- queryUser :: (HasFriends ?) => Key -> MonadDB User
    query =instance QueryUser ? where
    -- queryUser :: (HasName ?) => Key -> MonadDB User
    query = …

userFriends :: (HasFriends ?) => User -> [User]
userName :: (HasName ?) => User -> [User]

ふむー?userFriendsuserName を使った項は、まぁ (HasFriends ?, HasName ?) になりそうな気はするな。HasFriends ?? に入る型と対応する値が要る気がする。

そもそもそれぞれでインスタンス実装できるのか?

ConstraintKinds?

“When matching, GHC takes no account of the context of the instance declaration (context1 etc).” ってあるしムリっぽい。 https://downloads.haskell.org/~ghc/7.0.1/docs/html/users_guide/type-class-extensions.html#instance-overlap

GHC 8.0 だとその記述なくなってるな。 https://downloads.haskell.org/~ghc/8.0.2/docs/html/users_guide/glasgow_exts.html#overlapping-instances

とはいえムリっぽいのは変わりなさそうなんで、次は普通にモナドの方針で行ってみるか。

関係と代数的データ型との相互変換についての妄想 その2

思い付き その1

型レベルのリストをクエリー函数に与えてやる。(DataKinds が有効)

data Attr = Id | Name | Friends
data User = User { id :: Int, name :: String, friends :: [User] }
query :: Proxy '[??] -> Key -> MonadDB User
userFriends :: Proxy '[Friends] -> User -> [User]

リストだとダメだなーって気付いた。勝手に型の和が取られるわけじゃないからね。

それはそれとして、分からないところが2点。

1つは上記のコードで query の型の ?? って書いているところをどう書けばよいか。やりたいことは「?? の部分に入るのは 'Attr カインドの任意の型」ということを示したい。

しばらく寝かせて思い付いたけど KindSignatures を有効にして下記でいけるっぽい。

data ProxyAttr (t :: [Attr]) = ProxyAttr

もう1つは、下記のをうまいこと推論してくれないのなんでだ。stack --resolver lts-8.12 exec -- ghci -fprint-explicit-kinds -XDataKinds にて。

後から気付いた ProxyAttr を使うとエラーにならなかった。

ghci> :m + Data.Proxy
ghci> data Attr = Id | Name | Friends
ghci> data User = User { id :: Int, name :: String, friends :: [User] } deriving (Show)
ghci> :{
ghci| userFriends :: Proxy '[Friends] -> User -> [User]
ghci| userFriends _ _ = [User 1 "Ada" []]
ghci| :}
ghci> bob = User 2 "Bob" []
ghci> let p = Proxy in userFriends p bob

<interactive>:9:30: error:
    • Couldn't match type*’ with ‘[Attr]’
      Expected type: Proxy [Attr] ((':) Attr 'Friends ('[] Attr))
        Actual type: Proxy * ((':) Attr 'Friends ('[] Attr))
    • In the first argument of ‘userFriends’, namely ‘p’
      In the expression: userFriends p bob
      In the expression: let p = Proxy in userFriends p bob

Proxy に型注釈してやると大丈夫。

ghci> let p = Proxy :: Proxy '[Friends] in userFriends p bob
[User {id = 1, name = "Ada", friends = []}]

どっちにしろリストの戦略は破綻してるのでボツ。

制約の方に情報を乗せないとあかん気がしている。

関係と代数的データ型との相互変換についての妄想 その1

OR マッパーみたいな、関係*1とデータ型との相互変換が機械的にできたら嬉しいなという話。

シンプルなのは簡単だしすでにできる。例えば次のような関係がある場合*2

var user base relation {
  id integer,
  name string,
}
key { id };

var friends base relation {
  user1 integer,
  user2 integer
};

これを単に次のようなデータ型に変換するのはいくらかのライブラリーで実現できる。

data User = User { id: Int, name: String }

data Friends = Friends { user1: Int, user2: Int }

しかし、実際のところ欲しい型というのは次の通りでこれは機械的にできるのはなさそう。(ちゃんとは調べてないのであったら教えてほしい。)

data User = User { id: Int, name: String, friends: [User] }

よくあるクラスベースのオブジェクト指向言語なら Friends ゲッターの中でクエリー発行すればいいんだけど、同じことを Haskell ですると IO まみれになるしできれば純粋な函数にしたいよなー。

public class User {
  public readonly int id;
  public readonly string name;
  readonly IList<User> friends;
  public IList<User> Friends {
    get {
      if (friends == null) friends = …;
      return friends;
    }
  }
  public User query(int id) { … }
}

妄想としては、そのフィールドが使われてるかの情報を型に乗っけることで、DB からの取得時にどれを取ってくればいいか分からないかなーと。

do
  user <- queryUser 1 -- 何らかの queryUser :: Int -> MonadDB User みたいな函数があるとして
  return $ friends user

friends 函数の型を GetFriends user => user -> [User] みたいにしてやることで型推論によって queryUser 函数の型クラス制約にも GetFriends が付いて実装を変えられないかなぁと。

うーんでも型クラスのありなしでは実装は変えられないかー。なんとか型に情報乗せないとダメかな。

続きはまた後日。

*1:ここでいう関係は関係代数の用語としての関係です。

*2:Tutorial D の記法に従ってますが、パーサーにかけたことがないのでまちがってるかもしれない。

技術書典2にサークル参加します 「Haskell Yesod 本」

4月9日日曜日にアキバ・スクエアにて開催される技術書オンリー同人誌即売会技術書典2」にサークル「趣味はデバッグ……」として参加します。

冬コミで頒布した『遠回りして学ぶ Yesod 入門』の誤字脱字等を修正して組版を改善したものを持っていきます。

新作はちょっと間に合うか……

内容

内容は、下記となります。

  • ビルドツール Stack
  • 効率のよい文字列の扱い
  • Haskell の言語拡張
  • コンパイル時計算 Template Haskell
  • Web Application Interface とは
  • 簡単な Yesod の解説
  • ロガー用 Middleware を作る

詳しい内容は見本誌で確認ください。

ロガー用 Middleware の章は @syocy さんに書いていただきました。

紙面版仕様

  • 表紙フルカラー
  • 本文モノクロ
  • B5 判
  • 76ページ(表紙込み)

電子版

BOOTH にて販売中です。誤字脱字等修正済みです。

紙面版購入者は対面電書にて誤字脱字等修正版をダウンロードできます。

価格

価格は下記の通りとなります。

  • 現地販売(現金・クレジットカード)
    • 紙面+電子版
      • 1000円
    • 電子版
      • 800円
      • ダウンロード URI を渡します
  • オンライン販売
    • 電子版
      • 1000円

クレジットカード決済は、Square 社が対応しているものに限ります。

スペース

スペースは「う-04」です。

techbookfest.org

よろしくお願いします!

Yesod で1ページに複数個フォームがある場合は identifyForm を使う

resolver lts-5.4 で確認。

問題

1ページに複数個フォームがある場合、runFormPost はそれぞれのフォームの区別をしてくれません。どういうことかというと、例えば下記のような2つのフォームを利用するとします。

data AFormData = AFormData Text
aForm :: Html -> MForm Handler (FormResult AFormData, Widget)
aForm = renderDivs $ AFormData <$> areq textField "A Text" Nothing

data BFormData = BFormData Text
bForm :: Html -> MForm Handler (FormResult BFormData, Widget)
bForm = renderDivs $ BFormData <$> areq textField "B Text" Nothing

この2つのフォームを1つのページに配置し、ブラウザーでアクセスしどちらか一方のフォームに “Hello” とでも入力し送信します。すると runFormPost aFormrunFormPost bForm も返り値の FormResult Xxx 型の部分が FormSuccess xxx となり、xxx の部分はそれぞれ AFormData "Hello"BFormData "Hello" となります。

これは困ります。

解決

identifyForm を使います。

identifyForm
  :: Monad m
  => Text -- ^ Form identification string.
  -> (Html -> MForm m (FormResult a, WidgetT (HandlerSite m) IO ()))
  -> (Html -> MForm m (FormResult a, WidgetT (HandlerSite m) IO ()))

第1引数にユニークな文字列を指定してください。

aForm = identifyForm "a-form" $ renderDivs $ AFormData <$> areq textField "A Text" Nothing

これで、対応するフォームに入力されたときだけ runFormPostFormSuccess を返すようになります。

参考

Issue yesod-web/yesod #649

Yesod と HDBC-mysql と haskell-relational-record で “Commands out of sync”

Yesod と HDBC-mysqlhaskell-relational-record を一緒に使っているのだが、MySQL サーバーに「Commands out of sync; you can’t run this command now」って言われてぐぬぬってなって、最近デバッグをがんばっている。とりあえず途中経過をメモしておく。

そもそも MySQL プロトコルの呼び出し順とか知らないので苦戦していた。

この辺でエラーが出ている。結合をしなければエラーは出ない。

import Import hiding (on)
import Database.Relational.Query (on)
import qualified Model.Table.Account as Account
import qualified Model.Table.Tweet as Tweet
import qualified Model.Table.User as User

getTweetR :: AccountIdParam -> TweetIdParam -> Handler Html
getTweetR accountIdParam tweetIdParam = do
    user <- requireAuth
    p <- runRelational $ do
             accounts <- runQuery Account.selectAccount accountIdParam
             ts <- flip runQuery () $ relationalQuery $ relation $ do
                       t <- query Tweet.tweet
                       u <- query User.user
                       on $ t ! Tweet.userId' .=. u ! User.id'
                       wheres $ t ! Tweet.id' .=. value tweetIdParam
                       return $ (,) |$| t |*| u
             return (accounts, ts)
    case p of
        ([account@(Account _ _ _ _)], [(tweet@(Tweet _ _ _ _ _), tweetUser@(User _ _ _ _))]) -> do
            form <- generateFormPost commentForm
            defaultLayout $ do
                headerWidget $ Just user
                tweetWidget account user tweet form
        _ -> notFound

とりあえず HDBC-mysqlFFI で libmysqlclient を呼んでるので C のレベルでどの関数を呼んでいるのかログに出してみる。コードはこんな感じ。めっちゃ地道にログを挟んでいった。一部引用すると下記。

mysql_stmt_prepare :: Ptr MYSQL_STMT -> CString -> CInt -> IO CInt
mysql_stmt_prepare mysql a1 a2 = do
  s1 <- peekCString a1
  hPutStrLn stderr $ "mysql_stmt_prepare " ++ (show mysql) ++ " " ++ (show s1) ++ " " ++ (show a2)
  cr <- mysql_stmt_prepare_ mysql a1 a2
  hPutStrLn stderr $ "\t→ " ++ (show cr)
  return cr

そのログ出力が下記(別ページで開く)。同じ接続・同じステートメントに同じ色を塗った。

どうも mysql_stmt_execute した後に mysql_stmt_fetch せずに mysql_stmt_prepare するとダメっぽい。C で確認してみると下記のコードコメントアウトしてるところのありなしでエラーが出たり出なかったりするのでおそらく合ってる。

MYSQL_BIND result;
char display_name[100];
unsigned long display_name_length;
my_bool display_name_error;
memset(&result, 0, 1);
result.buffer = display_name;
result.buffer_length = sizeof(display_name) * sizeof(display_name[0]);
result.is_null = NULL;
result.length = &display_name_length;
result.error = &display_name_error;
{
    my_bool error = mysql_stmt_bind_result(stmt, &result);
    if (error) {
        fprintf(stderr, "mysql_stmt_bind_result\n");
        mysql_close(mysql);
        exit(1);
    }
}
// {
//     int fetch_result = mysql_stmt_fetch(stmt);
//     switch (fetch_result) {
//         case MYSQL_NO_DATA:
//             printf("mysql_stmt_fetch: MYSQL_NO_DATA\n");
//             break;
//         case MYSQL_DATA_TRUNCATED:
//             printf("mysql_stmt_fetch: MYSQL_DATA_TRUNCATED\n");
//             break;
//         default:
//             printf("mysql_stmt_fetch: %d\n", fetch_result);
//     }
//     printf("display_name: %s\n", display_name);
//     switch (result.buffer_type) {
//         case MYSQL_TYPE_BLOB:
//             printf("display_name type: MYSQL_TYPE_BLOB\n");
//         default:
//             printf("display_name type: %d\n", result.buffer_type);
//     }
//     printf("display_name_length: %ld\n", display_name_length);
//     printf("display_name_error: %d\n", display_name_error);
// }
{
    my_ulonglong rows = mysql_stmt_affected_rows(stmt);
    printf("mysql_stmt_affected_rows: %ld\n", (long)rows);
}
{
    MYSQL_STMT *stmt2 = mysql_stmt_init(mysql);
    if (stmt == NULL) {
        fprintf(stderr, "mysql_stmt_init: error\n");
        mysql_close(mysql);
        exit(1);
    }
    {
        const char * const stmt_str = "SELECT `email` FROM `user` WHERE `id` = ?";
        int error = mysql_stmt_prepare(stmt2, stmt_str, strlen(stmt_str));
        if (error) {
            fprintf(stderr, "mysql_stmt_prepare: error\n");
            fprintf(stderr, "error message: %s\n", mysql_stmt_error(stmt2));
            mysql_close(mysql);
            exit(1);
        }
    }
}

この FFI 呼び出しがどういう経緯で呼ばれてるかを探すのはこれから。

接続を使い回すようにしたのがダメなのかもしれない。

解決しました。(2017.03.17)

正格版の runQuery' があったのですね。

『遠回りして学ぶ Yesod 入門』誤字脱字等を修正した電子版を公開しました

先日の投稿で公開した正誤表の内容を反映した電子版を公開しました。

kakkun61.hatenablog.com

コミックマーケット 91 で購入した方は対面電書で、オンラインで購入した方は BOOTH で更新後のファイルを入手することができます。