Draft entry 7: Replace inheritance with natural transformation

_config.yml

@@ -45,3 +45,4 @@ plugins: [jekyll-paginate, jekyll-seo-tag, jekyll-feed, jekyll-remote-theme]
 exclude:
   - pages/refactorings/extract-method/
   - pages/refactorings/replace-mutable-fields-with-lenses/
+  - pages/refactorings/replace-inheritance-with-natural-transformation/

_data/refactorings.yml

@@ -10,7 +10,7 @@
     - { name: "Introduce ReaderT (Kleisli)" }
     - { name: "Replace loop with fold" }
     - { name: "Replace recursion with fold" }
-    - { name: "Replace inheritance with natural transformation" }
+    - { name: "Replace inheritance with natural transformation", slug: replace-inheritance-with-natural-transformation }
     - { name: "Replace exception with extended response type" }
     - { name: "Replace null with optional" }
     - { name: "Replace optional fields with sum types" }

pages/refactorings/replace-inheritance-with-natural-transformation/01-stack-vector/After.hs

@@ -0,0 +1,27 @@
+-- Editor history: apply edits and undos, then list the survivors
+-- oldest-first. Stack owns its discipline; toList is the arrow out.
+module After where
+
+import Data.List (foldl')
+
+newtype Stack a = Stack [a] deriving Functor
+
+push :: a -> Stack a -> Stack a
+push a (Stack xs) = Stack (xs ++ [a])
+
+undo :: Stack a -> Stack a
+undo (Stack xs) = Stack (take (length xs - 1) xs)
+
+toList :: Stack a -> [a] -- natural in a
+toList (Stack xs) = xs
+
+data Cmd = Edit String | Undo
+
+build :: [Cmd] -> Stack String
+build = foldl' step (Stack [])
+  where
+    step s (Edit t) = push t s
+    step s Undo     = undo s
+
+replay :: [Cmd] -> [String]
+replay cmds = toList (build cmds) -- build cmds alone: type error

pages/refactorings/replace-inheritance-with-natural-transformation/01-stack-vector/After.scala

@@ -0,0 +1,24 @@
+// Editor history: apply edits and undos, then list the survivors
+// oldest-first. Stack owns its discipline; toList is the arrow out.
+object After:
+  final case class Stack[A](private val repr: List[A]):
+    def push(a: A): Stack[A]        = Stack(repr :+ a)
+    def undo: Stack[A]              = Stack(repr.dropRight(1))
+    def map[B](f: A => B): Stack[B] = Stack(repr.map(f))
+    def toList: List[A]             = repr // natural in A
+
+  object Stack:
+    def empty[A]: Stack[A] = Stack(Nil)
+
+  enum Cmd:
+    case Edit(text: String)
+    case Undo
+
+  def build(cmds: List[Cmd]): Stack[String] =
+    cmds.foldLeft(Stack.empty[String]) {
+      case (s, Cmd.Edit(t)) => s.push(t)
+      case (s, Cmd.Undo)    => s.undo
+    }
+
+  def replay(cmds: List[Cmd]): List[String] =
+    build(cmds).toList // build(cmds) alone does not compile now

pages/refactorings/replace-inheritance-with-natural-transformation/01-stack-vector/Before.hs

@@ -0,0 +1,19 @@
+-- Editor history: apply edits and undos, then list the survivors
+-- oldest-first. A Stack is-a list, so the whole list API is the
+-- history's API: undo is list surgery like any other operation.
+module Before where
+
+import Data.List (foldl')
+
+type Stack a = [a]
+
+data Cmd = Edit String | Undo
+
+build :: [Cmd] -> Stack String
+build = foldl' step []
+  where
+    step h (Edit t) = h ++ [t]
+    step h Undo     = take (length h - 1) h
+
+replay :: [Cmd] -> [String]
+replay cmds = build cmds -- compiles: a Stack *is* the list

pages/refactorings/replace-inheritance-with-natural-transformation/01-stack-vector/Before.scala

@@ -0,0 +1,18 @@
+// Editor history: apply edits and undos, then list the survivors
+// oldest-first. A Stack is-a List, so the whole List API is the
+// history's API: undo is list surgery like any other operation.
+object Before:
+  type Stack[A] = List[A]
+
+  enum Cmd:
+    case Edit(text: String)
+    case Undo
+
+  def build(cmds: List[Cmd]): Stack[String] =
+    cmds.foldLeft(Nil: Stack[String]) {
+      case (h, Cmd.Edit(t)) => h :+ t
+      case (h, Cmd.Undo)    => h.dropRight(1)
+    }
+
+  def replay(cmds: List[Cmd]): List[String] =
+    build(cmds) // compiles only because a Stack *is* the List

pages/refactorings/replace-inheritance-with-natural-transformation/01-stack-vector/Spec.hs

@@ -0,0 +1,45 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Main where
+
+import Control.Monad (unless)
+import System.Exit (exitFailure)
+import Hedgehog
+import qualified Hedgehog.Gen as Gen
+import qualified Hedgehog.Range as Range
+import qualified Before
+import qualified After
+
+-- A script as raw data: Just text is an edit, Nothing an undo, so
+-- one generated script feeds Before.Cmd and After.Cmd alike.
+-- Short scripts with frequent undos hit the empty history often.
+genScript :: Gen [Maybe String]
+genScript = Gen.list (Range.linear 0 20) $ Gen.choice
+  [ Just <$> Gen.string (Range.linear 0 6) Gen.alpha
+  , pure Nothing
+  ]
+
+beforeCmd :: Maybe String -> Before.Cmd
+beforeCmd = maybe Before.Undo Before.Edit
+
+afterCmd :: Maybe String -> After.Cmd
+afterCmd = maybe After.Undo After.Edit
+
+prop_replay_agrees :: Property
+prop_replay_agrees = property $ do
+  s <- forAll genScript
+  Before.replay (map beforeCmd s) === After.replay (map afterCmd s)
+
+prop_toList_natural :: Property
+prop_toList_natural = property $ do
+  s <- forAll genScript
+  let stack = After.build (map afterCmd s)
+  After.toList (fmap length stack)
+    === map length (After.toList stack)
+
+main :: IO ()
+main = do
+  ok <- checkParallel $ Group "Props"
+    [ ("replay: Before == After", prop_replay_agrees)
+    , ("toList is natural in a", prop_toList_natural)
+    ]
+  unless ok exitFailure

pages/refactorings/replace-inheritance-with-natural-transformation/01-stack-vector/Spec.scala

@@ -0,0 +1,46 @@
+//> using scala 3.3.4
+//> using dep qa.hedgehog::hedgehog-core:0.14.0
+//> using dep qa.hedgehog::hedgehog-runner:0.14.0
+import hedgehog.*, hedgehog.core.*, hedgehog.runner.*
+
+object Props extends Properties:
+  def tests: List[Test] = List(
+    property("replay: Before == After", replayAgrees),
+    property("toList is natural in A", toListIsNatural),
+  )
+
+  // A script as raw data: Some(text) is an edit, None an undo, so
+  // one generated script feeds Before.Cmd and After.Cmd alike.
+  // Short scripts with frequent undos hit the empty history often.
+  val genScript: Gen[List[Option[String]]] =
+    Gen.choice1(
+      Gen.string(Gen.alpha, Range.linear(0, 6)).map(Some(_)),
+      Gen.constant(Option.empty[String]),
+    ).list(Range.linear(0, 20))
+
+  def beforeCmd(c: Option[String]): Before.Cmd =
+    c.fold(Before.Cmd.Undo)(Before.Cmd.Edit(_))
+
+  def afterCmd(c: Option[String]): After.Cmd =
+    c.fold(After.Cmd.Undo)(After.Cmd.Edit(_))
+
+  def replayAgrees: Property =
+    for s <- genScript.forAll
+    yield Before.replay(s.map(beforeCmd)) ====
+      After.replay(s.map(afterCmd))
+
+  def toListIsNatural: Property =
+    for s <- genScript.forAll
+    yield
+      val stack = After.build(s.map(afterCmd))
+      stack.map(_.length).toList ==== stack.toList.map(_.length)
+
+@main def spec(): Unit =
+  val results = Props.tests.map { t =>
+    val r = Property.check(
+      t.withConfig(PropertyConfig.default), t.result, Seed.fromTime())
+    println(
+      Test.renderReport("Props", t, r, ansiCodesSupported = false))
+    r.status
+  }
+  if !results.forall(_ == Status.ok) then sys.exit(1)

pages/refactorings/replace-inheritance-with-natural-transformation/02-dictionary-set/After.hs

@@ -0,0 +1,19 @@
+-- The same phone books as a Map, which owns one-value-per-key;
+-- entries is the arrow back into the world of sets.
+module After where
+
+import Data.List (foldl')
+import Data.Map (Map)
+import Data.Set (Set)
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+
+entries :: Map k v -> Set (k, v) -- natural in v
+entries = Set.fromList . Map.toList
+
+fill :: [(String, Int)] -> Map String Int
+fill = foldl' (\m (k, v) -> Map.insert k v m) Map.empty
+
+common :: [(String, Int)] -> [(String, Int)] -> Set (String, Int)
+common xs ys =
+  Set.intersection (entries (fill xs)) (entries (fill ys))

pages/refactorings/replace-inheritance-with-natural-transformation/02-dictionary-set/After.scala

@@ -0,0 +1,12 @@
+// The same phone books as a Map, which owns one-value-per-key;
+// entries is the arrow back into the world of sets.
+object After:
+  def entries[K, V](m: Map[K, V]): Set[(K, V)] =
+    m.toSet // natural in V
+
+  def fill(es: List[(String, Int)]): Map[String, Int] =
+    es.foldLeft(Map.empty[String, Int])(_ + _)
+
+  def common(xs: List[(String, Int)],
+             ys: List[(String, Int)]): Set[(String, Int)] =
+    entries(fill(xs)) & entries(fill(ys))

pages/refactorings/replace-inheritance-with-natural-transformation/02-dictionary-set/Before.hs

@@ -0,0 +1,20 @@
+-- Two phone books built by inserting entries in order (later
+-- numbers win), then the entries both books agree on. A Dict is-a
+-- Set of pairs, so one-value-per-key is re-imposed at every put.
+module Before where
+
+import Data.List (foldl')
+import Data.Set (Set)
+import qualified Data.Set as Set
+
+type Dict k v = Set (k, v)
+
+-- Ord v: the set orders values, which a map would never need.
+put :: (Ord k, Ord v) => k -> v -> Dict k v -> Dict k v
+put k v d = Set.insert (k, v) (Set.filter ((/= k) . fst) d)
+
+fill :: [(String, Int)] -> Dict String Int
+fill = foldl' (\d (k, v) -> put k v d) Set.empty
+
+common :: [(String, Int)] -> [(String, Int)] -> Set (String, Int)
+common xs ys = Set.intersection (fill xs) (fill ys)

pages/refactorings/replace-inheritance-with-natural-transformation/02-dictionary-set/Before.scala

@@ -0,0 +1,17 @@
+// Two phone books built by inserting entries in order (later
+// numbers win), then the entries both books agree on. A Dict is-a
+// Set of pairs, so one-value-per-key is re-imposed at every put.
+object Before:
+  type Dict[K, V] = Set[(K, V)]
+
+  def put[K, V](d: Dict[K, V], k: K, v: V): Dict[K, V] =
+    d.filterNot(_._1 == k) + ((k, v))
+
+  def fill(es: List[(String, Int)]): Dict[String, Int] =
+    es.foldLeft(Set.empty[(String, Int)]) { (d, e) =>
+      put(d, e._1, e._2)
+    }
+
+  def common(xs: List[(String, Int)],
+             ys: List[(String, Int)]): Set[(String, Int)] =
+    fill(xs) & fill(ys)

pages/refactorings/replace-inheritance-with-natural-transformation/02-dictionary-set/Spec.hs

@@ -0,0 +1,41 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Main where
+
+import Control.Monad (unless)
+import System.Exit (exitFailure)
+import Hedgehog
+import qualified Hedgehog.Gen as Gen
+import qualified Hedgehog.Range as Range
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+import qualified Before
+import qualified After
+
+-- Five names and ten numbers, so books collide on keys often and
+-- later-wins is exercised with equal and unequal values.
+genBook :: Gen [(String, Int)]
+genBook = Gen.list (Range.linear 0 12) $
+  (,) <$> Gen.element ["ann", "bo", "cy", "dee", "ed"]
+      <*> Gen.int (Range.linear 0 9)
+
+prop_common_agrees :: Property
+prop_common_agrees = property $ do
+  xs <- forAll genBook
+  ys <- forAll genBook
+  Before.common xs ys === After.common xs ys
+
+prop_entries_natural :: Property
+prop_entries_natural = property $ do
+  xs <- forAll genBook
+  let m = After.fill xs
+      f = (`mod` 3) -- not injective, on purpose
+  After.entries (Map.map f m)
+    === Set.map (\(k, v) -> (k, f v)) (After.entries m)
+
+main :: IO ()
+main = do
+  ok <- checkParallel $ Group "Props"
+    [ ("common: Before == After", prop_common_agrees)
+    , ("entries is natural in v", prop_entries_natural)
+    ]
+  unless ok exitFailure