この記事は，Haskell Advent Calendar 2022の20日目の記事です．
この記事では，Haskellライブラリの一つであるsybの簡単な紹介と，実際に私がプロジェクトの中で使用した例を紹介します．
本文はCC BY 4.0の下で利用可能です．またソースコードはWTFPLの下で利用可能です．
| 名前 | バージョン |
|---|---|
| Stack | 2.9.1 |
| Stack resolver | LTS 20.4 |
| GHCやライブラリのバージョン | LTSで指定されているものを使用 |
sybとはScrap Your Boilerplateの略です．Data型クラスやTypeableを利用して，データ構造に含まれている特定の型の値だけに対して操作を行ったり，特定の型の値だけを抽出するなどといったことが可能になります．
Haskell Wikiにいくつか論文が紹介されていますが，特にScrap Your Boilerplate: A Practical Design Pattern for Generic Programmingは読みやすいのでおすすめです．
以下の説明では，以下の，様々な世界に住む住民や集団の情報を一つのデータ構造に含めたものを用います．
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
module Lib
( gfoldlMember
, testMembersFromWorld
, testMembersFromWorldWithListify
, testListMossalcadiaMania
, testSummonAllGroupsInKumamotoCastle
, testAppendWorldForData
, testAllNothing
) where
import Data.Data (Data)
import Data.Generics.Aliases (mkT)
import Data.Generics.Schemes (everywhere, listify)
import Data.List (nub)
import Test.Hspec (Spec, describe, it, shouldBe)
import Type.Reflection (eqTypeRep, pattern App, typeRep,
(:~~:) (HRefl))
data World =
World
{ worldName :: String
, groups :: [Group]
}
deriving (Data, Eq)
data Group =
Group
{ groupName :: String
, place :: String
, members :: [Member]
}
deriving (Data, Eq)
data Member =
Member
{ memberName :: String
, anotherName :: String
, age :: Maybe Int
, favoriteMoss :: Maybe String
}
deriving (Data, Eq, Show)
worlds :: [World]
worlds =
[ World
{ worldName = "イルヴァ"
, groups =
[ Group
{ groupName = "エレア"
, place = "ノースティリス"
, members =
[ Member
{ memberName = "ロミアス"
, anotherName = "異形の森の使者"
, age = Just 24
, favoriteMoss = Nothing
}
, Member
{ memberName = "ラーネイレ"
, anotherName = "風を聴く者"
, age = Just 22
, favoriteMoss = Nothing
}
]
}
, Group
{ groupName = "ヴェルニースの人達"
, place = "ヴェルニース"
, members =
[ Member
{ memberName = "ウェゼル"
, anotherName = "ザナンの白き鷹"
, age = Just 31
, favoriteMoss = Nothing
}
, Member
{ memberName = "ロイター"
, anotherName = "ザナンの紅の英雄"
, age = Just 32
, favoriteMoss = Nothing
}
]
}
]
}
, World
{ worldName = "ざくざくアクターズの世界"
, groups =
[ Group
{ groupName = "ハグレ王国"
, place = "ハグレ王国"
, members =
[ Member
{ memberName = "デーリッチ"
, anotherName = "ハグレ王国国王"
, age = Nothing
, favoriteMoss = Nothing
}
, Member
{ memberName = "ローズマリー"
, anotherName = "ビッグモス"
, age = Nothing
, favoriteMoss = Just "モスアルカディア"
}
]
}
]
}
]sybを利用するためには，型がData型クラスを実装している必要があります．Data型クラスの詳細についてはドキュメントを確認してください．
何はともあれまずは実装方法ですが，GHCの拡張機能であるDeriveDataTypeableを有効にして，deriving (Data)で完了です．もちろん手動で実装することも可能ですが，deriveしたほうが楽です．
以下の説明は，型に対しData型クラスが適切に実装されていることを前提としています．
例えばWorldに含まれているMemberをすべて抽出する関数を書きたいとしましょう．そのような関数を単純に書くと，以下のmembersFromWorld関数のようになります．
membersFromWorld :: World -> [Member]
membersFromWorld = concatMap members . groups簡単ですね．以下のテストコードで動作を確かめることができます．
（本来テストコードは別の場所に書くべきですが，ここではGHCiなどの出力を載せる代わりにテストコードで実際の挙動を示しています．CIでテストコードを実行しているので，LTSなどのバージョンを上げた際，仮に将来動作が変更されたとしても，それに気付けるようにしています）
allMembersInWorld :: [Member]
allMembersInWorld =
[ Member
{ memberName = "ロミアス"
, anotherName = "異形の森の使者"
, age = Just 24
, favoriteMoss = Nothing
}
, Member
{ memberName = "ラーネイレ"
, anotherName = "風を聴く者"
, age = Just 22
, favoriteMoss = Nothing
}
, Member
{ memberName = "ウェゼル"
, anotherName = "ザナンの白き鷹"
, age = Just 31
, favoriteMoss = Nothing
}
, Member
{ memberName = "ロイター"
, anotherName = "ザナンの紅の英雄"
, age = Just 32
, favoriteMoss = Nothing
}
, Member
{ memberName = "デーリッチ"
, anotherName = "ハグレ王国国王"
, age = Nothing
, favoriteMoss = Nothing
}
, Member
{ memberName = "ローズマリー"
, anotherName = "ビッグモス"
, age = Nothing
, favoriteMoss = Just "モスアルカディア"
}
]
testMembersFromWorld :: Spec
testMembersFromWorld =
describe "membersFromWorld" $
it "`World`に含まれるすべての`Member`を返す．" $
concatMap membersFromWorld worlds `shouldBe` allMembersInWorld今回の場合，Worldの構造があまり複雑ではないため，いくつかの関数を用いて簡単に抽出することが出来ました．しかし，例えばMaybeが使われていたり，構造がもっと大きく複雑だったり，型引数が使用されていたりすると，今回のようにセレクタ関数を組み合わせて抽出する方法は難しくなります．
そのような場合，sybのlistify関数を用いるとすんなり書けます．
membersFromWorldWithListify :: World -> [Member]
membersFromWorldWithListify = listify onlyMember
where
onlyMember :: Member -> Bool
onlyMember = const True
testMembersFromWorldWithListify :: Spec
testMembersFromWorldWithListify =
describe "membersFromWorldWithListify" $
it "`membersFromWorld`と同じ機能を持つ" $
concatMap membersFromWorldWithListify worlds `shouldBe`
concatMap membersFromWorld worldslistify関数は，抽出する値の条件を指定する関数を受け取り，「Dataを実装する任意の型の値を受け取り，その値に含まれている値のうち，条件を満たす値をリストとして返す」関数を返します．
listify関数のシグネチャはTypeable r => (r -> Bool) -> GenericQ [r]となっています．このrが，最終的なリストの要素の型となります．すなわちこの関数が返す関数は，受け取った値に含まれている型rの値に対し，それが条件を満たすかどうかを確認しています．上記の場合，const Trueで常にTrueを返すことで，型rの値を常に抽出するするようにします．
なお，GenericQはforall a. Data a => a -> rのエイリアスです．また，ドキュメントに記載されているように，GHC7.10以降，全ての型は自動でTypeableをderiveしているため，型変数などを用いていなければ基本的にlistifyを任意の型に対して使用することができると考えて大丈夫です．以下に引用します．
Since GHC 7.10, all types automatically have Typeable instances derived. This is in contrast to previous releases where Typeable had to be explicitly derived using the DeriveDataTypeable language extension.
引数で抽出する条件を指定するため，例えばモスアルカディアが好きな人物だけを抽出することも可能です．
listMossalcadiaMania :: World -> [Member]
listMossalcadiaMania = listify f
where
f :: Member -> Bool
f = (== Just "モスアルカディア") . favoriteMoss
testListMossalcadiaMania :: Spec
testListMossalcadiaMania =
describe "listMossalcadiaMania" $
it "モスアルカディアが好きな`Member`をリストで返す" $
concatMap listMossalcadiaMania worlds `shouldBe` expected
where
expected =
[ Member
{ memberName = "ローズマリー"
, anotherName = "ビッグモス"
, age = Nothing
, favoriteMoss = Just "モスアルカディア"
}
]妙な話ですが，例えば全ての集団が突然熊本城に召喚されたとしましょう．Groupのplaceを全て"熊本城"に変更しなければなりません．やはりこれも小規模のデータ構造ならいくつの関数を定義すればどうにかなります．しかし大規模なものになると手に負えません．
このような場合，sybで定義されているeverywhereを使うと楽に書けます．
summonAllGroupsInKumamotoCastle :: World -> World
summonAllGroupsInKumamotoCastle = everywhere (mkT f)
where
f :: Group -> Group
f x = x {place = "熊本城"}
testSummonAllGroupsInKumamotoCastle :: Spec
testSummonAllGroupsInKumamotoCastle =
describe "summonAllGroupsInKumamotoCastle" $
it "`World`のすべての`Group`の`place`を\"熊本城\"に設定する" $
nub (fmap place $ listify f $ fmap summonAllGroupsInKumamotoCastle worlds) `shouldBe`
["熊本城"]
where
f :: Group -> Bool
f = const Trueeverywhereは値を変更するための関数を受け取り，「Dataを実装している任意の型の値を受け取り，それに含まれている全ての値に対して，先に受け取った関数を適用する」関数を返します．fmapのようなものです．
everywhereのシグネチャは(forall a. Data a => a -> a) -> forall a. Data a => a -> aとなっています．listifyの場合，引数の型はTypeable r => (r -> Bool)でしたので，単純にMember -> Boolなどと，適当な型の値を受け取ってBool値を返す関数を渡せばよいのですが，everywhereはDataを実装する任意の型を受け取って，同じ型の値を返す関数を定義しなければならず，ある特定の型の値に対する操作を行うのは不可能のように見えます．
ここで利用するものがmkTです．mkTのシグネチャは(Typeable a, Typeable b) => (b -> b) -> a -> aですが，この関数は，b型の値を受け取り，同じ型の値を返す関数を受け取り，それをTypeableな任意の型aの値を受け取り，同じ型の値を返す関数に拡張します．この際，受け取った値の型が実際にはbである場合，受け取った関数を適用し，そうでなければ単純に受け取った値を返すようになります．以下に実行例を示します．
appendWorld :: String -> String
appendWorld = (++ " World")
appendWorldForData :: Data a => a -> a
appendWorldForData = mkT appendWorld
testAppendWorldForData :: Spec
testAppendWorldForData =
describe "appendWorldForData" $ do
it "受け取った値の型が`String`なら，\" World\"を付加する" $
appendWorldForData "Hello" `shouldBe` "Hello World"
it "受け取った値の型が`String`ではないなら，受け取った値をそのまま返す" $
appendWorldForData (3 :: Int) `shouldBe` 3上記の熊本城の例では，関数f :: Group -> GroupにmkTを適用したものをeverywhereで使用しています．したがって，もし受け取った値の中にGroup型の値が含まれているのならば，それのplaceを"熊本城"に変更します．別の型の値に対しては何も変更を加えません．
どういう理由かは知りませんが，突然全てのMaybe aをNothingにしないといけなくなったとしましょう．単純にmkTにf :: Data a => Maybe a -> Maybe aという型の関数を渡すと失敗します．
-- 以下のような関数は定義できない．
-- allNothing :: World -> World
-- allNothing = everywhere (mkT f)
-- where
-- f :: Data a => Maybe a -> Maybe a
-- f = const Nothing正直なところ，私はこのエラーに対する正しい説明をすることが出来ません．ただし打開策は存在します．Type.Reflectionモジュールを利用します．以下のように書くと目的を達成できます．なお，このコードの実行にはTypeApplications，ScopedTypeVariables，RankNTypesを有効にする必要があります．
allNothing :: Data a => a -> a
allNothing = everywhere f
where
f :: forall a. Data a => a -> a
f x
| App g _ <- typeRep @a
, Just HRefl <- eqTypeRep g (typeRep @Maybe) = Nothing
| otherwise = x
testAllNothing :: Spec
testAllNothing =
describe "allNothing" $
it "すべての`Maybe a`を`Nothing`にする" $
allNothing allMembersInWorld `shouldBe` expected
where
expected =
[ Member
{ memberName = "ロミアス"
, anotherName = "異形の森の使者"
, age = Nothing
, favoriteMoss = Nothing
}
, Member
{ memberName = "ラーネイレ"
, anotherName = "風を聴く者"
, age = Nothing
, favoriteMoss = Nothing
}
, Member
{ memberName = "ウェゼル"
, anotherName = "ザナンの白き鷹"
, age = Nothing
, favoriteMoss = Nothing
}
, Member
{ memberName = "ロイター"
, anotherName = "ザナンの紅の英雄"
, age = Nothing
, favoriteMoss = Nothing
}
, Member
{ memberName = "デーリッチ"
, anotherName = "ハグレ王国国王"
, age = Nothing
, favoriteMoss = Nothing
}
, Member
{ memberName = "ローズマリー"
, anotherName = "ビッグモス"
, age = Nothing
, favoriteMoss = Nothing
}
]typeRepを使用することで，型の構成を知ることができます．また，eqTypeRepは2つの型が等しいかどうかを確かめます．これがJust HReflを返す場合，その2つの型は等しいとされます．
これらを用いることで，everywhereを使用する際に型変数を含む型に対しても操作を行うことができます．
現在私が行っているHIndentの改修において，ASTに対する前処理でsybの各関数を使用しています．
HIndentはHaskellのソースコードフォーマッタの一つです．現在の実装では，Haskellのソースコードをパースするためにhaskell-src-extsを用いています．しかしながら，このライブラリは長らくメンテナンスされておらず，最近のGHCで導入された拡張機能などに対応することができません．したがってそのような拡張機能を利用しているコードをうまく整形できない問題がありました．
そこで，GHCのAPIを複数のGHCのバージョンで利用できるようにしたghc-lib-parserを利用するように，現在ソースコードを改修しています．
ghc-lib-parserを用いてHaskellのソースコードをパースすると，HsModuleという型の値を得ることができます．これはHaskellのソースコードのASTであり，これをもとにHIndentはコードの整形を行います．ただし，単純に生成されたASTを用いるとコメントの扱いが難しかったり，他にも整形において不便な事柄が存在します．そのため，適切なノードにコメントのノードを再配置するなど，ASTに対する前処理を行う必要があります．
HsModuleはDataを実装しているため，sybの各関数を用いることができます．コメントノードの再配置の際は，まずlistifyでコメントノードを回収します．このとき，コードの終端を表すために存在するEOFコメントノードは省いています．その後，コメントを適切に再配置しています．このときStateモナドも利用しているため，everywhereではなく，モナドを扱うことができるeverywhereM関数を使用しています（コード例）．
この記事ではsybに関して簡単に説明しました．実際のところ，Dataが実装されていてFunctorが実装されていないという場合はあまりないと思います．だいたいfmapで事足ります．それでももしそのような状況に遭遇したら，sybのことを思い出してあげてください．
sybを初めて利用したときに，なぜlistifyやeverywhereなどが実装可能なのか非常に気になりました．
その秘密はData型クラスにあります．特に一番重要なメソッドがgfoldlです．Member型ではderiving (Data)を用いていますが，おおよそ以下のような実装が生成されます（実際のメソッドの名前はgfoldlですが，ここではgfoldlMemberとしています）．
gfoldlMember ::
(forall d b. Data d =>
c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> Member
-> c Member
gfoldlMember k z Member {..} =
z Member `k` memberName `k` anotherName `k` age `k` favoriteMossつまり，Memberの各フィールドの値を畳み込むことが出来ます．
sybで定義されている各関数は直接gfoldl関数を用いているのではなく，この関数を用いているData型クラスの他のメソッドを使用しています．