一体何番煎じか分かったもんじゃないけどMonadでStack (2)

前回の記事で作製した

data Stack a = Stack a (Stack a) | Empty deriving (Show)
type MonadStack a = State (Stack a) a

で問題が発覚したから、ちゃんと直しましょう。名だたるHaskeller達に噴飯されないように。せめて失笑レベルまで持って行きたいな。

型変数追加

で何が問題かって言うと、MonadStackの型変数がaだけでStackに押し込む値の型も、MonadStackの操作で返る値の型も同じaだってこと。
じゃ、それぞれに別々の型変数を用意すればイイね。ってことで型変数bをMonadStackに追加で。

data Stack a = Stack a (Stack a) | Empty deriving (Show)
type MonadStack a b = State (Stack a) b

これでOK。あとは実装した関数たちの型も変更してやれば大丈夫ですな(ﾉ´∀｀*)

push :: a -> MonadStack a a
pop :: MonadStack a a
top :: MonadStack a a
empty :: MonadStack a Bool
size :: MonadStack a Int

(*実装省略)

> runState (push 1 >> empty) Empty
(False,Stack 1 Empty)
> runState (empty) Empty
(True,Empty)

やったぜワッショイ(∩´∀｀)∩ﾜｰｲ

ついでにfoldとfmapも…

Stackに対するfoldrとfmapも定義してみよう。

import Prelude hiding (foldr)

instance Foldable Stack where
    foldr f z Empty = z
    foldr f z (Stack x stack) = foldr f (f x z) stack

instance Functor Stack where
    fmap f Empty = Empty
    fmap f (Stack x stack) = Stack (f x) (fmap f stack)

よし。そしてMonadStack用にmapSとfoldSも作ったぞ。役に立つかは知りません。

mapS :: (a -> b) -> MonadStack a (Stack b)
mapS f = do
    stack <- get
    return $ fmap f stack

foldS :: (a -> b -> b) -> b -> MonadStack a b
foldS f x = do
    stack <- get
    return $ foldr f x stack

とまぁこんな感じでStackをMonadで扱えるようにしてみた。
せっかくだから何かに使いたいな〜なんて思ったりしている(´・ω・｀)