makeClassyを使って複数のオブジェクトで共通する函数をまとめる

makeClassy.hs

{-# LANGUAGE TemplateHaskell, FlexibleContexts, FlexibleInstances, UndecidableInstances, OverlappingInstances #-}
import Control.Lens
import Control.Monad.State

-- 基本となるオブジェクト
data Obj = Obj {
  _pos :: Int
  } deriving (Show)

-- Obj型のオブジェクトをもつ抽象的なクラスHasObjを作る
makeClassy ''Obj

data Ball = Ball {
  _objBall :: Obj,
  _r :: Int
  } deriving (Show)
  
makeLenses ''Ball

-- BallはObj型のobjBallをもつのでHasObjのインスタンスになる
instance HasObj Ball where
  obj = objBall

data Bar = Bar {
  _objBar :: Obj,
  _width :: Int
  } deriving (Show)
  
makeLenses ''Bar

instance HasObj Bar where
  obj = objBar

-- HasObjのインスタンスになったオブジェクトならなんでもこの函数で操作できる
updatePos :: (HasObj c) => c -> c
updatePos = (obj . pos) %~ (+2)

-- 各オブジェクトごとのメソッドを用意
class Display c where
  draw :: c -> IO ()
  update :: State c ()

-- メソッドの実装(HasObj型で全て共通化されている)
instance (HasObj c) => Display c where
  draw c = putStrLn $ "drawing an object:" ++ (show $ c ^. obj ^. pos)
  update = do
    (obj . pos) %= (+3)

instance Display Ball where
  draw c = putStrLn $ "drawing a ball:" ++ (show $ c ^. pos) ++ " r:" ++ (show $ c ^. r)
  update = do
    (obj . pos) %= (+3)

main :: IO ()
main = do
  let a = Obj 10
  print $ updatePos a
  -- output: Obj {_pos = 12}

  let b = Ball (Obj 10) 5
  print $ updatePos b
  -- output: Ball {_objBall = Obj {_pos = 12}, _r = 5}

  let c = Bar (Obj 10) 100
  print $ updatePos c
  -- output: Bar {_objBar = Obj {_pos = 12}, _width = 100}

  let d = Bar (Obj 10) 70
  draw $ execState update d
  -- output: drawing an object:13

  let e = Ball (Obj 10) 7
  draw $ execState update e
  -- output: drawing a ball:13 r:7