Help us understand the problem. What is going on with this article?

Data.Aesonで複数バージョンのJSONをあつかう小手先テクニック

More than 5 years have passed since last update.

フロントエンドとJSON形式のWeb APIを通してやりとりするWebアプリケーションなどで、
JSONの仕様変更に対して対応が容易なプログラムを書きたい。
そしてどうせなら、DeriveGenericの便利さを活かしながら複数バージョンのJSONを並行してあつかえるようにしたい。

もしUser01型とUser02みたいに独立したデータ型を下記のように宣言すると、Multiple declarationsエラーになってしまう。

-- コンパイルできないやつ
{-# LANGUAGE DeriveGeneric #-}

import Data.Aeson
import GHC.Generics
import Data.Text (Text)

data User01 = User01  -- User data for ver 0.1 
            { name  :: Text
            , age   :: Int      -- This column is removed from ver 0.2
            , email :: Text
            }
  deriving (Show, Read, Eq, Generic)
instance FromJSON User01
instance ToJSON   User01

data User02 = User02  -- User data for ver 0.2
            { name    :: Text
            , address :: Text   -- This column is added from ver 0.2
            , email   :: Text
            }
  deriving (Show, Read, Eq, Generic)
instance FromJSON User02
instance ToJSON   User02

仕方ないので個別にparseJSONtoJSONを定義するが、めんどくさいしお昼寝する時間が減ってしまう。

-- お昼寝できないやつ
import Data.Aeson
import Data.Text (Text)

data User01 = User01  -- User data for ver 0.1 
            { name01  :: Text
            , age01   :: Int      -- This column is removed from ver 0.2
            , email01 :: Text
            }
  deriving (Show, Read, Eq)

instance FromJSON User01 where
    parseJSON (Object v) = User01 <$>
                           v .: "name" <*>
                           v .: "age"  <*>
                           v .: "email"
    parseJSON _          = mzero

instance ToJSON User01 where
    toJSON (User01 name age email) = object ["name" .= name, "age" .= age, "email" .= email]

data User02 = User02  -- User data for ver 0.2
            { name02    :: Text
            , address02 :: Text   -- This column is added from ver 0.2
            , email02   :: Text
            }
  deriving (Show, Read, Eq)

instance FromJSON User02 where
    parseJSON (Object v) = User02 <$>
                           v .: "name" <*>
                           v .: "address"  <*>
                           v .: "email"
    parseJSON _          = mzero

instance ToJSON User02 where
    toJSON (User02 name address email) = object ["name" .= name, "address" .= address, "email" .= email]

 instance FromJSON Coord where
     parseJSON (Object v) = Person <$>
                            v .: "name" <*>
                            v .: "age"
     -- A non-Object value is of the wrong type, so fail.
     parseJSON _          = mzero

ということでこうする。

-- お昼寝とコンパイルができるやつ
{-# LANGUAGE DeriveGeneric #-}

import Data.Aeson
import Data.Text (Text)
import GHC.Generics

data User = User01  -- User data for ver 0.1 
            { name  :: Text
            , age   :: Int      -- This column is removed from ver 0.2
            , email :: Text
            }
          | User02  -- User data for ver 0.2
            { name    :: Text
            , address :: Text   -- This column is added from ver 0.2
            , email   :: Text
            }
  deriving (Show, Read, Eq, Generic)

instance FromJSON User
instance ToJSON   User

ただ、このままだと与えられたJSONがUser01の方なのかUser02の方なのかHaskellちゃんが判断に困るので、JSONにtagキーを追加して教えてあげるようにする。

jsonInput01 :: LBS.ByteString
jsonInput01 = "{\"name\": \"me\", \"age\": 17, \"email\": \"me@domain.com\", \"tag\": \"User01\"}"

jsonInput02 :: LBS.ByteString
jsonInput02 = "{\"name\": \"me\", \"address\": \"Tokyo\", \"email\": \"me@domain.com\", \"tag\": \"User02\"}"

ということで、この小手先テクニックを使ったWebサーバもどき。

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}

import Control.Exception
import Data.Aeson
import Data.Maybe (fromJust)
import Data.Text (Text)
import GHC.Generics

import qualified Data.ByteString.Lazy as LBS
import qualified Data.Text as T hiding (Text)
import qualified Data.Text.IO as T

data User = User01  -- User data for ver 0.1 
            { name  :: Text
            , age   :: Int      -- This column is removed from ver 0.2
            , email :: Text
            }
          | User02  -- User data for ver 0.2
            { name    :: Text
            , address :: Text   -- This column is added from ver 0.2
            , email   :: Text
            }
  deriving (Show, Read, Eq, Generic)

instance FromJSON User
instance ToJSON   User

type Routing = String

-- ====================
--  Sample API Handler
-- ====================

-- |
-- >>> main
-- me is 17 years old.
-- me lives in Tokyo.
-- Error: No match in record selector age
-- Error: No match in record selector address
-- me is 17 years old.
-- me lives in Tokyo.
main :: IO ()
main = do
  handleErr $ routing "/api/0.1/getUserMsg" jsonInput01
  handleErr $ routing "/api/0.2/getUserMsg" jsonInput02
  handleErr $ routing "/api/0.1/getUserMsg" jsonInput02
  handleErr $ routing "/api/0.2/getUserMsg" jsonInput01
  handleErr $ routing "/api/getUserMsg"     jsonInput01
  handleErr $ routing "/api/getUserMsg"     jsonInput02

-- | 単にエラーのときにエラー内容を標準出力に表示して処理を続けるだけ
handleErr :: IO () -> IO ()
handleErr = handle errToMsg
 where
  errToMsg :: SomeException -> IO ()
  errToMsg e = putStrLn $ "Error: " ++ show e

-- =================
--  Sample routing
-- =================

-- | ルーティングっぽいやつ
routing :: Routing -> LBS.ByteString -> IO ()
routing "/api/0.1/getUserMsg" = T.putStrLn . getUserMsg01 . fromJust . decode
routing "/api/0.2/getUserMsg" = T.putStrLn . getUserMsg02 . fromJust . decode
routing "/api/getUserMsg"     = T.putStrLn . getUserMsg   . fromJust . decode
routing _ = error "Not Found"

-- ====================
--  Main task
-- ====================

getUserMsg01 :: User -> Text
getUserMsg01 u = T.concat [name u, " is ", T.pack . show $ age u, " years old."]

getUserMsg02 :: User -> Text
getUserMsg02 u = T.concat [name u, " lives in ", address u, "."]

getUserMsg   :: User -> Text
getUserMsg u@User01{} = getUserMsg01 u
getUserMsg u@User02{} = getUserMsg02 u

-- =====================
--  Sample JSON request
-- =====================

jsonInput01 :: LBS.ByteString
jsonInput01 = "{\"name\": \"me\", \"age\": 17, \"email\": \"me@domain.com\", \"tag\": \"User01\"}"

jsonInput02 :: LBS.ByteString
jsonInput02 = "{\"name\": \"me\", \"address\": \"Tokyo\", \"email\": \"me@domain.com\", \"tag\": \"User02\"}"

もちろん、同じデータ型で複数のバージョンを吸収するより、多少手間でも型を分けたほうが健全な構成になるアプリケーションも存在するとは思う。

あ、Haskellとか好きなおもしろい技術で仕事してお昼寝もしたいなら株式会社ARoWって会社がいいって聞いたよ(ステま!)。

arowM
ヤギさんとして自由に生きてるよ さくらちゃんはアーティストだから世の理不尽には頭突きしちゃうよ フリーランスUXハッカー・プログラマー(Elm, Haskell)・技術翻訳・ヤギ語翻訳 ARoW代表 http://arow.info /気吹堂(出版)代表/人材紹介会社CXO http://github.com/arow
https://arow.info
arow-oss
ヘテロジニアスで自律分散型な優しい会社です。 従業員がヘテロジニアスな自律分散ノードとして活躍し、代表が汎用ノードとして全体の仕事の調整や、割り振り先がない仕事の処理を担当するボロ雑巾として活躍してます。 フロントエンド側のヘテロジニアスノードがほしいなー
https://arow.info
Why not register and get more from Qiita?
  1. We will deliver articles that match you
    By following users and tags, you can catch up information on technical fields that you are interested in as a whole
  2. you can read useful information later efficiently
    By "stocking" the articles you like, you can search right away