bigsleepの日記

 | 

2014-11-05

Haskellの型からスキーマみたいなのを取得する

01:22

Aeson

http://hackage.haskell.org/package/aeson

Haskelljsonを扱うときにAesonというライブラリが便利でよく使ってます。

Haskellのデータ型をjsonエンコードしたり、jsonからデータ型にデコードしたりが簡単にできます。


Haskellだけで使う場合はあまりいらない気もするんですが、

他の言語とやりとりしたりする場合にjson schemaみたいなものが

あるといいような気がしてそんな感じのものを生成するものが欲しくて書いてみました。


書いたもの

https://github.com/bigsleep/schema-experiment


Template Haskell

http://hackage.haskell.org/package/template-haskell

AesonにはTemplate Haskellで自動でコード生成してjsonエンコードデコードができるようにする

deriveJSONという便利な関数があります。


ただコードを見たところインスタンス宣言の制約の部分がちょっと不完全で

データ型の型引数に(* -> *)のものがあったりすると使えないようでした。


Template Haskellにはreifyというメソッドがあって、

定義した型の情報を取得してコード生成に利用できます。


これでできるはずと思って最初Template Haskellで書いて見てたんですが

普通のHaskellのコードと大分違ってつらい感があったため

途中でGHC.Genericsを使うことにしました。


GHC.Generics

https://www.haskell.org/haskellwiki/GHC.Generics

これは多分Javaとかに出てくるGenericsとはあまり関係ないものだと思います。

型の情報と値の情報を一般化された形式にエンコードできるようにする仕組みみたいな感じがします。

deriving Genericとか書いておくとreifyみたいに型の情報が手に入るようになります。


AesonにもGHC.Genericsを使ってToJSON, FromJSONを生成する感じのコードがあってこれを真似して

スキーマを生成するコードを書きました。


幽霊型

型からスキーマを生成するときにインスタンスを作らずに型の情報を渡す必要があります。

こういう場合に幽霊型というのが使えるようです。

taggedというライブラリがあったんですが、自分の使う分には数行ですむ感じだったので結局使いませんでした。


https://hackage.haskell.org/package/tagged


生成したもの

適当に下のような感じの例から生成してみました。

data FLAGS = AAA | BBB | CCC  deriving (Show, Eq, Generic)

instance HasSchema FLAGS

data Hoge = Hoge
    { hogeTree :: Tree Int
    , hogeArray :: [String]
    , hogeTuple :: (Int, Bool, String)
    , hogeFlag :: FLAGS
    } deriving (Show, Eq, Generic)

instance HasSchema Hoge where
    schema = genericSchema opts
        where
        opts = defaultOptions { fieldLabelModifier = drop 4 }

data Tree a = Node a (Tree a) (Tree a) | Leaf deriving (Show, Eq, Generic)

instance (HasSchema a) => HasSchema (Tree a) where
    schema = genericSchema defaultOptions { sumEncoding = ObjectWithSingleField }

Showのインスタンスにしたのでprintで表示させると下のような感じでした。

(SchemaAlias "Main.Hoge",fromList [("Main.Hoge",Schema (SchemaValueObject (SchemaObject (fromList [("Array",Schema (SchemaValueArray (SchemaArray (Schema (SchemaValueString SchemaString))))),("Flag",Schema (SchemaValueString (SchemaStringEnum ["AAA","BBB","CCC"]))),("Tree",SchemaAlias "Main.Tree"),("Tuple",Schema (SchemaValueArray (SchemaArrayTuple [Schema (SchemaValueNumber SchemaNumber),Schema (SchemaValueBool SchemaBool),Schema (SchemaValueString SchemaString)])))])))),("Main.Tree",SchemaUnion ObjectWithSingleField (fromList [("Leaf",Schema (SchemaValueArray (SchemaArrayTuple []))),("Node",Schema (SchemaValueArray (SchemaArrayTuple [Schema (SchemaValueNumber SchemaNumber),SchemaAlias "Main.Tree",SchemaAlias "Main.Tree"])))]))])

整形しずらいのでAesonを使ってJSONで出してみたところ下のような感じでした。

階層が深くてあまり読みやすい感じではないですが、とりあえずは必要な情報は出力できてそうな感じでした。

[
  {
    "SchemaAlias": "Main.Hoge"
  },
  {
    "Main.Tree": {
      "SchemaUnion": [
        {
          "contents": [],
          "tag": "ObjectWithSingleField"
        },
        {
          "Leaf": {
            "Schema": {
              "SchemaValueArray": {
                "SchemaArrayTuple": []
              }
            }
          },
          "Node": {
            "Schema": {
              "SchemaValueArray": {
                "SchemaArrayTuple": [
                  {
                    "Schema": {
                      "SchemaValueNumber": []
                    }
                  },
                  {
                    "SchemaAlias": "Main.Tree"
                  },
                  {
                    "SchemaAlias": "Main.Tree"
                  }
                ]
              }
            }
          }
        }
      ]
    },
    "Main.Hoge": {
      "Schema": {
        "SchemaValueObject": {
          "Flag": {
            "Schema": {
              "SchemaValueString": {
                "SchemaStringEnum": [
                  "AAA",
                  "BBB",
                  "CCC"
                ]
              }
            }
          },
          "Array": {
            "Schema": {
              "SchemaValueArray": {
                "SchemaArray": {
                  "Schema": {
                    "SchemaValueString": {
                      "SchemaString": []
                    }
                  }
                }
              }
            }
          },
          "Tree": {
            "SchemaAlias": "Main.Tree"
          },
          "Tuple": {
            "Schema": {
              "SchemaValueArray": {
                "SchemaArrayTuple": [
                  {
                    "Schema": {
                      "SchemaValueNumber": []
                    }
                  },
                  {
                    "Schema": {
                      "SchemaValueBool": []
                    }
                  },
                  {
                    "Schema": {
                      "SchemaValueString": {
                        "SchemaString": []
                      }
                    }
                  }
                ]
              }
            }
          }
        }
      }
    }
  }
]
トラックバック - http://d.hatena.ne.jp/bigsleep/20141105/1415204548
リンク元
 |