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

# 問題

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を使うと、型クラス制約をデータ型に封じ込めることができます。

```haskell: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 のインスタンスが無から出現するようなことはない
```

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

```haskell: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`」を表す型クラスを用意してやれば良いでしょう。

```haskell: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のような危険な拡張を使っても

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

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

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

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

```haskell: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` 型に対しても使えるようにするためにはどうすれば良いのでしょう？

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

```haskell: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` のインスタンスを個別に定義した方が良いでしょう）