Maybeを自作してみる(Monoid編その２)

前回の続きから、Maybeの中身がMonoidだった場合の型クラスの実装は次のとおり。

import Data.Monoid

data Option a = None | Some a
                deriving (Eq, Ord, Read, Show)

instance (Monoid a) => Monoid (Option a) where
  mempty = None
  None `mappend` any = any
  any `mappend` None = any
  (Some x) `mappend` (Some y) = Some (x `mappend` y)

main = print $ Some (Sum 1) `mappend` Some (Sum 2)

SumはMonoidです。実行するとこんな感じになる。

Some (Sum {getSum = 3})

次はMaybeの中身がMonoidじゃなかった場合の実装を考えてみたけど、GHCのソースみた方がはやいのでFirst, Lastを調べてみました。

newtype First a = First { getFirst :: Maybe a }
        deriving (Eq, Ord, Read, Show)

instance Monoid (First a) where
        mempty = First Nothing
        r@(First (Just _)) `mappend` _ = r
        First Nothing `mappend` r = r

newtype Last a = Last { getLast :: Maybe a }
        deriving (Eq, Ord, Read, Show)

instance Monoid (Last a) where
        mempty = Last Nothing
        _ `mappend` r@(Last (Just _)) = r
        r `mappend` Last Nothing = r

ほほー、MaybeをFirstやLastでラップして新しい型を定義していますね。そしてそれぞれに対応したMonoid型クラスのインスタンスを定義しています。Firstのmappendの実装では、Justである最初の値を返しています。Lastは逆にJustである最後の値を返します。

実装をまねるので面白くないですが、、、とりあえずこんな感じ。

newtype FirstOp a = FirstOp { getFirst :: Option a }
        deriving (Eq, Ord, Read, Show)

instance Monoid (FirstOp a) where
        mempty = FirstOp None
        r@(FirstOp (Some _)) `mappend` _ = r
        FirstOp None `mappend` r = r

newtype LastOp a = LastOp { getLast :: Option a }
        deriving (Eq, Ord, Read, Show)

instance Monoid (LastOp a) where
        mempty = LastOp None
        _ `mappend` r@(LastOp (Some _)) = r
        r `mappend` LastOp None = r

使い方の例はこんな感じ。

*Main> print $ FirstOp (Some 1) `mappend` FirstOp (Some 2)
FirstOp {getFirst = Some 1}
*Main> print $ LastOp (Some 1) `mappend` LastOp (Some 2)
LastOp {getFirst = Some 2}

Maybeの中身がMonoidじゃない場合はなんとかしてmappendを振るまいを定義しないといけないけど、それをFirstやLastというコンテナによってどうmappendするか決めているってだけですな。ストラテジパターンに似てるなぁ。この仕組の有益性をぜんぜん理解できていないですが、ぜんぜん難しくないよね！！

というわけで、次はMonadですよ。