問題

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 を満たす

再び型クラス

いちいち FooWitness や BarWitness を渡すのが面倒な場合は、「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 型に対して適用できません（Integer は Bounded のインスタンスではないので）。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 のインスタンスを個別に定義した方が良いでしょう）

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

問題

GADTsと型クラス制約

再び型クラス

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