instance宣言練習

Haskellの型クラスあたりは幾ら説明読んでもよくわからんから試してみた。
二分木(Tree)つくってderivingせずにinstance宣言？練習。
ReadクラスとApplicativeクラスが結構迷った。
Applicativeはとりあえず型エラーは出なくなったが使い方がいまいち分からない。まあTreeには合わないだけかも。
Functorは実装してみたら良く理解出来た。Functorはただの入れ物だね。
Monadも定義は簡単だった。そして前より理解が深まった気がする。


インスタンス宣言の基本は次のようなもの。

instance {TypeClass} {TypeInstance} where
    method1  = ...
    method2  = ...

ここの{TypeClass}に型クラスを、{TypeInstance}に型インスタンス?を当てはめる。
で、今回(Tree a)型をインスタンスにするわけだから、

instance {TypeClass} (Tree a) where
    method1  = ...
    method2  = ...

こんな感じ。
ここの型変数aにクラス制限？(例としてEq)をつけると、

instance (Eq a) => {TypeClass} (Tree a) where
    method1  = ...
    method2  = ...

こうなる。関数との一貫性はあるが、初見ではちょっと分かりにくい。
さらにFunctor, Applicative, Monadとなると

instance Functor Tree where
    method1  = ...
    method2  = ...

こう書くらしい。あれ(Tree a)のaはどこいったん？と初め超悩んだ。そういうものらしい。
まあ理解は後で。

しかしHaskell用語が分からなすぎて困るな。

module Main where
import Control.Applicative

-- Treeの定義
data Tree a = Leaf a | Tree (Tree a) (Tree a)

instance (Show a) => Show (Tree a) where
    -- showは簡単
    show (Tree b c) = "<" ++ show b ++ "|" ++ show c ++ ">"
    show (Leaf a) = show a

instance (Read a) => Read (Tree a) where
    readsPrec _ s = readsTree s  -- ???
      where
        readsTree :: (Read a) => ReadS (Tree a)
        readsTree s = [ (Tree left right, x) | ('<'  , t)  <- lex' s,
                                               (left , u)  <- readsTree t,
                                               ('|'  , v)  <- lex' u,
                                               (right, w)  <- readsTree v,
                                               ('>'  , x)  <- lex' w         ]
                      ++ 
                      [ (Leaf x, t)          | (x    , t)  <- reads s {- このreadsは何..? -} ]
        lex' (c:cs) = [(c, cs)] -- Readで定義されているlexでは上手くいかないので自前で簡易定義


-- 同一ならTrue
instance (Eq a) => Eq (Tree a) where
    -- (==), (/=) が定義されているが、どちらか一方を定義すれば十分
    Leaf a == Leaf b  = a == b
    Tree a b == Tree c d  = a == c && b == d
    _ == _  = False -- LeafとTreeを比べたら必ずFalse

-- Treeの深さで序列をつけてみる
instance (Eq a) => Ord (Tree a) where
    -- compare, min, max, (<), (>), (>=), (<=) が定義されているが、compareを定義すれば十分
    a `compare` b = depth a `compare` depth b
      where
        -- 深さ定義
        depth :: Tree a -> Int
        depth (Leaf _) = 1
        depth (Tree a b) = if depth a > depth b then 1 + depth a else 1 + depth b

instance Functor Tree where
    -- fmapはmapの拡張版のようなもの
    fmap f (Leaf a)   = Leaf (f a)
    fmap f (Tree a b) = Tree (fmap f a) (fmap f b)

instance Applicative Tree where
    -- とりあえずpure, (<*>)を定義
    pure a                  = Leaf a
    Leaf f <*> Leaf a       = Leaf (f a)  -- Leaf同士
    Leaf f <*> Tree t1 t2   = Tree (Leaf f <*> t1) (Leaf f <*> t2)  -- Leaf と Tree
    Tree tf tg <*> Leaf a   = Tree (tf <*> Leaf a) (tg <*> Leaf a)  -- Tree と Leaf
    Tree f g <*> Tree t1 t2 = Tree (Tree f g <*> t1) (Tree f g <*> t2)  -- Tree同士

instance Monad Tree where
    Leaf a >>= f      = f a
    Tree t1 t2 >>= f  = Tree (t1 >>= f) (t2 >>= f)
    return            = Leaf


-- 以下テスト
main = do
    -- 準備
    tree1 <- return $ Tree (Leaf 1) (Tree (Tree (Leaf 2) (Leaf 3)) (Leaf 4))
    tree2 <- return $ Tree (Leaf 1) (Tree (Leaf 2) (Leaf 3))
    tree3 <- return $ Tree (Leaf 1) (Leaf 2)
    -- Show
    print $ tree1
    -- Read
    print $ (read "<<20|3>|5>" :: Tree Double)
    -- Eq
    print $ Tree (Leaf 2) (Leaf 3) /= Tree (Leaf 2) (Tree (Leaf 4) (Leaf 5))
    -- Ord
    print $ Tree (Leaf 2) (Leaf 3) > Tree (Leaf 2) (Tree (Leaf 4) (Leaf 5))
    print $ Tree (Leaf 2) (Leaf 3) >= Tree (Leaf 2) (Tree (Leaf 4) (Leaf 5))
    print $ Tree (Leaf 2) (Leaf 3) `compare` Tree (Leaf 2) (Tree (Leaf 4) (Leaf 5))
    print $ Tree (Leaf 2) (Leaf 3) `max` Tree (Leaf 2) (Tree (Leaf 4) (Leaf 5))
    print $ Tree (Leaf 2) (Leaf 3) `min` Tree (Leaf 2) (Tree (Leaf 4) (Leaf 5))
    -- Functor
    print $ fmap (^2) tree1
    -- Applicative
    print $ Tree (Leaf (*2)) (Tree (Tree (Leaf (*3)) (Leaf (*4))) (Leaf (*5))) <*> Leaf 3
    print $ Leaf (*2) <*> Tree (Tree (Leaf 3) (Leaf 5)) (Leaf 4)
    print $ Tree (Leaf (*2)) (Tree (Tree (Leaf (*3)) (Leaf (*4))) (Leaf (*5))) <*> tree1
    print $ Tree (Leaf show) (Tree (Tree (Leaf $ (++"hoge").show) (Leaf $ (++"moge").show)) (Leaf $ (++"fuga").show)) <*> tree1
    -- Monad
    print $ tree1 >>= \x -> Tree (Leaf $ x*3) (Leaf $ x*2) >>= \x -> fmap (*x) tree2

クラスにどんなメソッドが定義されているかはghci立ち上げて

:i Ord

などとやってみると分かる。:iは:infoの略だっけ。

Readクラスに関しては以下を参照した。

しかしそのままでは動かないという罠がある。lexの動作のせいと分かったので、上ではlex'を定義している。