TODO： 後で書く。

■[scala] Design by Contract(契約による設計)でScalaの守備力を上げる 00:11

このエントリはScala Advent Calendar jp 2010の16日目です。

昨日は@ussy00さんのScala でテンプレートエンジンを利用して HTML メールを送信するでした。

月日がたつのは早いもので今年も残すところ後9日です。

前回のブログ更新直後にtwitterで「あっ」とつぶやいてみれば、それが公開される頃には一年以上の月日が過ぎていました。

夏にはカブトムシが群がる程ワキの甘い一年でしたが、最期ぐらいはビシッと締める必要があります。

そんな僕にDesign by Contract(以下 DbC)です。

javaにはDbCをサポートするツールとしてContract4Jなどがありますが、

今回はscala wikiに掲載されていた、traitを使用したシンプルなDbCの実現方法の紹介とコードの解説をしたいと思います。

そもそもDbCってなによって方はまずこの辺りを参照してください。

まず初めに、契約を記述する為のContracted traitを以下のように定義します。

trait Contracted {
  class AssertionFailed extends Error

  type Conds = List[() => Boolean]

  protected case class Contract(reqs:Conds, enss:Conds) {
    def require(test: => Boolean) = Contract((() => test)::reqs, enss)
    def ensure(test: => Boolean) = Contract(reqs,(() => test):: enss)
    def in[T](body: => T):T = {
      for(r <- reqs.reverse if(!r())) throw new AssertionFailed()
      val ret = body
      for(e <- enss.reverse if(!e())) throw new AssertionFailed()
      ret
    }
  }

  def require(test: => Boolean) = Contract((() => test) :: Nil, Nil)
  def ensure(test: => Boolean) = Contract(Nil, (() => test) :: Nil)
}

Contractedに定義されたrequireとensureが事前条件と事後条件を定義する為のメソッドです。

この二つのメソッドは、「引数0でBooleanを返すの関数」を引数として指定していますが、

こうすることで内部に書かれた式を関数として受けとり、後から遅延評価させることができます。

requireのensureの返り値の型はContractedの内部クラスとして定義されている

Contractですが、このクラスの説明をする前に実際の使用方法をみてみましょう。

CbDを行なうには、対象のクラスに先程のContractedをmixinし、

更にrequireとensureで事前条件と事後条件を定義した後、inメソッドに実際のロジックを記述します。

class Account(b: Int) extends Contracted {
  def withdraw(amount: Int) {
    val old_balance = balance
    (
      require(amount > 0)
      require(balance - amount >= 0)
      ensure(old_balance - amount == balance)
    ) in {
      balance -= amount
    }
  }
}

val account = new Account(1000)
account.withdraw(300)
account.withdraw(800) // 事前条件 「balance - amount >= 0」をみたさないのでエラー

事前条件と事後条件の書き方は、DSL的な特殊な構文に見えますが、

これは先程のContractクラスとドットの省略を組み合わせるテクニックで実現しています。

それを理解する為に、試しにドットなどを省略せずに冗長な記述してみます。

するとこれは単純にメソッドチェインをしているだけということが判るかと思います。

val contract1 = this.require(amount > 0)
val contract2 = contract1.require(balance - amount >= 0)
val contract3 = contract2.ensure(old_balance - amount == balance)
contract3.in {
  balance -= amount
}

最期に先程説明を省略したContractの実装をみてみましょう。

  protected case class Contract(reqs:Conds, enss:Conds) {
    def require(test: => Boolean) = Contract((() => test)::reqs, enss)
    def ensure(test: => Boolean) = Contract(reqs,(() => test):: enss)
    def in[T](body: => T):T = {
      for(r <- reqs.reverse if(!r())) throw new AssertionFailed()
      val ret = body
      for(e <- enss.reverse if(!e())) throw new AssertionFailed()
      ret
    }
  }

requireやensureが呼ばれるとのリスト先頭に新しい契約を追加した、新しいContractを返します。

これまでに定義した契約が守られているかをbodyの前後のfor文で確認しているわけです。

さて次はScalaやってて知らない奴はモグリといっても過言ではない、

どうみてもチン○のマスコットでお馴染の@yuroyoroさんです。

元ネタ

- http://scala.sygneca.com/code/design-by-contract

■[emacs][scala][elisp] flymakeでscalaの文法をリアルタイムにチェックする 01:17

前回のはおまけで、やりたかったのはむしろこっち。

flymakeがわからない人はこちらを参照。

(eval-when-compile (require 'cl))
(require 'flymake)

(defvar flymake-scala-tmpdir "/tmp")

(defvar flymake-scala-global-classpath ".")

(push '(".+\\.scala$" flymake-scala-init) flymake-allowed-file-name-masks)
(push '("^\\(.*\\):\\([0-9]+\\): error: \\(.*\\)$" 1 2 nil 3) flymake-err-line-patterns)

(defun flymake-scala-string-join (sequence separator)
  (mapconcat #'identity sequence separator))

(defun flymake-scala-string-not-empty (str)
  (and (stringp str) (not (or (string-equal "" str)
                              (string-match "^ +$" str)))))

(defun flymake-scala-parent-dir (path)
  "return parent directory path of argument."
  (substring-no-properties (file-name-directory path) 0 -1))

(defun flymake-scala-find-target-file-dir (path target)
  (let* ((src (split-string (flymake-scala-parent-dir path) "/"))
         (paths (maplist #'(lambda (l) (flymake-scala-string-join (reverse l) "/")) (nreverse src))))
    (loop for path in paths
          if (file-exists-p (concat path "/" target))
          return path)))

(defun flymake-scala-maven-build-cmd ()
  (list "mvn" (list "-fn" "-Dmaven.compiler.showWarnings=true" "dependency:copy-dependencies" "scala:compile")))

(defun flymake-scala-build-cmd (target distdir classpath)
  (list "fsc" (list "-classpath" classpath "-d" distdir target)))

(defun flymake-scala-init ()
  (let ((dir (flymake-scala-find-target-file-dir buffer-file-name "pom.xml")))
    (if (flymake-scala-string-not-empty dir)
        (progn
          (cd dir)
          (let ((distdir (loop for path in '("target" "build")
                               if (file-exists-p path)
                               return path)))
            (if (flymake-scala-string-not-empty distdir)
                (let* ((classes (concat distdir "/classes"))
                       (dependency (concat distdir "/dependency"))
                       (jars (directory-files dependency t "^[^\.]"))
                       (classpath (flymake-scala-string-join (append (cons classes jars) flymake-scala-global-classpath) ":")))
                  (flymake-scala-build-cmd buffer-file-name classes classpath))
              (flymake-scala-maven-build-cmd))))
      (flymake-scala-build-cmd buffer-file-name flymake-scala-tmpdir flymake-scala-global-classpath))))

(defun flymake-scala-start-fsc-server ()
  (with-temp-buffer
    (call-process-shell-command "fsc" nil nil)))

(defun flymake-scala-maven-update ()
  (interactive)
  (let ((dir (flymake-scala-find-target-file-dir buffer-file-name "pom.xml")))
    (if (flymake-scala-string-not-empty dir)
        (progn
          (cd dir)
          (let* ((cmd (flymake-scala-maven-build-cmd))
                 (progname (car cmd))
                 (args (cadr cmd))
                 (buffname (format "*%s*" progname))
                 (buffer (get-buffer-create buffname)))
            (switch-to-buffer-other-window buffer)
            (start-process-shell-command progname buffer progname (flymake-scala-string-join args " "))))
      (message "No pom.xml found"))))

(add-hook 'scala-mode-hook (lambda () (flymake-scala-start-fsc-server) (flymake-mode-on)))

maven2のプロジェクトにも地味に対応。

pom.xmlを再帰的に探して存在する場合はmvn scala:compileを、

無い場合はfscをflymakeで実行させとります。

■参考にしたサイト

• Rakefileを再帰的に探してrake testするelisp(TB) - trotrの日記

2009/10/04 18:00

mvnコマンドの実行が遅いので、二回目以降はfscを使うように修正。

後からjarなどを追加した場合は、

M-x flymake-scala-maven-update

を実行してください。

2009/10/10 21:00

rails.elの関数を参照してしまっていたのを修正

■[emacs][elisp] anythingを使ってflymakeのエラー行を表示する 23:22

探してみても見あたら無かったので慣れないelispで書いてみたでござるの巻

(eval-when-compile (require 'cl))
(require 'flymake)
(setq anything-c-source-flymake
  '((name . "Flymake")
    (init . (lambda ()
              (setq anything-flymake-err-list
                    (loop for err-info in flymake-err-info
                          for err = (nth 1 err-info)
                          append err))))
    (candidates
     . (lambda ()
         (mapcar
          (lambda (err)
            (let* ((text (flymake-ler-text err))
                   (line (flymake-ler-line err)))
              (cons (format "[%s] %s" line text) err)))
          anything-flymake-err-list)))
    (action
     . (("Goto line" . (lambda (candidate) (goto-line (flymake-ler-line candidate) anything-current-buffer)))))))

(defun anything-flymake ()
  (interactive)
  (something (list anything-c-source-flymake)))

M-x anything-flymake

でエラーの一覧を表示。

C-zでanythingのバッファを開いたままactionが実行出来るので、

一覧を表示させたままエラー行の表示できます。

■[haskell] ポーカーの勝敗判定 11:43

haskell入門中

■参考

http://www6.airnet.ne.jp/spade/poker/rule/yaku.html

import Data.List
import Data.Maybe
import Random

data Suit = Spade | Heart | Diamond | Club deriving (Eq, Enum, Show)
type Rank = Int
data Card = Card Rank Suit deriving Show
data Pair = Pair Rank Int deriving Show
data Role = HighCard
          | OnePair
          | TwoPair
          | ThreeOfAKind
          | Straight
          | Flush
          | FullHouse
          | FourOfAKind
          | StraightFlush
          | RoyalFlush  deriving (Eq, Ord, Show)
data Hand = Hand Role [Rank] deriving Show

run :: [Card] -> [Card] -> Ordering
run p1 p2 = deal (analysis p1) (analysis p2)

deal :: Hand -> Hand -> Ordering
deal (Hand h1 r1) (Hand h2 r2)
    | h1 /= h2  = h2 `compare` h1
    | otherwise = r2 `compare` r1

analysis :: [Card] -> Hand
analysis cs  = let rs = sortRank cs
                   s  = straight rs
                   f  = flash cs
                   ps = pair rs
                   hs = highcard rs
               in hand s f ps hs
    where
      sortRank :: [Card] -> [Rank]
      sortRank = sortRoyal . toRanks
          where
            toRanks = map $ \(Card r _) -> r
            sortRoyal rs | rs == [1, 2, 3, 4, 5] = rs
                         | otherwise             = sort $ map (\r -> if r == 1 then 14 else r) rs

      straight :: [Rank] -> Bool
      straight rs = all (== 1) $ zipWith (-) (tail rs) rs

      flash :: [Card] -> Bool
      flash = same . toSuits
          where
            toSuits = map $ \(Card _ s) -> s
            same (s:ss) = all (== s) ss

      pair :: [Rank] -> [Pair]
      pair = (map (\xs -> Pair (head xs) (length xs))) . (filter ((> 1) . length)) . group

      highcard :: [Rank] -> [Rank]
      highcard = concat . (filter ((== 1) . length)) . group

hand :: Bool -> Bool -> [Pair] -> [Rank] -> Hand
hand True  True  [                        ] rs | rs == [10, 11, 12, 13, 14] = Hand RoyalFlush []
                                               | otherwise                  = Hand StraightFlush [head rs]
hand False False [(Pair r  4)             ] rs = Hand FourOfAKind $ r:reverse rs
hand False False [(Pair r2 2), (Pair r3 3)] _  = Hand FullHouse [r3, r2]
hand False False [(Pair r3 3), (Pair r2 2)] _  = Hand FullHouse [r3, r2]
hand False True  [                        ] rs = Hand Flush [head rs]
hand True  False [                        ] rs = Hand Straight [head rs]
hand False False [(Pair r  3)             ] rs = Hand ThreeOfAKind $ r:reverse rs
hand False False [(Pair r1 2), (Pair r2 2)] rs = Hand TwoPair $ r2:r1:reverse rs
hand False False [(Pair r  2)             ] rs = Hand OnePair $ r:reverse rs
hand False False [                        ] rs = Hand HighCard $ reverse rs

ランダムに対戦させてみる。

cards = [(Card r s) | r <- [1 .. 13], s <- [Spade .. Club]]
main = do cards' <- getStdGen >>= (\g -> return $ shuffle g cards)
          mapM_ (\(p1, p2) -> poker p1 p2) $ oddEvenList $ splits 5 cards'
    where
      poker :: [Card] -> [Card] -> IO ()
      poker p1 p2 = do print $ "p1 = " ++ (show p1)
                       print $ "   = " ++ (show $ analysis p1)
                       print $ "p2 = " ++ (show p2)
                       print $ "   = " ++ (show $ analysis p2)
                       print $ msg $ run p1 p2
          where
            msg LT = "P1 Win!!"
            msg GT = "P1 Lose..."
            msg EQ = "even"

splits :: Int -> [a] -> [[a]]
splits n xs | length xs >= n = let (x, xs') = splitAt n xs
                               in x : splits n xs'
            | otherwise      = []

oddEvenList :: [a] -> [(a, a)]
oddEvenList xs = zip (oddList xs) (evenList xs)
    where
      filterList :: ([a] -> Bool) -> [a] -> [a]
      filterList p []                  = []
      filterList p (x:xs)  | p xs      = x : filterList p xs
                           | otherwise = filterList p xs

      oddList = filterList (odd . length)
      evenList = filterList (even . length)

shuffle g [] = []
shuffle g xs = x : shuffle g' rest
    where
      (n, g')   = randomR (0, length xs - 1) g
      (x, rest) = pick n xs

pick :: Int -> [a] -> (a, [a])
pick n xs = let (ys, p:zs) = splitAt n xs
            in (p, ys++zs)

■[emacs] xmlのfolding(折り畳み)をする 16:33

たまには更新しろよってことでemacs小ネタ。

一万行のxmlファイルの修正依頼に涙がぶち切れそうになったので

emacsの折り畳みについてさらっと調べてみたら、hs-minor-modeなるものが標準で入ってた。

ということでsgmlモードでxmlの折り畳みをする設定。

ついでに標準のキーバインド(C-c @ C-c とか)が使いづらいので、

sgml-modeで空いてそうなC-c系列に変更。

(add-hook 'sgml-mode-hook
          '(lambda()
             (hs-minor-mode 1)))
(add-to-list 'hs-special-modes-alist
             '(sgml-mode
               "<!--\\|<[^/>]>\\|<[^/][^>]*[^/]>"
               ""
               "<!--"
               sgml-skip-tag-forward
               nil))

;; key bind
(define-key sgml-mode-map (kbd "C-c C-o") 'hs-toggle-hiding)
(define-key sgml-mode-map (kbd "C-c C-l") 'hs-hide-level)
(define-key sgml-mode-map (kbd "C-c C-s") 'hs-show-all)