YesodでのFunctional Test

追記:2012/04/05: yesod-testがリリースされた。http://hackage.haskell.org/package/yesod-test

YesodはWai上に実装されているので、機能テストにはwai-testが使用できる。で、Yesod自身のテストコードはどうなってるのかなと見たところ、どうやらHspecと併用して要件を満たしているようで、同じテスト構成で構築したので備忘録がわりにメモ。

Yesodのやり方に従ったのでHspecという選択肢にしたが、別にdoctestでもQuickCheckでもなんでもいい。

├── Application.hs
├── Foundation.hs
├── Handler
│   ├── Api
│   │   └── User.hs
│   └── Root.hs
├── Import.hs
├── LICENSE
├── Sample.cabal
├── Settings
│   └── StaticFiles.hs
├── Settings.hs
├── Tests
│   ├── SampleTest
│   │   └── Handler
│   │       └── Api
│   │           └── User.hs
│   ├── SampleTest.hs
│   └── test.hs
<以下省略>

.cabalの編集。extra-source-filesにTestsディレクトリ以下のファイルを追加。Flag testの追加。testフラグが立っている場合はwai-testを使用。

<省略>
cabal-version:     >= 1.6
build-type:        Simple
homepage:          http://Sample.yesodweb.com/
extra-source-files:
    Tests/SampleTest/Handler/Api/User.hs
    Tests/SampleTest.hs
    Tests/test.hs

Flag test
  description: Build the executable to run unit tests
  default: False

Flag dev
    Description:   Turn on development settings, like auto-reload templates.
    Default:       False

Flag library-only
    Description:   Build for use with "yesod devel"
    Default:       False

library
    if flag(library-only)
        Buildable: True
    else
        Buildable: False

    if flag(test)
        build-depends: wai-test
<省略>

.cabalにtest-suiteを追加。

test-suite tests
    type: exitcode-stdio-1.0
    main-is: Tests/test.hs
    cpp-options: -DTEST
    extensions: TemplateHaskell
                QuasiQuotes
                OverloadedStrings
                NoImplicitPrelude
                CPP
                OverloadedStrings
                MultiParamTypeClasses
                TypeFamilies
    build-depends: base                          >= 4          && < 5                  , yesod                         >= 0.10.1     && < 0.11                  , yesod-core                    >= 0.10       && < 0.11                  , yesod-static                  >= 0.10       && < 0.11                  , yesod-default                 >= 0.6        && < 0.7                  , clientsession                 >= 0.7.3      && < 0.8                  , bytestring                    >= 0.9        && < 0.10                  , text                          >= 0.11       && < 0.12                  , template-haskell                  , hamlet                        >= 0.10       && < 0.11                  , shakespeare-text              >= 0.10       && < 0.11                  , shakespeare-css               >= 0.10.7.1   && < 0.11                  , shakespeare-js                >= 0.11.1     && < 0.12                  , wai                           >= 1.1        && < 1.2                  , wai-extra                     >= 1.1        && < 1.2                  , transformers                  >= 0.2        && < 0.3                  , monad-control                 >= 0.3        && < 0.4                  , yaml                          >= 0.5        && < 0.6                  , blaze-html                    >=0.4.3.1     && < 0.5                  , SHA                           >=1.5.0.0     && < 1.6.0.0                  , utf8-string                   >=0.3.7       && < 0.4                  , old-time                      >=1.1.0.0     && < 1.2                  , QuickCheck                    >=2.4.2       && < 3.0                  , random                        >=1.0.1.1     && < 1.1                  , test-framework                >=0.5         && < 0.6                  , test-framework-hunit          >=0.2.7       && < 0.3                  , test-framework-quickcheck2    >=0.2.12      && < 0.3                  , HUnit                  , hspec                         >=0.9.1.1      && < 1.0                  , wai-test                      >=1.1.1        && < 2.0                  , wai                  , wai-extra                     >=1.1.0.1      && < 1.2                  , cookie                        >=0.4.0        && < 0.5                  , http-conduit                  >=1.2.6        && < 1.3                  , clientsession                 >=0.7.4        && < 0.8                  , aeson                         >= 0.5
    ghc-options: -Wall

Tests/test.hs にエントリポイントを記述。

import Import
import Test.Hspec
import Tests.SampleTest

main :: IO ()
main = hspecX $ descriptions $ specs

Tests/SampleTest.hs で[Specs]を作成。

module Tests.SampleTest (specs) where

import Tests.SampleTest.Handler.Api.User
import Test.Hspec

specs :: [Specs]
specs =
    [ userTest
    ]

Tests/SampleTest/Handler/Api/User.hs

module Tests.SampleTest.Handler.Api.User (userTest) where

import Prelude
import Yesod
import Application
import Test.Hspec
import Test.Hspec.HUnit ()
import Network.Wai
import Network.Wai.Test

userTest :: [Spec]
userTest = describe "SampleTest"
    [ it "check request is valid" case_request_valid
    ]

getApp :: IO Application
getApp = do
    (_,app) <- getApplicationDev     return app runner :: Session () -> IO ()
runner f = getApp >>= runSession f

case_request_valid :: IO ()
case_request_valid = runner $ do
      res <- request defaultRequest
        {
          pathInfo = ["api", "user"],
          requestHeaders = [("Accept-Language", "es")]
        }
      assertBody "aaa" res

getApplicationDevからApplicationを取ってきてrunSessionに投げる関数を作り、テストケース内でリクエストを投げてテストを実行していく。

実行。

cabal configure -ftest --enable-tests
cabal build
cabal test
Written on March 1, 2012

GHC 7.4.1のコンパイルエラー

追記:2012/05/27:どうやらMilestoneの設定が間違っていたようで、再度チケットを確認すると7.4.2に変更されていた。ということで、7.4.2が出るまではMac OSX Lionでコンパイルするともれなくこける。

haddock: internal error: divide by zero
 make[1]: *** [libraries/base/dist-install/doc/html/base/base.haddock] Error 1
 make: *** [all] Error 2

すでにチケットはfixedになっているがhttp://www.haskell.org/ghc/にあるソースコードはまだ修正されていないので、そのままコンパイルすると普通に上記のエラーでこける

#5810 (OSX Lion building 7.4 head causes Haddock Divide By Zero) – GHC: http://hackage.haskell.org/trac/ghc/ticket/5810

commit 552504663774d4ad2528d466f08841b5b78c7518で修正されているので、gitから対象の差分をmergeすればコンパイルは成功する。

Milestoneが7.4.1になっているので修正分が入ってないとおかしいのだが、なぜか入ってない。

Written on February 29, 2012

draft-ietf-hybi-thewebsocketprotocol-14

websocketのdrafut14が出ていた。一番大きな変更点はSec-WebSocket-Versionフィールドに複数のバージョンを指定できるようになったことだろう。

4.4. Supporting multiple versions of WebSocket protocol

This section provides some guidance on supporting multiple versions of the WebSocket protocol in clients and servers.

Using the WebSocket version advertisement capability (the “Sec- WebSocket-Version” header field) client can initially request the version of the WebSocket protocol that it prefers (which doesn’t necessarily have to be the latest supported by the client). If the server supports the requested version and the handshake message is otherwise valid, the server will accept that version. If the server doesn’t support the requested version, it will respond with a Sec- WebSocket-Version header field (or multiple Sec-WebSocket-Version header fields) containing all versions it is willing to use. At this point, if the client supports one of the advertised versions, it can repeat the WebSocket handshake using a new version value.

draft-ietf-hybi-thewebsocketprotocol-14 – The WebSocket protocol から2011年9月11日0時43分に引用

ブラウザやサーバによってサポートしているwebsocketのバージョンがまちまちなのでDraft 76でSec-WebSocket-Versionフィールドがサポートされたが、さらに複数のバージョンを指定できるようになった。

例えばクライアントが

GET /chat HTTP/1.1
Host: server.example.com
Upgrade: websocket
Connection: Upgrade
...
Sec-WebSocket-Version: 25

のようなハンドシェイクを試みると、

HTTP/1.1 400 Bad Request
...
Sec-WebSocket-Version: 13
Sec-WebSocket-Version: 8, 7

のようなハンドシェイクをサーバが返すことができる。この場合サーバはバージョン25のwebsocketプロトコルをサポートしておらず、バージョン8と7をサポートしていることが分かる。

Written on September 11, 2011

前エントリのバグレポートの返事

が帰って来た。Duplicateらしい。

オリジナルのバグレポートを参照したいのだが、過去のレポートはどこで見ればいいんだろう。Appleのサイト見てもレポートを参照したい場合はメールを送れとしか書いてない。不便だなあ。

Written on August 22, 2011

NS_BLOCK_ASSERTIONSが有効のとき可変長引数のNSAssertが未定義になる

NSCAssertも同様。これは一体どういう意図があるんだろう。それとも単なるバグなのか。

NSBLOCKASSERTIONSが無効のとき

#if !defined(NS_BLOCK_ASSERTIONS) && defined(__STDC_VERSION__) && (199901L <= __STDC_VERSION__) && (defined(__GNUC__) || 0)

#if !defined(_NSAssertBody)

#define NSAssert(condition, desc, ...) \
    do {            \
    if (!(condition)) { \
        [[NSAssertionHandler currentHandler] handleFailureInMethod:_cmd \
        object:self file:[NSString stringWithUTF8String:__FILE__] \
            lineNumber:__LINE__ description:(desc), ##__VA_ARGS__]; \
    }           \
    } while(0)

#define NSAssert1(condition, desc, arg1) NSAssert((condition), (desc), (arg1))
#define NSAssert2(condition, desc, arg1, arg2) NSAssert((condition), (desc), (arg1), (arg2))
#define NSAssert3(condition, desc, arg1, arg2, arg3) NSAssert((condition), (desc), (arg1), (arg2), (arg3))
#define NSAssert4(condition, desc, arg1, arg2, arg3, arg4) NSAssert((condition), (desc), (arg1), (arg2), (arg3), (arg4))
#define NSAssert5(condition, desc, arg1, arg2, arg3, arg4, arg5) NSAssert((condition), (desc), (arg1), (arg2), (arg3), (arg4), (arg5))

#define NSParameterAssert(condition) NSAssert((condition), @"Invalid parameter not satisfying: %s", #condition)

#endif

NSBLOCKASSERTIONSが有効のとき

#if !defined(NSAssert)
#define NSAssert5(condition, desc, arg1, arg2, arg3, arg4, arg5)    \
    _NSAssertBody((condition), (desc), (arg1), (arg2), (arg3), (arg4), (arg5))

#define NSAssert4(condition, desc, arg1, arg2, arg3, arg4)  \
    _NSAssertBody((condition), (desc), (arg1), (arg2), (arg3), (arg4), 0)

#define NSAssert3(condition, desc, arg1, arg2, arg3)    \
    _NSAssertBody((condition), (desc), (arg1), (arg2), (arg3), 0, 0)

#define NSAssert2(condition, desc, arg1, arg2)      \
    _NSAssertBody((condition), (desc), (arg1), (arg2), 0, 0, 0)

#define NSAssert1(condition, desc, arg1)        \
    _NSAssertBody((condition), (desc), (arg1), 0, 0, 0, 0)

#define NSAssert(condition, desc)           \
    _NSAssertBody((condition), (desc), 0, 0, 0, 0, 0)
#endif

意図的にやってるとしてもメリットが分からない。油断してNSAssert(condition, desc, ...)を開発時に使いまくって、いざNSBLOCKASSERTIONS付きでreleaseビルドすると悲惨なことになる。

Written on July 26, 2011

不動点コンビネータ

Y M = M (Y M)

を満たすλ式の時、

Y = λf·(λx·f (x x)) (λx·f (x x))

と定義される(Yコンビネータ)。この時、Haskellでは以下のように表現できる。

fix :: (a -> a) -> a
fix f = f (fix f)

Control.Monad.Fixに同じものがある。

ghci> :module Control.Monad.Fix
ghci> :type fix
fix :: (a -> a) -> a

fixを使ってみる。再帰が用いられた関数。

fib _ 0 = 0
fib _ 1 = 1
fib fact n = n + fact (n -1)

fixに渡す。

ghci> fix fib 4
10
Written on January 26, 2011

Haskell Programming Guidelines

複数人でHaskellを使うときにゴルフコードへの誘惑をいかに断つかってのは最もだなあと思う。別にHaskellに限った話ではないが。

Programming guidelines – HaskellWiki:

http://www.haskell.org/haskellwiki/Programming_guidelines

All Haskell source files start with a haddock header of the form:

{- |
Module      :  <File name or $Header$ to be replaced automatically>
Description :  <optional short text displayed on contents page>
Copyright   :  (c) <Authors or Affiliations>
License     :  <license>

Maintainer  :  <email>
Stability   :  unstable | experimental | provisional | stable | frozen
Portability :  portable | non-portable (<reason>)

<module description starting at first column>
-}

Bad:

case foo of Foo -> "Foo"
         Bar -> "Bar"

Good:

case  of
       Foo -> "Foo"
       Bar -> "Bar"

Not always nice:

longFunctionName (Foo: _ : _) = e1
longFunctionName (Bar: _) = e2

Better:

longFunctionName arg = case arg of
       Foo : _ : _ -> e1
       Bar : _ -> e2
       _ -> error "ProgrammingGuidelines.longFunctionName"

Bad (to handle arguments in sync):

data Mode f p = Box f p | Diamond f p

Good (to handle arguments only once):

data BoxOrDiamond = Box | Diamond

 data Mode f p = Mode BoxOrDiamond f p

Consider (bad):

data Tuple a b = Tuple a b | Undefined

versus (better):

data Tuple a b = Tuple a b

and using:

Maybe (Tuple a b)
Written on January 20, 2011