reounoの投稿 - Crieit

Data.Aesonの使い方

2019-09-29T19:46:32+09:00

HaskellのJSONライブラリとしておそらくメジャーなData.Aesonですが、使い方が難しいので色々試行錯誤しています。

以降のコードはghci上で実行することを想定しています。
適当にstackでプロジェクトを作って、aesonをcabalファイルのbuild-dependsに追加してビルドし、stack ghciとするのが良いと思います。あと、Data.TextやData.HashMapなども必要です。

# ここはターミナルで
stack new sandbox-prj simple
cd sandbox-prj
# cabalファイルのbuild-dependsにaeson, text, unordered-containers, vectorを追記
stack build
stack ghci

はじめに、以下をghci上でコピペしておいてください。以降のコードが全部動くはずです。

-- ghci上で
-- 最初にこれらをコピペしておくと、以降のコードが全部動くはず

-- 後でGHC拡張を使う
:set -XDeriveGeneric
:set -XExistentialQuantification
:set -XFlexibleContexts
:set -XFlexibleInstances
:set -XGADTs
:set -XInstanceSigs
:set -XOverloadedStrings
:set -XTypeFamilies
:set +m

-- 後で色々使う
import Control.Applicative (empty, pure)
import Data.Aeson
import qualified Data.Aeson.Encoding.Internal as DAE
import Data.Aeson.Types
import Data.Char (toLower, toUpper)
import qualified Data.HashMap.Lazy as HML
import qualified Data.HashMap.Strict as HMS
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Vector as V
import GHC.Generics

基本的な使い方

基本的な型については特にパーサーを定義しなくて良いので、いきなりエンコード・デコードできます。

エンコード

encode 1
-- --> "1"
encode "hello"
-- --> "\"hello\""
encode [1,2,3]
-- --> "[1,2,3]"
encode (1,2)
-- --> "[1,2]"
encode (Just 1)
-- --> "1"
encode True
-- --> "true"
encode Null
-- --> "null"
encode (1234, "hello", True, False, [1,2,3], Just 10)
-- --> "[1234,\"hello\",true,false,[1,2,3],10]"

デコードは、Haskellの型を指定する必要があります。

-- 型を指定しないとデコードできない
decode "1"
-- --> Nothing

decode "1" :: Maybe Int
-- --> Just 1
decode "\"hello\"" :: Maybe String
-- --> Just "hello"
decode "[1234,\"hello\",true,false,[1,2,3],10]" :: Maybe (Int,String,Bool,Bool,[Int],Maybe Int)
-- --> Just (1234,"hello",True,False,[1,2,3],Just 10)

Haskellのレコードを使うときは、以下のように型名のプレフィックスをフィールド名につけて定義することが多いかもしれません（あるいはlensなどを使うのかもしれませんが）。それでも、JSONのフィールド名はシンプルに"title", "created"としておきたいですよね。
こういう場合、defaultOptionsというのを使います。fieldLabelModifierに、フィールド名の変換関数を定義しておけば、エンコード時に適用してくれます。ここでは、プレフィックス（"movie"の5文字）を取り除き、かつ小文字にするというルールにしました。

:{
data Movie = Movie
  { movieTitle :: String
  , movieCreated :: Int
  } deriving (Show, Generic)
:}
movieOptions = defaultOptions {fieldLabelModifier = map toLower . drop 5}
instance ToJSON Movie where
  toEncoding = genericToEncoding movieOptions
instance FromJSON Movie where
  parseJSON = genericParseJSON movieOptions


movie = Movie "The Matrix" 1999

encode movie
-- --> "{\"title\":\"The Matrix\",\"created\":1999}"

decode "{\"title\":\"The Matrix\",\"created\":1999}" :: Maybe Movie
-- --> Just (Movie {movieTitle = "The Matrix", movieCreated = 1999})

エンコーダー・デコーダーを自前で定義

では、代数データ型の場合はどうでしょうか。基本的には以下のように自動導出できます。

data Size = Small|Medium|Large deriving (Show, Generic)
instance ToJSON Size
instance FromJSON Size

encode [Small, Medium, Large]
-- --> "[\"Small\",\"Medium\",\"Large\"]"

decode "[\"Small\",\"Medium\",\"Large\"]" :: Maybe [Size]
-- --> Just [Small,Medium,Large]

ただ、JSONデータではキャメルケースでなくsmall, medium, largeのように小文字で表現したいかもしれません。その場合は、以下のように自分で定義する必要があります。ToJSONのインスタンスにするには、toJSONか、toEncodingを自分で定義します。以下のような型です。

toJSON :: a -> Value
toEncoding :: a -> Encoding

toJSONは任意の型をData.AesonのValue型にします。したがって、toJSONのみを定義した場合は、toEncodingが自動導出されます。JSONにエンコードするときは、一旦Valueに変換され、その後JSONの文字列に変換されます。
一方、toEncodingを直接定義することもできて、その場合は、Valueを経由せず直接エンコードされることになります。ここには歴史的経緯があるようです。

-- toJSONを定義する場合
data Size = Small|Medium|Large deriving (Show, Generic)
instance ToJSON Size where
  toJSON Small = String "small"
  toJSON Medium = String "medium"
  toJSON Large = String "large"

encode [Small, Medium, Large]
-- --> "[\"small\",\"medium\",\"large\"]"

-- toEncodingを定義する場合
data Size = Small|Medium|Large deriving (Show, Generic)
instance ToJSON Size where
  toEncoding Small = DAE.string "small"
  toEncoding Medium = DAE.string "medium"
  toEncoding Large = DAE.string "large"

encode [Small, Medium, Large]
-- --> "[\"small\",\"medium\",\"large\"]"

FromJSONのインスタンスについては、parseJSONを定義します。こちらは少し面倒です。以下のような型をしています。

parseJSON :: Value -> Parser a

-- withTextの第一引数（"Size"）は、どんな文字列でも良いみたい。
-- なんのための引数なのかまだわかっていない。
instance FromJSON Size where
  parseJSON = withText "Size" $ \t ->
    fromString (TL.unpack (TL.fromStrict t))
    where fromString :: String -> Parser Size
          fromString "small" = pure Small
          fromString "medium" = pure Medium
          fromString "large" = pure Large
          fromString _ = empty

decode "[\"small\",\"medium\",\"large\"]" :: Maybe [Size]
-- --> Just [Small,Medium,Large]

これで、Sizeデータを使ったレコードもエンコード・デコードすることができます。

:{
data Tomato = Tomato
  { size :: Size
  , brand :: String
  } deriving (Show, Generic)
:}
instance ToJSON Tomato
instance FromJSON Tomato

mini = Tomato Small "famous brand name"

encode mini
-- --> "{\"size\":\"small\",\"brand\":\"famous brand name\"}"

decode "{\"size\":\"small\",\"brand\":\"famous brand name\"}"
-- --> Just (Tomato {size = Small, brand = "famous brand name"})

多相型

このようなデータ型でもこれまでと同じようにToJSON・FromJSONのインスタンスにすることができます。自動導出の場合は、以下の例のようにエンコード時にWrapが外れます。

data Wrap a = Wrap a deriving (Show, Generic)
instance ToJSON a => ToJSON (Wrap a)
instance FromJSON a => FromJSON (Wrap a)

encode $ Wrap 1
-- --> "1"
encode $ Wrap "wrapped"
-- --> "\"wrapped\""

decode "1" :: Maybe (Wrap Int)
-- --> Just (Wrap 1)
decode "\"wrapped\"" :: Maybe (Wrap String)
-- --> Just (Wrap "wrapped")

今度はPoint a型で考えます。自動導出で問題ない場合は良いのですが、自分で定義しようとした時に、少し悩みました。toJSONもparseJSONも、aの部分の値をエンコード・デコードする処理を自分で定義してしまうと型を決めなくてはなりません。そうするとaのままではできず、Point Intなどの具体的な型で定義せざるを得ません。そこで、aの部分については、自分で定義せず、toJSONやparseJSONをそのまま使います。もともとaはそれらのインスタンスであることを仮定しているので、自分で定義する必要がありません。以下のように書くと、型引数をとる型についても定義できます。

data Point a = Point a a deriving (Show, Generic)
instance ToJSON a => ToJSON (Point a) where
  toJSON (Point x y) = Object $ HMS.fromList [("point", toJSON [x,y])]

:{
instance FromJSON a => FromJSON (Point a) where
  parseJSON (Object o) = case HML.lookup "point" o of
    Just arr -> let
                    pts = parseJSON arr :: FromJSON b => Parser (b, b)
                in
                    Point <$> (fst <$> pts) <*> (snd <$> pts)
    Nothing -> empty
:}

pi = Point 1 2
ps = Point "one" "two"

encode pi
-- --> "{\"point\":[1,2]}"

encode ps
-- --> "{\"point\":[\"one\",\"two\"]}"

decode "{\"point\":[1,2]}" :: Maybe (Point Int)
-- --> Just (Point 1 2)

decode "{\"point\":[\"one\",\"two\"]}" :: Maybe (Point String)
-- --> Just (Point "one" "two")

少し複雑な代数データ型

data Gender = Female|Male deriving (Show, Generic)
data Property = Name String|Age Int|Gender Gender deriving (Show, Generic)
instance ToJSON Gender
instance FromJSON Gender
instance ToJSON Property
instance FromJSON Property

props = [Name "Neo", Age 30, Gender Male]

encode props
-- --> "[{\"tag\":\"Name\",\"contents\":\"Neo\"},{\"tag\":\"Age\",\"contents\":30},{\"tag\":\"Gender\",\"contents\":\"Male\"}]"

decode "[{\"tag\":\"Name\",\"contents\":\"Neo\"},{\"tag\":\"Age\",\"contents\":30},{\"tag\":\"Gender\",\"contents\":\"Male\"}]" :: Maybe [Property]
-- --> Just [Name "Neo",Age 30,Gender Male]

このような型でもすべて自動導出できました。しかし、JSONのフォーマットは微妙ですね。以下のようになって欲しいです。（レコード型で定義すれば良いだけの話なのですが、今は例ということで。。）

{ "name": "Neo", "age": 30, "gender": "male" }

自前で定義しましょう。名前を変えるため別の例にしますが、データ構造はほぼ一緒です。

data CarType = Coupe|SUV deriving (Show, Generic)
data Car = Model String|Release Int|CarType CarType deriving (Show, Generic)

instance ToJSON CarType where
  toJSON Coupe = String "coupe"
  toJSON SUV = String "suv"

instance FromJSON CarType where
  parseJSON = withText "CarType" $ \t ->
    fromString (T.unpack t)
    where fromString :: String -> Parser CarType
          fromString "coupe" = pure Coupe
          fromString "suv" = pure SUV
          fromString _ = empty

instance ToJSON Car where
  toJSON (Model s) = object [("model", toJSON s)]
  toJSON (Release i) = object [("release", toJSON i)]
  toJSON (CarType c) = object [("car_type", toJSON c)]

instance FromJSON Car where
  parseJSON (Object o) = case HML.lookup "model" o of
    Just (String s) -> pure (Model $ T.unpack s)
    _ -> case HML.lookup "release" o of
      Just i -> Release <$> (parseJSON i :: Parser Int)
      _ -> case HML.lookup "car_type" o of
        Just t -> CarType <$> (parseJSON t :: Parser CarType)

myCar = [Model "Land Cruiser", Release 1954, CarType SUV]

encode myCar
-- --> "[{\"model\":\"Land Cruiser\"},{\"release\":1954},{\"car_type\":\"suv\"}]"

decode "[{\"model\":\"Land Cruiser\"},{\"release\":1954},{\"car_type\":\"suv\"}]" :: Maybe [Car]
-- --> Just [Model "Land Cruiser",Release 1954,CarType SUV]

これで、望みのJSON形式でエンコード・デコードできるようになりました。

Either型

Either型の場合はどうなるでしょうか。わからないのでまずは自動導出して見ましょう。

:{
data Filter = Filter
  { value :: Either String [String] } deriving (Show, Generic)
:}
instance ToJSON Filter
instance FromJSON Filter

filterL = Filter (Left "eq")
filterR = Filter (Right ["eq", "gt"])

encode filterL
-- --> "{\"value\":{\"Left\":\"eq\"}}"

encode filterR
-- --> "{\"value\":{\"Right\":[\"eq\",\"gt\"]}}"

decode "{\"value\":{\"Left\":\"eq\"}}" :: Maybe (Filter)
-- --> Just (Filter {value = Left "eq"})

decode "{\"value\":{\"Right\":[\"eq\",\"gt\"]}}" :: Maybe (Filter)
-- --> Just (Filter {value = Right ["eq","gt"]})

一応できました。しかし、JSONデータの中に"Left"や"Right"が入ってしまって冗長です。この場合は、以下のようになって欲しいですね。

# Leftの場合
{"value": "eq"}

# Rightの場合
{"value": ["eq", "gt"]}

以下のように定義しましょう。別の例にするのが面倒なので、同じデータを再定義します。

:{
data Filter = Filter
  { value :: Either String [String] } deriving (Show, Generic)
:}
instance ToJSON Filter where
  toJSON (Filter (Left s)) = object [("value", toJSON s)]
  toJSON (Filter (Right ss)) = object [("value", toJSON ss)]

-- Arrayの時に、判定できていないのが難点
-- でも、失敗した時はちゃんとNothingを返してくれるのでとりあえず良いか
instance FromJSON Filter where
  parseJSON (Object o) = case HML.lookup "value" o of
    Just (String s) -> pure (Filter (Left $ T.unpack s))
    Just arr -> (Filter . Right) <$> (parseJSON arr :: Parser [String])
    _ -> empty

filterL = Filter (Left "eq")
filterR = Filter (Right ["eq", "gt"])

encode filterL
-- --> "{\"value\":\"eq\"}"

encode filterR
-- --> "{\"value\":[\"eq\",\"gt\"]}"

decode "{\"value\":\"eq\"}" :: Maybe Filter
-- --> Just (Filter {value = Left "eq"})

decode "{\"value\":[\"eq\",\"gt\"]}" :: Maybe Filter
-- --> Just (Filter {value = Right ["eq","gt"]})

Either型の場合もこのように定義することで自由にJSONとの変換ができます。ちなみに上記の例のようにではなく、Either String aとしてエラーメッセージ付きのMaybeのような扱いをしたい場合は、専用の関数がすでに用意されているようです。

GADT

この場合は、Field StringとField Boolの場合でそれぞれ定義するしかなさそうです。もしまとめて定義する方法があれば誰か教えてください。

data Field typ = (typ ~ String) => Title | (typ ~ Bool) => Done

instance Show (Field typ) where
  show Title = "Title"
  show Done = "Done"

instance ToJSON (Field typ) where
  toJSON Title = String "title"
  toJSON Done = String "done"

:{
instance FromJSON (Field String) where
  parseJSON = withText "Field" $ \v -> case v of
    "title" -> pure Title
    _ -> empty
instance FromJSON (Field Bool) where
  parseJSON = withText "Field" $ \v -> case v of
    "done" -> pure Done
    _ -> empty
:}
encode Title
-- --> "\"title\""
encode Done
-- --> "\"done\""
decode "\"title\"" :: Maybe (Field String)
-- --> Just Title
decode "\"done\"" :: Maybe (Field Bool)
-- --> Just Done

で、このFieldを使って、以下のようなレコードを定義します。

:{
data Filter = forall typ. Show typ => Filter
            { field :: Field typ
            , value :: typ
            }
:}

なぜこんなデータ型を考えているかというと、実はpersistentのクラスに、Filterっていうのがあって、これをFromJSONのインスタンスにしたかったのです。このデータをもう少し簡易にしたものが、上で定義したFilterです。ここでの肝は、型引数のtypが型としては明示的に現れていない点です。つまりFilter Title "some title"も、Filter Done Trueも型としては単にFilter型ですが、前者のtypはStringで後者はBoolです。

-- どちらも単にFilter型
:t Filter Title "some title"
-- --> Filter Title "some title" :: Filter

:t Filter Done True
-- --> Filter Done True :: Filter

このようなデータ型の場合、先ほどFieldのFromJSONをField StringとField Boolでそれぞれ定義した時のようなことができません。fieldの値がTitleならtypはString、DoneならBoolというような場合分けをする必要があります。色々試行錯誤してようやくできた定義が以下です。mayTitleとmayDoneの場合分けのところは、この2つデータの型が違うので、それぞれ別の変数にせざるを得ませんでした。そのためmayFieldを必ず2回評価することになり、無駄の多い実装になってしまいました。

instance FromJSON Filter where
        parseJSON (Object o) = do
            let mayField = HMS.lookup "field" o
            let mayValue = HMS.lookup "value" o
            let mayTitle = case mayField of
                               Just (String "title") -> Just Title
                               _ -> Nothing
            let mayDone = case mayField of
                              Just (String "done") -> Just Done
                              _ -> Nothing
            case mayValue of
                Just value -> do
                    case mayTitle of
                        Just title -> Filter title <$> (parseJSON value :: Parser String)
                        Nothing -> case mayDone of
                                       Just done -> Filter done <$> (parseJSON value :: Parser Bool)
                                       Nothing -> empty
                Nothing -> empty

-- Filter Title "some title"
case decode "{\"field\":\"title\", \"value\":\"some title\"}" :: Maybe Filter of
    Just (Filter field value) -> print value
    Nothing -> print Nothing

-- Filter Done True
case decode "{\"field\":\"done\", \"value\":true}" :: Maybe Filter of
    Just (Filter field value) -> print value
    Nothing -> print Nothing

Haskellで複雑度測定

2019-09-23T09:59:26+09:00

※ この記事はHaskellで複雑度測定からの転載です。

自分で書いているブログのPVが増えなくて悲しいので、こういうところにも載せて見たら多少増えるんじゃないかと思って試しに載せて見ます。

Haskellでサイクロマティック複雑度（循環的複雑度）を測定する場合、2つツールがあるようです。

githubのスター数はargonの方が多いのですが、コミット履歴を見るとhomplexityの方が今もメンテナンスされているようなのでhomplexityがオススメです。機能的な違いは特に調べていません。

homplexityの機能

公式サイトによれば、以下の統計値を出してくれるようです。

Cyclomatic complexity
Code metric
Lines of code
Branching depth
Type metric
Comment metric
Code to comments ratio
Type tree nodes
Number of function arguments

本題から外れますがBranching depthってなんでしょうか。説明には

Branching is used with conditionals and has been used as a criterion for both software complexity and logic.

と書いてあります。分岐の数のことなんでしょうか。ちょっと試して見たところ、if分岐がある場合でも0でしたが、ifの中にifをネストさせると1になり、ifの中にifの中にifとネストさせると2になりました。だから分岐の深さってことか。なんかサイクロマティック複雑度と似ていますね。

homplexityのインストール

stackが入っていれば簡単です。クローンしてstack installするだけです。

git clone https://github.com/mgajda/homplexity.git
cd homplexity
stack install

で、~/.local/binにhomplexity-cliができるはずです。パスを通すなら、~/.bashrcや~/.bash_profileなどに

PATH=$PATH:~/.local/bin

を追記すれば良いです。

これで簡単にインストールできるのは良いのですが、このリポジトリで指定しているGHCバージョンが入っていない場合、そのインストールと依存パッケージのインストールから始めるので結構時間がかかるかもしれません。これがstackのデメリットですよね（メリットなのか？cabal hellという言葉を思い出した、そしてWhat is Cabal Hell?というStackoverflowを見つけたw）。

使い方

githubリポにも書いてありますが、以下のようにメインモジュールファイルと依存モジュールのルートディレクトリを指定します。

# プロジェクトディレクトリ構成がこのようになっている場合
root --- app --- Main.hs
      |
      |- src --- Lib.hs
              |- ...

homplexity-cli app/Main.hs src/

これで、メインモジュールと依存モジュールファイル群を見つけて各メソッドの複雑度を測定してくれます。出力は、

Warning:src/InterfaceAdapter/Presenter/StockAPIHandler.hs:SrcLoc "src/InterfaceAdapter/Presenter/StockAPIHandler.hs" 34 1:function stockServer has 48 lines of code should be kept below 20 lines of code.
Correctly parsed 16 out of 16 input files.

こんなのが出てきます。このファイルのこのメソッドが48行もあるから20行未満に抑えた方が良いよ、と言っています。これは複雑度ではありませんが。

もっと詳細な情報を出して欲しい場合は--severityというオプションを使います。ログレベルの設定のような感じです。homplexity -hを見てもらえばわかりますが、

# ヘルプの説明
 --severity={Debug|Info|Warning|Critical}  level of output verbosity (Debug Info Warning Critical) (default: Warning, from module: Main)

とのことなのでデフォルトはWarningですがInfoにすればもっと色々出てきます。以下はInfoで解析した時の出力の一部です。

homplexity-cli --severity=Info app/Main.hs src/
Info:app/Main.hs:SrcLoc "app/Main.hs" 1 1:module Main has 14 lines of code
Info:app/Main.hs:SrcLoc "app/Main.hs" 8 1:type signature for main has type constructor nesting of 1
Info:app/Main.hs:SrcLoc "app/Main.hs" 8 1:type signature for main has 1 arguments
Info:app/Main.hs:SrcLoc "app/Main.hs" 9 1:function main has 8 lines of code
Info:app/Main.hs:SrcLoc "app/Main.hs" 9 1:function main has cyclomatic complexity of 1
Info:app/Main.hs:SrcLoc "app/Main.hs" 9 1:function main has branching depth of 0

メソッドの行数
コンストラクタのネスト数
引数の数（＋1された数字が出ている？Haskellの関数には暗黙的な引数が一つあるのかな？それか単に型一つにつき1とカウントしているのかな？）
サイクロマティック複雑度
Branching depth
が出てきました。

これは、Makefileなどに書いておいて、毎回ビルドの時に一緒に測定してもらうなどが良さそうですね。それかIDEでファイル保存のトリガーで実行してくれる方が良いのかな。そこで警告などが出てくれればソースコードを見直そうという気になるかもしれません。