Haskellの列挙型のネストをしたい

実現したいこと

JSONパーサーを作っています。

JSONの値を示す列挙型とJSONのトークンを表す列挙型を区別して定義をしたいです。

そしてJSONのトークンを表す型が、JSONの値を表す型を内包するように定義したいです。

しかし、以下のように定義してもJSONToken型にJSONStringやJSONNumberが含まれる訳ではなく、ただ単にJSONValueTypeが他のKEYやCOLON等と同様に定義されるだけです。

haskell
1data JSONValueType=JSONString|JSONNumber|JSONBoolean|JSONArray|JSONObject|JSONNull deriving (Show,Eq)
2data JSONToken=JSONValueType|KEY|COLON|COMMA|OBJECT_OPEN|OBJECT_CLOSE|ARRAY_OPEN|ARRAY_CLOSE deriving (Show,Eq)

理想の動作としては
・JSONString::JSONTokenかつJSONString::JSONValueTypeが可能
・OBJECT_OPEN::JSONTokenは可能だがOBJECT_OPEN::JSONValueTypeは不可能

図式化して表すと以下のようにしたいです。

これを実現することは可能でしょうか?
可能ならばそれを実現する方法を教えて頂きたいです。

行動規範の内容に同意します

回答1件

ベストアンサー

はい、可能です。
なぜかというと、データ型を定義する際にデータ構築子が引数を取るようにできるためです。

いま、以下の定義です。

haskell
1data JSONValueType
2  = JSONString
3  | JSONNumber
4  | JSONBoolean
5  | JSONArray
6  | JSONObject
7  | JSONNull
8  deriving (Show, Eq)
9
10data JSONToken
11  = JSONValueType
12  | KEY
13  | COLON
14  | COMMA
15  | OBJECT_OPEN
16  | OBJECT_CLOSE
17  | ARRAY_OPEN
18  | ARRAY_CLOSE
19  deriving (Show, Eq)

ここでデータ型JSONValueTypeの名前とデータ型JSONTokenのデータ構築子の1つJSONValueTypeが同名でやや紛らわしいため、後者をVALUEに改名します。

haskell
1data JSONToken
2  = VALUE -- 改名
3  | KEY
4  | COLON
5  | COMMA
6  | OBJECT_OPEN
7  | OBJECT_CLOSE
8  | ARRAY_OPEN
9  | ARRAY_CLOSE
10  deriving (Show, Eq)

そして「JSONのトークンを表す型が、JSONの値を表す型を内包するように定義したい」ため、JSONのトークンを表す型であるJSONTokenの一部のデータ構築子が型JSONValueTypeの値を取れるようにします。

haskell
1data JSONToken
2  = VALUE JSONValueType -- 追加
3  | KEY
4  | COLON
5  | COMMA
6  | OBJECT_OPEN
7  | OBJECT_CLOSE
8  | ARRAY_OPEN
9  | ARRAY_CLOSE
10  deriving (Show, Eq)

動かしてみましょう。

shell
1$ ghci main.hs 
2GHCi, version 8.10.7: https://www.haskell.org/ghc/  :? for help
3...
4Ok, one module loaded.
5*Main> :t KEY
6KEY :: JSONToken
7*Main> :t VALUE
8VALUE :: JSONValueType -> JSONToken
9*Main> :t VALUE JSONString
10VALUE JSONString :: JSONToken

データ構築子KEYは引数を取らずして型JSONTokenであるのに対し、VALUEのほうはJSONValueTypeの値を取り、これも型JSONTokenになりました。

なお、余談ですがデータ型の定義方法には以下の形もあります。
こちらのほうがデータ構築子が引数を取る様子を見やすいかもしれません。

haskell
1{-# LANGUAGE GADTs #-}
2
3...
4
5data JSONToken where
6  VALUE        :: JSONValueType -> JSONToken
7  KEY          ::                  JSONToken
8  COLON        ::                  JSONToken
9  COMMA        ::                  JSONToken
10  OBJECT_OPEN  ::                  JSONToken
11  OBJECT_CLOSE ::                  JSONToken
12  ARRAY_OPEN   ::                  JSONToken
13  ARRAY_CLOSE  ::                  JSONToken