Writer Monad to make classes.

MakeClass.hs

{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Main where

import Control.Monad.Writer
import Control.Applicative

main :: IO ()
main = do
    (_, w) <- return $ makeClass $ \b -> do
        field "foo" 42
        field "bar" 7

        if b
            then do
                field "baz" 1024
                method "add"
            else do
                method "sub"
        method "mul"
        method "div"
    print w


--------------------------------------------------------------------------------
-- 構築したい型
data Class = Class [Method] [Field]
newtype Method = Method String
    deriving Show
newtype Field = Field (String, Int)
    deriving Show

instance Monoid Class where
    mempty = Class [] []
    mappend (Class m f) (Class m' f') = Class (m <> m') (f <> f')
instance Show Class where
    show (Class m f) = "Class " <> show m <> " " <> show f


--------------------------------------------------------------------------------
-- Class構築のためのモナド
newtype MkClass a = Con { unCon :: Writer Class a }
    deriving (Functor, Applicative, Monad, MonadWriter Class)

-- MkClassモナドを走らせ、構築結果を受け取る
makeClass :: (Bool -> MkClass a) -> (a, Class)
makeClass m = runWriter . unCon $ m False


--------------------------------------------------------------------------------
-- MkClassモナド内で使えるヘルパー関数
method :: String -> MkClass ()
method nm = tell $ Class [Method nm] []

field :: String -> Int -> MkClass ()
field nm val = tell $ Class [] [Field (nm, val)]