DDD 宣言的な設計をCommon Lispで実装してみる

specification.ros.lisp

#!/bin/sh
#|-*- mode:lisp -*-|#
#|
exec ros -Q -- $0 "$@"
|#
(progn ;;init forms
  (ros:ensure-asdf)
  #+quicklisp(ql:quickload '(:prove) :silent t)
  )

(defpackage :ros.script.specification-combination.3771051914
  (:use :cl :prove))
(in-package :ros.script.specification-combination.3771051914)

;; 人のクラス定義
(defclass person () ((gender :initarg :gender :accessor gender)
                      (age :initarg :age :accessor age)))

;;; 仕様のクラス定義
(defclass marriage-spec () ())

(defclass age-spec (marriage-spec)
  ((age :initarg :age :accessor age)))

(defclass gender-spec (marriage-spec)
  ((gender :initarg :gender :accessor gender)))

(defclass or-spec (marriage-spec)
  ((specs :type 'marriage-spec :initarg :specs :accessor specs)))

(defclass and-spec (marriage-spec)
  ((specs :type 'marriage-spec :initarg :specs :accessor specs)))

;;; 仕様に対する判定
;; orは複数の仕様がどれか満たされたときに満たされる
(defmethod satisfyp ((spec or-spec) (candidate person))
  (reduce #'(lambda (acc sp) (or acc (satisfyp sp candidate))) (specs spec) :initial-value nil))

;; andは複数の仕様の全てが満たされたときに満たされる
(defmethod satisfyp ((spec and-spec) (candidate person))
  (reduce #'(lambda (acc sp) (and acc (satisfyp sp candidate))) (specs spec) :initial-value t))

;; 年齢の仕様は，人の年齢が仕様の年齢以上であったときに満たされる
(defmethod satisfyp ((spec age-spec) (candidate person))
  (>= (age candidate) (age spec)))

;; 性別の仕様は，人の性別が仕様の性別と同じときに満たされる
(defmethod satisfyp ((spec gender-spec) (candidate person))
  (eq (gender spec) (gender candidate)))

;; make-instanceを書かずにすむ表記用のマクロ
(defmacro age-spec (&rest rest)
  `(make-instance 'age-spec ,@rest))
(defmacro gender-spec (&rest rest)
  `(make-instance 'gender-spec ,@rest))
(defmacro or-spec (&rest rest)
  `(make-instance 'or-spec :specs (list ,@rest)))
(defmacro and-spec (&rest rest)
  `(make-instance 'and-spec :specs (list ,@rest)))

;; 結婚できる仕様を作成
(defparameter *marriage-spec*
  (or-spec (and-spec (age-spec :age 18)
                     (gender-spec :gender :male))
           (and-spec (age-spec :age 16)
                     (gender-spec :gender :female))))

;; 人のインスタンスを作成
(defparameter *16-male*
  (make-instance 'person :age 16 :gender :male))
(defparameter *16-female*
  (make-instance 'person :age 16 :gender :female))
(defparameter *18-male*
  (make-instance 'person :age 18 :gender :male))
(defparameter *18-female*
  (make-instance 'person :age 18 :gender :female))

;; テスト
(defun run-test ()
  (plan 4)
  (subtest "16歳男性は結婚できない"
    (ok (not (satisfyp *marriage-spec* *16-male*))))
  (subtest "16歳女性は結婚できる"
    (ok (satisfyp *marriage-spec* *16-female*)))
  (subtest "18歳男性は結婚できる"
    (ok (satisfyp *marriage-spec* *18-male*)))
  (subtest "18歳女性は結婚できる"
    (ok (satisfyp *marriage-spec* *18-female*)))
  (finalize))

(defun main (&rest argv)
  (declare (ignorable argv))
  (run-test))
;;; vim: set ft=lisp lisp:

windymelt% ./specification-combination.ros                                                                                       5594:windymeltnoMacBook-puro
1..4

 16歳男性は結婚できない
    ✓ T is expected to be T

 16歳女性は結婚できる
    ✓ T is expected to be T

 18歳男性は結婚できる
    ✓ T is expected to be T

 18歳女性は結婚できる
    ✓ T is expected to be T

✓ 4 tests completed