Code to go with http://www.well-typed.com/blog/2018/03/oop-in-haskell/

OopInHaskell.hs

module Blog where

import Prelude hiding ((.), id)
import Control.Category
import Data.Bifunctor

{-------------------------------------------------------------------------------
  Fixed points
-------------------------------------------------------------------------------}

fix :: (a -> a) -> a
fix f = let a = fix f in f a

fac :: (Int -> Int) -> Int -> Int
fac r 1 = 1
fac r n = n * r (n - 1)

skim :: (Int -> Int) -> Int -> Int
skim r 1 = 1
skim r n = (fac r n) - 1

skimSpec :: Int -> Int
skimSpec 1 = 1
skimSpec n = n * skimSpec (n - 1) - 1

{-------------------------------------------------------------------------------
  Inheritance
-------------------------------------------------------------------------------}

{-
data Counter = Counter {
      tick    :: Counter
    , display :: Int
    }

mkCounter :: (Int -> Counter) -> (Int -> Counter)
mkCounter self n = Counter {
      tick    = self (n + 1)
    , display = n
    }

twice :: (Int -> Counter) -> (Int -> Counter)
twice self n = (mkCounter self n) {
      display = n * 2
    }
-}

{-------------------------------------------------------------------------------
  Lenses
-------------------------------------------------------------------------------}

data Lens a b = Lens {
      get    :: a -> b
    , modify :: (b -> b) -> (a -> a)
    }

instance Category Lens where
  id     = Lens id id
  l . l' = Lens (get l . get l') (modify l' . modify l)

_1 :: Lens (a, b) a
_1 = Lens fst first

_2 :: Lens (a, b) b
_2 = Lens snd second

{-------------------------------------------------------------------------------
  Extending state
-------------------------------------------------------------------------------}

data Counter = Counter {
      tick    :: Counter
    , tock    :: Counter
    , display :: String
    }

mkCounter' :: (Int -> Counter) -> (Int -> Counter)
mkCounter' self n = Counter {
      tick    = self (n + 1)
    , tock    = self (n + 1)
    , display = show n
    }

-- ticktock' :: ((Int, Int) -> Counter) -> (Int, Int) -> Counter
-- ticktock' self (n, m) = mkCounter' (self . _) n

mkCounter :: Lens st Int -> (st -> Counter) -> (st -> Counter)
mkCounter l self st = Counter {
      tick    = self (modify l (+ 1) st)
    , tock    = self (modify l (+ 1) st)
    , display = show (get l st)
    }

ticktock :: Lens st (Int, Int) -> (st -> Counter) -> (st -> Counter)
ticktock l self st = (mkCounter (_1 . l) self st) {
      tock    = self (modify (_2 . l) (+ 1) st)
    , display = show (get l st)
    }


{-
data Counter = Counter {
      tick    :: Counter
    , display :: Int
    }

mkCounter :: Int -> Counter
mkCounter n = Counter {
      tick    = mkCounter (n + 1)
    , display = n
    }

twice :: Int -> Counter
twice n = (mkCounter n) {
      display = n * 2
    }
-}

{-------------------------------------------------------------------------------
  Tests
-------------------------------------------------------------------------------}

main :: IO ()
main = do
    print $ fix fac  5
    print $ fix skim 5
    print $ skimSpec 5
    putStrLn $ display (tick (tock (tick (fix (ticktock id) (0, 0)))))