Posted at

Haskellで型クラス制約の和を表現する


問題

Haskellでコードを書いている時、「複数の型クラス制約のうち一つを満たすような型」を扱うような関数を書きたい場合があります。擬似コードで書けば、


typeclass-sum-0.hs

class Foo a where

foo :: a -> String

class Bar a where
bar :: a -> Int

instance Foo Integer where
foo = show

instance Bar Int where
bar = id

-- 型クラス制約の「和」を取る関数を定義したい
someFunc :: (Foo a OR Bar a) => a -> IO ()
someFunc x = let y = foo x OR ("Bar:" ++ show (bar x))
in putStrLn y

main :: IO ()
main = do
someFunc (123 :: Integer) -- Integer は Foo を満たす
someFunc (456 :: Int) -- Int は Bar を満たす


という風に書きたい状況です。普通なら「Fooに対しての関数」と「Barに関しての関数」を別の名前で定義するところですが、 main から someFunc の呼び出しの間に関数が何段か挟まっている場合、途中の関数を全て複製する羽目になるのは大変です。なんとかして、「制約の和」を表現することを考えてみましょう。(この記事で書いているテクニックを推奨するわけではありません)


GADTsと型クラス制約

GADTsを使うと、型クラス制約をデータ型に封じ込めることができます。


gadts.hs

{-# LANGUAGE GADTs #-}

class Foo a where
foo :: a -> String

instance Foo Integer where
foo = show

-- 型クラス制約を表現するデータ型
data IsFoo a where
FooWitness :: (Foo a) => IsFoo a

fooFunc :: IsFoo a -> a -> IO ()
fooFunc witness x = do
-- この段階では a は一般の型
-- putStrLn (foo x) は型エラー
case witness of
FooWitness -> do
-- FooWitness にパターンマッチすることで Foo a という制約が利用できるようになる
putStrLn (foo x)

main :: IO ()
main = do
fooFunc FooWitness (123 :: Integer)
fooFunc undefined (456 :: Int)
-- undefined によって IsFoo Int の値を無理やり作ってもパターンマッチで例外が飛ぶので、
-- Foo Int のインスタンスが無から出現するようなことはない


これを使うと、「複数の制約のいずれかを表すデータ型」を作ることができます。


typeclass-sum-1.hs

{-# LANGUAGE GADTs #-}

class Foo a where ...
class Bar a where ...

-- Foo または Bar のインスタンスであることを表すデータ型
data IsFooOrBar a where
FooWitness :: (Foo a) => IsFooOrBar a
BarWitness :: (Bar a) => IsFooOrBar a

-- 型クラス制約の「和」を取る関数
someFunc :: IsFooOrBar a -> a -> IO ()
someFunc witness x
= let y = case witness of
FooWitness -> foo x
BarWitness -> "Bar:" ++ show (bar x)
in putStrLn y

main :: IO ()
main = do
someFunc FooWitness (123 :: Integer) -- Integer は Foo を満たす
someFunc BarWitness (456 :: Int) -- Int は Bar を満たす



再び型クラス

いちいち FooWitnessBarWitness を渡すのが面倒な場合は、「Foo または Bar」を表す型クラスを用意してやれば良いでしょう。


typeclass-sum-2.hs

{-# LANGUAGE GADTs #-}

{-# LANGUAGE ScopedTypeVariables #-}
class Foo a where ...
class Bar a where ...

-- Foo または Bar のインスタンスであることを表すデータ型
data IsFooOrBar a where
FooWitness :: (Foo a) => IsFooOrBar a
BarWitness :: (Bar a) => IsFooOrBar a

-- Foo と Bar の和を表す型クラス
class FooOrBar a where
fooOrBarWitness :: IsFooOrBar a

-- 型ごとに FooOrBar のインスタンスを定義しておく
instance FooOrBar Integer where
fooOrBarWitness = FooWitness
instance FooOrBar Int where
fooOrBarWitness = BarWitness

-- 型クラス制約の「和」を取る関数
someFunc :: forall a. (FooOrBar a) => a -> IO ()
someFunc x
= let y = case fooOrBarWitness :: IsFooOrBar a of
FooWitness -> foo x
BarWitness -> "Bar:" ++ show (bar x)
in putStrLn y

main :: IO ()
main = do
someFunc (123 :: Integer) -- Foo のインスタンスが使われる
someFunc (456 :: Int) -- Bar のインスタンスが使われる


型ごとに FooOrBar のインスタンスを定義するのが面倒ですが、そこは我慢します。ちなみに、UndecidableInstancesのような危険な拡張を使っても

instance (Foo a) => FooOrBar a where

fooOrBarWitness = FooWitness
instance (Bar a) => FooOrBar a where
fooOrBarWitness = BarWitness

のようなコードはコンパイルできないようです。


例:固定長または多倍長整数

Integer で表された整数がターゲットの型で表せる範囲内なら Just に包んだそれを、そうでないなら Nothing を返すような関数 maybeFromInteger を考えましょう。


maybefrominteger0.hs

{-# LANGUAGE ScopedTypeVariables #-}

import Data.Int

maybeFromInteger :: forall a. (Integral a, Bounded a) => Integer -> Maybe a
maybeFromInteger x
= if toInteger (minBound :: a) <= x && x <= toInteger (maxBound :: a)
then Just (fromInteger x)
else Nothing

main :: IO ()
main = do
print (maybeFromInteger (2^50) :: Maybe Int32)
print (maybeFromInteger (2^50) :: Maybe Int64)
-- print (maybeFromInteger (2^50) :: Maybe Integer)


maybeFromInteger はターゲットの型の範囲を知るために Bounded 制約を必要としますが、それでは Integer 型に対して適用できません(IntegerBounded のインスタンスではないので)。maybeFromInteger 関数を Integer 型に対しても使えるようにするためにはどうすれば良いのでしょう?

そう、この記事で説明したテクニックを使えば良いですね。


maybefrominteger1.hs

{-# LANGUAGE GADTs #-}

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
import Data.Int

data IsBoundedOrInteger a where
UnboundedWitness :: IsBoundedOrInteger Integer
BoundedWitness :: (Bounded a) => IsBoundedOrInteger a

class BoundedOrInteger a where
boundednessWitness :: IsBoundedOrInteger a
instance BoundedOrInteger Integer where
boundednessWitness = UnboundedWitness
instance {-# INCOHERENT #-} (Bounded a) => BoundedOrInteger a where
boundednessWitness = BoundedWitness

maybeFromInteger :: forall a. (Integral a, BoundedOrInteger a) => Integer -> Maybe a
maybeFromInteger x
= case boundednessWitness :: IsBoundedOrInteger a of
UnboundedWitness ->
-- a が Integer の場合
Just x
BoundedWitness ->
-- a が Bounded の場合
if toInteger (minBound :: a) <= x && x <= toInteger (maxBound :: a)
then Just (fromInteger x)
else Nothing

hello :: (Integral a, Bounded a, Show a) => (a -> String) -> IO ()
hello s = do
-- INCOHERENT プラグマを使っているので、具体的な型がわかってない状況で Bounded から IsBoundedOrInteger を捻出できる
case maybeFromInteger (2^50) of
Just x -> putStrLn ("Hello, " ++ s x)
Nothing -> putStrLn "Hello!"

main :: IO ()
main = do
print (maybeFromInteger (2^50) :: Maybe Int32)
print (maybeFromInteger (2^50) :: Maybe Int64)
print (maybeFromInteger (2^50) :: Maybe Integer)
hello (show :: Int32 -> String)
hello (show :: Int64 -> String)


この場合は選択肢の一方が具体的な型 (Integer) なので、 instance {-# INCOHERENT #-} (Bounded a) => BoundedOrInteger a という宣言によって BoundedOrInteger のインスタンスを自動的に導出できます。ここではUndecidableInstances拡張などの危険な機能を使っていますが、 Bounded Integer のインスタンスを定義するバカがいない限り問題になることはないでしょう。

(UndecidableInstancesなどの危険な機能の使用に良心の呵責を感じる人は、 IsBoundedOrInteger の値を受け取るようにするか、 BoundedOrInteger のインスタンスを個別に定義した方が良いでしょう)