JSON Schema

JSON Schemaというものがある。これはみんな大好きJSONにXSDよろしく型をつけようというものだ。XSDより簡単っぽいのでとりあえず実装してみた。こんな感じで使える。

// product.schema.json
{
  "$schema": "http://json-schema.org/draft-07/schema#",
  "$id": "http://example.com/product.schema.json",
  "title": "Product",
  "description": "A product in the catalog",
  "type": "object",
  "properties": {
    "productId": {
      "description": "The unique identifier for a product",
      "type": "integer"
    }
  },
  "required": [ "productId" ]
}
// input.json
{
  "productId": 1
}

(import (rnrs)
        (text json)
        (text json validator)
        (text json schema))

(define product-validator 
  (json-schema->json-validator 
    (call-with-input-file "product.schema.json" json-read)))
(validate-json product-validator
  (call-with-input-file "input.json" json-read))
;; -> #t

もう少し凝った例を見てみる。本当ならhttps://json-schema.org/learn/にあるのを直接使いたかったが、どうもあまりメンテされてないらしく不整合があって使えなかった。なので、ちょっと長いがSchemaをだらだら書く。

// address.schema.json
{
  "$id": "http://example.com/address.schema.json",
  "$schema": "http://json-schema.org/draft-07/schema#",
  "description": "An address similar to http://microformats.org/wiki/h-card",
  "type": "object",
  "properties": {
    "post-office-box": {
      "type": "string"
    },
    "extended-address": {
      "type": "string"
    },
    "street-address": {
      "type": "string"
    },
    "locality": {
      "type": "string"
    },
    "region": {
      "type": "string"
    },
    "postal-code": {
      "type": "string"
    },
    "country-name": {
      "type": "string"
    }
  },
  "required": [ "locality", "region", "country-name" ],
  "dependencies": {
    "post-office-box": [ "street-address" ],
    "extended-address": [ "street-address" ]
  }
}
// geographical-location.schema.json
{
  "$id": "http://example.com/geographical-location.schema.json",
  "$schema": "http://json-schema.org/draft-07/schema#",
  "title": "Longitude and Latitude Values",
  "description": "A geographical coordinate.",
  "required": [ "latitude", "longitude" ],
  "type": "object",
  "properties": {
    "latitude": {
      "type": "number",
      "minimum": -90,
      "maximum": 90
    },
    "longitude": {
      "type": "number",
      "minimum": -180,
      "maximum": 180
    }
  }
}
// card.schema.json
{
  "$id": "http://example.com/card.schema.json",
  "$schema": "http://json-schema.org/draft-07/schema#",
  "description": "A representation of a person, company, organization, or place"\
,
  "type": "object",
  "required": [ "familyName", "givenName" ],
  "properties": {
    "fn": {
      "description": "Formatted Name",
      "type": "string"
    },
    "familyName": {
      "type": "string"
    },
    "givenName": {
      "type": "string"
    },
    "additionalName": {
      "type": "array",
      "items": {
        "type": "string"
      }
    },
    "honorificPrefix": {
      "type": "array",
      "items": {
        "type": "string"
      }
    },
    "honorificSuffix": {
      "type": "array",
      "items": {
        "type": "string"
      }
    },
    "nickname": {
      "type": "string"
    },
    "url": {
      "type": "string"
    },
    "email": {
      "type": "object",
      "properties": {
        "type": {
          "type": "string"
        },
        "value": {
          "type": "string"
        }
      }
    },
    "tel": {
      "type": "object",
      "properties": {
        "type": {
          "type": "string"
        },
        "value": {
          "type": "string"
        }
      }
    },
    "adr": { "$ref": "http://example.com/address.schema.json" },
    "geo": { "$ref": "http://example.com/geographical-location.schema.json" },
    "tz": {
      "type": "string"
    },
    "photo": {
      "type": "string"
    },
    "logo": {
      "type": "string"
    },
    "sound": {
      "type": "string"
    },
    "bday": {
      "type": "string"
    },
    "title": {
      "type": "string"
    },
    "role": {
      "type": "string"
    },
    "org": {
      "type": "object",
      "properties": {
        "organizationName": {
          "type": "string"
        },
        "organizationUnit": {
          "type": "string"
        }
      }
    }
  }
}
// card.json
{
    "familyName": "Kato",
    "givenName": "Takashi",
    "adr": {
        "locality": "locality",
        "region": "region",
        "country-name": "The Netherlands"
    },
    "geo": {
        "latitude": 10,
        "longitude": 90
    }
}

バリデーションコードは以下

(import (rnrs)
        (text json)
        (text json schema)
        (text json validator)
        (srfi :26 cut))

(let* ((validators (map json-schema->json-validator
                        (map (cut call-with-input-file <> json-read)
                             '("address.schema.json"
                               "geographical-location.schema.json"))))
       (validator (apply json-schema->json-validator
                         (call-with-input-file "card.schema.json" json-read)
                         validators)))
  (validate-json validator (call-with-input-file "card.json" json-read)))
;; -> #t

一応公式Githubにあるテストは全部通る(ドラフト7、オプショナル除く)。

余談だが、最近書いたYAMLパーサと組み合わせることもできる。以下はカードYAML

---
familyName: Kato
givenName: Takashi
adr:
  locality: locality
  region: region
  country-name: The Netherlands
geo:
  latitude: 10
  longitude: 90

っで、コード

(import (rnrs)
        (text json)
        (text json schema)
        (text json validator)
        (text yaml)
        (srfi :26 cut))

(let* ((validators (map json-schema->json-validator
                        (map (cut call-with-input-file <> json-read)
                             '("address.schema.json"
                               "geographical-location.schema.json"))))
       (validator (apply json-schema->json-validator
                         (call-with-input-file "card.schema.json" json-read)
                         validators)))
  (map (cut validate-json validator <>)
       (call-with-input-file "card.yaml" yaml-read)))
;; -> (#t)

YAMLはドキュメントのリストを返すのでmap辺りでリストを回す必要がある。便利に使えそうな雰囲気がある。

キャッシュバグと手続きの同一性

こんなバグに遭遇した。

ASSERT failure /home/takashi/projects/sagittarius/src/closure.c:50: SG_CODE_BUILDERP(code)

C assertなので、いかんともしがたいやつである。

再現コードはこんな感じ。

;; lib1.scm
(library (lib1)
  (export +closures+)
  (import (rnrs))

(define (foo e)
  (unless (string? e) (assert-violation 'foo "string" e))
  (lambda (v) (string=? v e)))

(define +closures+ `(,foo))
)

;; lib2.scm
(library (lib2)
  (export bar buz)
  (import (rnrs)
          (lib1))

(define (bar s) ((buz) s))
(define (buz) (car +closures+))
)

;; test.scm
(import (rnrs) (lib2))

((bar "s") "s")

何が問題化というと、キャッシュと最適化の問題だったりする。Sagittariusではexportされた変数は変更不可能というのを利用して、キャッシュ可能なオブジェクト(文字列、リスト等)を本来なら大域変数の参照になるところを実際に値にするという最適化がなされる。手続きがSchemeで定義されたもの(closure)であればキャッシュ可能なのと、+closure+に束縛されているのがリストなので、コンパイラはこいつを値に置き換える。

バグの修正はCONSTインストラクションに渡されるオブジェクトをチェックするというものになるのだが(こんな感じ)、まだ完全には直っていない模様(くそったれ！)

このバグで気づいたのだが、Sagittariusでは手続きの同一性が保証されない。以下のコードは1回目と2回目の実行で結果が異なる。

(import (rnrs) (lib1) (lib2))

(eq? (car +closures+) (buz))

個人的にはこれはR6RSなら11.5 Equivalence predicatesにある以下の例の範疇だと思っているのだが、R7RS的には常に#tを返さないといけなかったはず。

(let ((p (lambda (x) x)))
  (eq? p p)) ;; unspecified

(let ((p (lambda (x) x)))
  (eqv? p p)) ;; unspecified

いちおう両方準拠を謳っているから直さないとまずいかねぇ…

YAMLパーサー

個人的にはYAMLは好きではないのだが、世の中の流れはYAMLに行っているのは明白かなぁと思っている。ということで、SagittariusにはYAMLのサポートを入れることにした。こんな感じで使える。

# test.yaml
%YAML 1.2
---
receipt:     Oz-Ware Purchase Invoice
date:        2012-08-06
customer:
    first_name:   Dorothy
    family_name:  Gale

items:
    - part_no:   A4786
      descrip:   Water Bucket (Filled)
      price:     1.47
      quantity:  4

    - part_no:   E1628
      descrip:   High Heeled "Ruby" Slippers
      size:      8
      price:     133.7
      quantity:  1

bill-to:  &id001
    street: |
            123 Tornado Alley
            Suite 16
    city:   East Centerville
    state:  KS

ship-to:  *id001

specialDelivery:  >
    Follow the Yellow Brick
    Road to the Emerald City.
    Pay no attention to the
    man behind the curtain.

(import (rnrs)
        (text yaml))

(call-with-input-file "test.yaml" yaml-read)

#|
(#(("receipt" . "Oz-Ware Purchase Invoice")
   ("date" . "2012-08-06T00:00:00Z")
   ("customer"
    .
    #(("first_name" . "Dorothy")
      ("family_name" . "Gale")))
   ("items"
    #(("part_no" . "A4786")
      ("descrip" . "Water Bucket (Filled)")
      ("price" . 1.47)
      ("quantity" . 4))
    #(("part_no" . "E1628")
      ("descrip" . "High Heeled \"Ruby\" Slippers")
      ("size" . 8)
      ("price" . 133.7)
      ("quantity" . 1)))
   ("bill-to"
    .
    #(("street" . "123 Tornado Alley
Suite 16
")
      ("city" . "East Centerville")
      ("state" . "KS")))
   ("ship-to"
    .
    #(("street" . "123 Tornado Alley
Suite 16
")
      ("city" . "East Centerville")
      ("state" . "KS")))
   ("specialDelivery"
    .
    "Follow the Yellow Brick Road to the Emerald City. Pay no attention to the man behind the curtain.
")))
|#

YAMLは一ファイルの中に複数ドキュメント含むことを許しているのでリストを返すことにした。デフォルトでは(text json)が返す書式と同じものを返すが、オプショナル引数でその辺を制御することもできる。書き出しは以下のようにする。

;; suppose variable yaml is bound to a YAML document
(yaml-write yaml)

;; if it's read by yaml-read, then it should be like this
(for-each yaml-write yaml)

書き出しはあまりこみったことをしないので(複数ラインリテラルとか、ラベルとか)、完全に元のドキュメントに復元はしない可能性がある。(ラベルくらいは実装してもいいかなぁとはブログ書いてて思った。)

これ書いてて思ったのは、YAMLの文法は思った以上に機械に優しくないということか。ヒューマンリーダブルかどうかは議論する気はないが(個人的には読みづらいと思ってる)、一文字ずつ読む感じのPEGでの実装はやる気をなくすレベルであった(ついでに公式サイトにあるBNFは人にも機械にも辛い気がする)。

あとは適当に使ってみて不具合をつぶしていくかね。