Hatena::Grouphaskell

suztomoの日記

 | 

2011-12-28

-ddump-splicesでYesodのmkMessageのtemplate haskellの部分を理解する

00:58

mkMessageって何かよくわからないじゃないですか。ja.msgを用意して

Hello: こんにちは

って用意しても表示されませんし、そこで-ddump-splicesでコンパイルしてやると

ghc -cpp  Foundation.hs -ddump-splices
Foundation.hs:1:1: Splicing declarations
    mkMessage "Test" "messages" "ja"
  ======>
    Foundation.hs:59:1-32
    data TestMessage = MsgHello {}
    instance RenderMessage Test TestMessage where
        { renderMessage _ (: lang[a4B3] _) MsgHello {}
            | (lang[a4B3] == Data.Text.pack "en")
            = Data.Text.pack ("Hell" :: String)
          renderMessage _ (: lang[a4B4] _) MsgHello {}
            | (lang[a4B4] == Data.Text.pack "ja")
            = Data.Text.pack ("\12371\12435\12395\12385\12399" :: String)
          renderMessage _ [] MsgHello {}
            = Data.Text.pack ("\12371\12435\12395\12385\12399" :: String)
          renderMessage sub[a4B5] (: _ langs[a4B6]) msg[a4B7]
            = renderMessage sub[a4B5] langs[a4B6] msg[a4B7] }

と表示されます。lang[a4B4]などはそのcaseでbindされている変数で"en"とか"ja"とかがくると思います。つぎはこのrenderMessageがどうやって使われているかという変数を見ないといけないわけですが .

よーくrenderMessageを見ると、第二引数は"en"とか"ja"とかのリストになっていて、最後のrenderMessageの定義はそれが"en"でも"ja"でもなかった場合にそのリストの次の候補を探すようになっているぽい。じゃあ"en"とか"ja"とかが定義されているところはどこかというかrenderMessageはどこでつかわれているのか。

最初の問題「ja.msgを用意したのに日本語が表示されない」というのは自分のブラウザが英語設定になっていたためで日本語設定のブラウザでアクセスしたらちゃんと「こんにちは」と表示された。たぶんHTTP request headerのAccept-Language:en-US,en;q=0.8あたりを見ているのだと思う。

yesod-core/Yesod/Internal/Request.hsでは

parseWaiRequest' env session' key' gen = Request gets'' cookies' env langs' nonce
  where
    gets' = queryToQueryText $ W.queryString env
    gets'' = map (second $ fromMaybe "") gets'
    reqCookie = lookup "Cookie" $ W.requestHeaders env
    cookies' = maybe [] parseCookiesText reqCookie
    acceptLang = lookup "Accept-Language" $ W.requestHeaders env
    langs = map (pack . S8.unpack) $ maybe [] NWP.parseHttpAccept acceptLang
    -- The language preferences are prioritized as follows:
    langs' = catMaybes [ join $ lookup langKey gets' -- Query _LANG
                       , lookup langKey cookies'     -- Cookie _LANG
                       , lookup langKey session'     -- Session _LANG
                       ] ++ langs                    -- Accept-Language(s)
    -- If sessions are disabled nonces should not be used (any
    -- nonceKey present in the session is ignored). If sessions
    -- are enabled and a session has no nonceKey a new one is
    -- generated.
    nonce = case (key', lookup nonceKey session') of
                (Nothing, _) -> Nothing
                (_, Just x)  -> Just x
                _            -> Just $ pack $ randomString 10 gen

というかんじでCookie, Sessionも使ってlangのリストが作られているようなので、ブラウザの設定をかえなくてもそれらを設定すれば言語の設定ができそう。

Requestの4つ目の引数のlangs'はreqLangsで

-- | The parsed request information.
data Request = Request
    { reqGetParams :: [(Text, Text)]
    , reqCookies :: [(Text, Text)]
    , reqWaiRequest :: W.Request
      -- | Languages which the client supports.
    , reqLangs :: [Text]
      -- | A random, session-specific nonce used to prevent CSRF attacks.
    , reqNonce :: Maybe Text
    }

yesod-coreのYesod/Handler.hsで予想どおりrenderMessageとともに使われている。

getMessageRender :: (Monad mo, RenderMessage master message) => GGHandler s master mo (message -> Text)
getMessageRender = do
    m <- getYesod
    l <- reqLangs `liftM` getRequest
    return $ renderMessage m l

参考

できた(?)Template Haskell

22:54

できる!Template Haskell (完) - はてな使ったら負けだと思っている deriving Haskell - haskellをやっている。

"$()"の演算子が見つからないなと思っていたら

*TupTH> $(varE $ mkName "pi")
<interactive>:1:1: parse error on input `$'

言語の大切な部分にさわる関数なので(?)、"-XTemplateHaskell"が必要なのでした。

~/Documents/.../Haskell/TemplateHaskell $ ghci -XTemplateHaskell -XQuasiQuotes TupTH.hs 
GHCi, version 7.0.3: http://www.haskell.org/ghc/  :? for help
Loading package ghc-prim ... linking ... done.
Loading package integer-gmp ... linking ... done.
Loading package base ... linking ... done.
Loading package ffi-1.0 ... linking ... done.
[1 of 1] Compiling TupTH            ( TupTH.hs, interpreted )
Ok, modules loaded: TupTH.
*TupTH> $(varE $ mkName "pi")
Loading package array-0.3.0.2 ... linking ... done.
Loading package containers-0.4.0.0 ... linking ... done.
Loading package pretty-1.0.1.2 ... linking ... done.
Loading package template-haskell ... linking ... done.
3.141592653589793

そしてsplice(接合)について、

$(varE $ mkName "pi")

$(varE =<< newName "pi")

って中の型が違うんですけどいいのかな。後者はQもなどの中に入っているけれども、前者はQもなどには入っていないただのExp型である。


。。。と思ったらVarEだと思っていたのはvarEでこれはQモナドに入ったものを作ってくれるユーティリティ関数らしいです。

*TupTH> :t varE
varE :: Name -> ExpQ
*TupTH> :t VarE
VarE :: Name -> Exp
~/Documents/.../Haskell/TemplateHaskell $ ghci -XTemplateHaskell TupTH.hs
GHCi, version 7.0.3: http://www.haskell.org/ghc/  :? for help
Loading package ghc-prim ... linking ... done.
Loading package integer-gmp ... linking ... done.
Loading package base ... linking ... done.
Loading package ffi-1.0 ... linking ... done.
[1 of 1] Compiling TupTH            ( TupTH.hs, interpreted )
Ok, modules loaded: TupT
*TupTH> $(sel 10 7) (1,1,1,1,1,1,5,1,1,1)
5

うごいた。



この調子でYesodのmkMessageがどんなものなのかをしらべてみる。

~/Documents/.../Yesod/testyesod $ ghci -cpp -XTemplateHaskell -XOverloadedStrings Foundation.hs
GHCi, version 7.0.3: http://www.haskell.org/ghc/  :? for help
Loading package ghc-prim ... linking ... done.
Loading package integer-gmp ... linking ... done.
Loading package base ... linking ... done.
Loading package ffi-1.0 ... linking ... done.
Ok, modules loaded: Foundation, Settings, Model, Settings.StaticFiles.
Prelude Foundation> let e = mkMessage "Test" "messages" "ja"
Loading package transformers-0.2.2.0 ... linking ... done.
Loading package bytestring-0.9.1.10 ... linking ... done.
Loading package mtl-2.0.1.0 ... linking ... done.
Loading package parsec-3.1.1 ... linking ... done.
Loading package array-0.3.0.2 ... linking ... done.
Loading package containers-0.4.0.0 ... linking ... done.
Loading package deepseq-1.1.0.2 ... linking ... done.
Loading package pretty-1.0.1.2 ... linking ... done.
Loading package filepath-1.2.0.0 ... linking ... done.
Loading package old-locale-1.0.0.2 ... linking ... done.
Loading package old-time-1.0.0.6 ... linking ... done.
Loading package unix-2.4.2.0 ... linking ... done.
Loading package directory-1.1.0.0 ... linking ... done.
Loading package template-haskell ... linking ... done.
Loading package text-0.11.1.12 ... linking ... done.
Loading package shakespeare-0.10.2 ... linking ... done.
Loading package shakespeare-i18n-0.0.0 ... linking ... done.
Prelude Foundation> :m Language.Haskell.TH
Prelude Language.Haskell.TH> runQ e
[DataD [] TestMessage [] [RecC MsgHello []] [],InstanceD [] (AppT (AppT (ConT Text.Shakespeare.I18N.RenderMessage) (ConT Test)) (ConT TestMessage)) [FunD renderMessage [Clause [WildP,ConP : [VarP lang_0,WildP],RecP MsgHello []] (GuardedB [(NormalG (InfixE (Just (VarE lang_0)) (VarE GHC.Classes.==) (Just (AppE (VarE Data.Text.pack) (LitE (StringL "en"))))),AppE (VarE Data.Text.pack) (SigE (LitE (StringL "Hell")) (ConT GHC.Base.String)))]) [],Clause [WildP,ConP : [VarP lang_1,WildP],RecP MsgHello []] (GuardedB [(NormalG (InfixE (Just (VarE lang_1)) (VarE GHC.Classes.==) (Just (AppE (VarE Data.Text.pack) (LitE (StringL "ja"))))),AppE (VarE Data.Text.pack) (SigE (LitE (StringL "Hel")) (ConT GHC.Base.String)))]) [],Clause [WildP,ConP [] [],RecP MsgHello []] (NormalB (AppE (VarE Data.Text.pack) (SigE (LitE (StringL "Hel")) (ConT GHC.Base.String)))) [],Clause [VarP sub_2,ConP : [WildP,VarP langs_3],VarP msg_4] (NormalB (AppE (AppE (AppE (VarE Text.Shakespeare.I18N.renderMessage) (VarE sub_2)) (VarE langs_3)) (VarE msg_4))) []]]]

読めない。。。

ifdefマクロがコンパイルされない

22:17

今日知ったんですけれど、ghcはifdefはデフォルトで処理してくれないんですね。

そんなときは

{-# LANGUAGE CPP #-}

もしくは

ghc -cpp --make Foundation.hs

しましょう。

こんなのを行頭に入れておくといいかんじです。

{-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell, MultiParamTypeClasses, OverloadedStrings, FlexibleContexts, GADTs #-}

mr_konnmr_konn2011/12/28 22:57>中の型が違うんですけどいいのかな。

前者がExpQ に対して後者が Q Exp である、と云うことであれば、 ExpQ は Q Exp のエイリアスみたいなものなので大丈夫なはずです。

インモラルインモラル2013/09/23 11:21淫インモラル:http://immoral.hellokanpo.com
インモラル:http://immoral.hellokanpo.com
媚薬 淫インモラル:http://immoral.hellokanpo.com
媚薬 インモラル:http://immoral.hellokanpo.com
妖姫:http://youhi.hellokanpo.com
媚薬 妖姫:http://youhi.hellokanpo.com



威哥王:http://www.hellokanpo.com/view/weigewang.html
巨人倍増:http://www.hellokanpo.com/view/jurenbeiceng.html
三便宝:http://www.hellokanpo.com/view/satibo-capsules.html
D10 媚薬:http://www.hellokanpo.com/view/D10-meiyao.html
RU486:http://www.hellokanpo.com/view/beijing-ru486.html
花痴:http://www.hellokanpo.com/view/huachi.html
紅蜘蛛:http://www.hellokanpo.com/view/hongzhizhu1.html
狼一号:http://www.hellokanpo.com/view/langyihao.html
三體牛鞭:http://www.hellokanpo.com/view/santiniubian.html
蟻力神:http://www.hellokanpo.com/view/yilishen.html
D10 催情剤:http://www.hellokanpo.com/view/D10-meiyao.html
三体牛鞭:http://www.hellokanpo.com/view/santiniubian.html
天天素:http://www.hellokanpo.com/view/tiantiansu.html
福源春:http://www.hellokanpo.com/view/fuyuanchun.html
韓国痩身1号:http://www.hellokanpo.com/view/hanguoshou-575.html


五便宝:http://www.hellokanpo.com/view/wodibo-capsules.html
さんべんぼう:http://www.hellokanpo.com/view/satibo-capsules.html
キョジンバイゾウ:http://www.hellokanpo.com/view/jurenbeiceng.html
蒼蝿水:http://www.hellokanpo.com/view/FLY-D5.html
VigRx:http://www.hellokanpo.com/view/VigRx.html
ウェイカワン:http://www.hellokanpo.com/view/weigewang.html
VVK:http://www.hellokanpo.com/view/VVK-Wenickman.html
狼1号:http://www.hellokanpo.com/view/langyihao.html
男宝:http://www.hellokanpo.com/view/nanbao.html
vigRx oil:http://www.hellokanpo.com/view/Oil.html
V26:http://www.hellokanpo.com/view/V26.html
曲美:http://www.hellokanpo.com/view/qumei.html
SPANISCHE FLIEGE:http://www.hellokanpo.com/view/spanische-flieged5-1.html
巨根カプセル:http://www.hellokanpo.com/view/jugen.html
絶對高潮:http://www.hellokanpo.com/view/jueduigaochao.html
SEX DROPS:http://www.hellokanpo.com/view/sex-drops.html
終極痩身:http://www.hellokanpo.com/view/zhongjishoushen.html
福源春カプセル:http://www.hellokanpo.com/view/fuyuanchun.html
超級脂肪燃焼弾:http://www.hellokanpo.com/view/FATBURNING.html
SUPER FAT BURNING:http://www.hellokanpo.com/view/SUPERFATBURNING.html
D5 原液:http://www.hellokanpo.com/view/FLYD5yuan.html
イーリーシン:http://www.hellokanpo.com/view/yilishen.html
黒倍王:http://www.hellokanpo.com/view/heibeiwang.html
新一粒神:http://www.hellokanpo.com/view/xinyilishen.html
女性催情剤:http://www.hellokanpo.com/view/d10-meiyao.html
蒼蝿粉:http://www.hellokanpo.com/view/inverma.html
ビグレックス:http://www.hellokanpo.com/view/Oil.html
蔵八宝:http://www.hellokanpo.com/view/zhangbabao.html
小情人:http://www.hellokanpo.com/view/sex-drops5.html
御秀堂:http://www.hellokanpo.com/view/yuxiutang.html
威哥王 販売:http://www.hellokanpo.com/view/weigewang.html
紅蜘蛛 液体:http://www.hellokanpo.com/view/hong-zhi-zhu.html
紅蜘蛛 激安:http://www.hellokanpo.com/view/hong-zhi-zhu-meiyao.html

 |