+
+Inheritance between container types is the object-oriented world's
+best-documented regret — `java.util.Stack extends Vector` (the
+Javadoc itself now steers users elsewhere [[5](#ref-5)]), `Properties extends
+Hashtable` (Bloch's standing violations of *favor composition over
+inheritance* [[4](#ref-4)], [[3](#ref-3)]), Smalltalk-80's `Dictionary` as a subclass of
+`Set` [[6](#ref-6)], [[7](#ref-7)] — and the theory agrees with the folklore: inheritance
+is not subtyping [[8](#ref-8)], [[9](#ref-9)]. Where Fowler's *Replace Superclass with
+Delegate* discards the is-a [[1](#ref-1)], [[2](#ref-2)], the functional reading keeps
+what it truly asserted — that at every element type `A` a `Stack[A]`
+can stand for a `Vector[A]`, uniformly, because the coercion never
+looks at the elements — and names it: a *natural transformation*
+[[10](#ref-10)], [[11](#ref-11)], in code a rank-1 polymorphic function
+`toVector: Stack[A] => Vector[A]`, whose law — converting then
+mapping equals mapping then converting — is Wadler's theorem for
+free [[12](#ref-12)], [[13](#ref-13)]; no higher-kinded types until you abstract over
+*which* containers (`FunctionK`, `F ~> G`), which is the next group
+of this catalogue. The equation reads in both directions: where the
+is-a holds strictly and universally — every Applicative *is* a
+Functor, every Circle *is* a Shape — the coercion is total and
+lawful, and the inverse move, making the arrow implicit again, is
+just as legitimate.
+
+## Motivation
+
+Reach for the arrow when the is-a is a lie that exposes unexpected
+behaviour.
+A subclass (or alias) of a container inherits the whole container
+API, so the specialized type's invariant lives in the callers'
+discipline rather than in the type: nothing stops list surgery on an
+undo history, or a `Set`-style insertion that gives a dictionary two
+values for one key. Every operation the supertype gains, the subtype
+gains too, meaningful or not — the fragile-base-class problem is this
+leak seen over time. And the representation is frozen: a `Stack` that
+is-a `Vector` can never become a linked list. Naming the coercion
+fixes all three at once. The specialized type exports exactly its
+discipline; the general API is reachable only through an explicit,
+typed conversion, so the compiler lists every place the two worlds
+touch; and the law the is-a only ever promised — that the coercion is
+uniform in the elements — becomes a theorem of the arrow's type.
+
+Reach for the inverse when the wrapper protects nothing, or when the
+is-a relationship holds universally true. If every call site converts
+immediately, the arrow is noise — `toList` at every seam, a name that
+adds a hop, not meaning.
+Making the type transparent again (an alias, an exported underlying
+API, or a genuine subtype where the language has one) says the same
+thing more briefly. The precondition is the one Liskov and Wing
+state: the is-a must be total — every general operation meaningful on
+the specialized value and harmless to its invariants [[9](#ref-9)]. Where that
+holds, the arrow was an isomorphism in waiting, and inlining it loses
+nothing; where it does not, the "inverse" is not a refactoring but a
+regression to the smell.
+
+## The move
+
+Fowler's mechanics for *Replace Superclass with Delegate* — a field
+holding an instance of the former superclass, a forwarding method for
+each operation the subclass really supports, then remove the
+`extends` [[1](#ref-1)] — carry over almost verbatim: declare the specialized
+type as its own type (a `newtype`, a `final case class`, an `opaque
+type`) holding the general representation privately, give it exactly
+the operations of its discipline, and define the arrow — one line,
+the accessor, `toList`, `entries`, `toOption`, polymorphic in the
+element. Then follow the type errors: every place that used the
+specialized value *as* the general one is now either an operation the
+type should own (move it inside) or a genuine departure into the
+general world (apply the arrow) — the alias made those crossings
+invisible, the wrapper makes them a checklist. Where the inverse
+arrow is total — `fromList` is just the constructor — define it too,
+and the pair witnesses that the wrapper forgets nothing; where it is
+not (a set of pairs is not a map), its absence is the point: the
+invariant now has an owner.
+
+## To and from
+
+
+{% include_relative replace-inheritance-with-natural-transformation/diagrams/koan.svg %}
+The koan. One equation, read in two directions: replace
+(name the coercion the is-a made implicit; hide the representation)
+to the right, inline (make the conversion implicit again; expose the
+representation) to the left. The named arrow α has one component per
+element type, and the naturality square — α then map equals map then
+α — holds for any function of α's type, by parametricity.
+
+
+The catalogue lists each refactoring in both directions because the
+two moves are one equation read left to right and right to left. To
+the right: the is-a between `S[A]` and `G[A]` becomes an arrow
+`α : S[A] => G[A]`, applied wherever a specialized value used to pass
+silently as a general one. To the left: where α is one half of an
+isomorphism and no invariant separates the two types, erase the
+wrapper and let the coercion be implicit — in Haskell the `newtype`
+erases at runtime already, so inlining it is purely a source-level
+act. Both directions are checked by the same property: for all
+generated inputs, the before-program and the after-program agree on
+the entry point.
+
+## Three examples
+
+Each example is the same program twice, `Before` and `After`, in
+Scala 3 and in Haskell. The entry point keeps its name and its type,
+the replacement of an is-a by an arrow is the only difference, and a
+hedgehog property generates inputs and demands that both versions
+agree on every one of them; a second property states the naturality
+square itself, the law the is-a only ever implied. The three escalate
+by what the arrow preserves: everything (a wrapper whose two arrows
+forget nothing), an invariant (every map is a set of pairs; not every
+set of pairs is a map), and finally only part of the structure (the
+error channel forgotten, and the way back needs a chosen default).
+The sources below are included verbatim from the files the tests run
+against.
+
+### 1 · An undo history: the textbook move
+
+Java's `Stack extends Vector` in miniature. `Before` writes the is-a
+the way a functional language writes it — a transparent alias — and
+the history's API is the whole list API: `undo` is `dropRight`,
+nothing distinguishes the stack's discipline from arbitrary list
+surgery on it, and `replay` hands the stack itself to the UI — the
+body `build(cmds)` type-checks only because a `Stack` literally *is*
+the list. `After` makes `Stack` its own type owning `push` and
+`undo`, and the old is-a survives as the one-line arrow `toList`,
+applied exactly where the program genuinely leaves the stack world:
+the old body of `replay` no longer compiles, which is the move doing
+its job. The arrow back, `fromList`, is the constructor: this pair
+forgets nothing, which is why the inverse refactoring stays available
+here.
+
+
+{% include_relative replace-inheritance-with-natural-transformation/01-stack-vector/diagram.svg %}
+
+
+
+
+Note what the Haskell `newtype` buys: the arrow is free at runtime —
+`toList` erases entirely — so the conversion costs what the
+inheritance cost, nothing, while the source now marks every crossing.
+
+
+The properties: Before.replay == After.replay,
+and toList commutes with map
+
+
+
+### 2 · A phone book: the arrow guards an invariant
+
+Smalltalk-80's `Dictionary` is-a `Set` in miniature [[6](#ref-6)], [[7](#ref-7)].
+`Before` stores a phone book as a set of pairs, so *one value per
+key* belongs to no type: `put` re-imposes it by hand — filter the old
+key out, insert the new pair — and every future operation must
+remember to do the same, forever. (The representation also demands an
+ordering on the *values* in Haskell, which a map never needs.)
+`After` gives the invariant an owner, `Map`, and keeps the honest
+half of the old is-a as the arrow `entries` — every map *is* a set of
+pairs — applied exactly where the program wants set algebra: the
+intersection of two books. The other half is gone by design: a set of
+pairs with colliding keys is not a map until someone chooses a merge
+policy, and choosing one is a design decision, not a refactoring.
+
+
+{% include_relative replace-inheritance-with-natural-transformation/02-dictionary-set/diagram.svg %}
+
+
+
+
+The naturality property here is worth reading twice: `entries`
+commutes with mapping a function over the *values*, even a
+non-injective one, because the keys keep the pairs apart. The same
+square drawn for *keys* fails on collisions — naturality is a
+statement about the parameter you kept polymorphic, not about the
+type constructor wholesale. The pitfalls return to this.
+
+
+The properties: Before.common == After.common,
+and entries commutes with mapping values
+
+
+
+### 3 · A parsed form field: the arrow forgets
+
+The escalation completes: here the inheritance is *multiple*. One
+result class is-a both views — the diagnosis (`err`) and the presence
+(`value`) — so every caller sees both protocols, and the class must
+answer both, forever: each new consumer view is another supertype
+bolted onto the hierarchy. `Before` writes that god-type out (in
+Haskell, which has no subtyping, the merged sum type with a
+hand-rolled function per view is the same design). `After` keeps one
+canonical type at the boundary — `Either`, the shape with all the
+information — and renders each view as an arrow instead of a
+superclass: `toOption` (`toMaybe`) forgets the error channel, and the
+caller that wanted presence gets exactly `Option[Int]`. The standard
+libraries are full of this arrow's relatives — `listToMaybe` and
+`maybeToList` in `Data.Maybe`, `.toOption`, `.toList`, `.toSet` in
+Scala — everyday natural transformations nobody bothers to name as
+such. The arrow is lossy, and the way back, `note(e)` / `toRight(e)`,
+must invent an error value: `toOption(note(e)(o)) == o` for every
+`o`, but the composite the other way is not the identity. Forgetting
+is one-way, and the type records it.
+
+
+{% include_relative replace-inheritance-with-natural-transformation/03-either-option/diagram.svg %}
+
+
+
+
+
+## Pitfalls
+
+The equation has hypotheses, and most of them attach to the *inverse*
+direction — the replace direction is protected by parametricity, the
+inline direction by nothing but your judgement.
+
+- **The way back may need a policy.** `entries` is an equation;
+ "set of pairs to map" is not, until a merge for colliding keys is
+ chosen — and a merge that inspects values breaks the naturality
+ square (two pairs a function `f` maps to the same value need not
+ merge to the image of the merge). Likewise `Option` to `Either`
+ needs an invented error. Choosing a policy or a default is design;
+ do not present it as a refactoring, and test it as a change.
+- **Naturality is per type parameter.** A `Map[K, V]` is a functor in
+ `V` at fixed `K`; `entries` commutes with mapping values, not with
+ mapping keys, where collisions merge entries. State the law in the
+ parameter the arrow is polymorphic in, and keep the other fixed.
+- **Conversions cost what inheritance hid.** The subtype view was
+ free; the arrow may be O(n) — `entries` walks the map, `.toSet`
+ allocates. Convert once at the seam, not inside a loop that the
+ is-a used to cross silently. Where the arrow is a `newtype`
+ accessor it is free, and Haskell erases it at runtime.
+- **Wrapper versus alias changes strictness in Haskell.** A `newtype`
+ is the honest inheritance-eraser: same representation, same
+ strictness. A `data` wrapper adds a lift — `Stack ⊥` is not `⊥` —
+ so swapping one for the other can change what a program forces.
+- **Do not rebuild cross-type equality across the arrow.** Cook's
+ survey found methods with the same name and unrelated behaviours in
+ one hierarchy [[7](#ref-7)]; the two-type version of that bug is an `equals`
+ that converts and compares. After the move, cross-type equality
+ does not typecheck. Let that stand.
+- **A natural transformation is not a type class.** A type class
+ replaces *dispatch* — which implementation runs for this type; the
+ arrow replaces *coercion* — this shape passed off as that one. The
+ shape-hierarchy examples (circle, square, one `area` method) belong
+ to *Replace subtypes with type class instances*, not here. Reaching
+ for `F ~> G` as a first-class value — abstracting over the
+ containers, not the elements — is the moment higher-kinded types
+ arrive, and that is the next group of this catalogue.
+
+
+The functional reading
+
+
+A natural transformation between functors `F` and `G` is a family of
+maps `α[A]: F[A] → G[A]`, one per object `A`, such that for every
+`f: A → B` the square commutes: `α ∘ F.map(f) = G.map(f) ∘ α`.
+Eilenberg and Mac Lane defined it in 1945 — the paper that introduced
+categories and functors did so, by its own account, in order to say
+*natural* precisely [[10](#ref-10)], [[11](#ref-11)]. The programming reading is
+plain: `α` rearranges, duplicates, discards or repackages structure,
+and never inspects the elements. `reverse`, `concat`, `listToMaybe`,
+`Map.toList`, `Either.toOption` — the standard libraries are full of
+natural transformations that nobody introduces as such.
+
+In a parametrically polymorphic language the naturality square is not
+a proof obligation. Reynolds's abstraction theorem says a term of
+type `∀a. F a → G a` relates related inputs to related outputs
+[[12](#ref-12)]; Wadler's *Theorems for Free!* turns the crank: every function
+of that type satisfies the square, no matter how it is written
+[[13](#ref-13)]. That is why the move is safe in the only direction that
+matters. Inheritance promised uniformity behaviourally — Liskov and
+Wing's substitutability [[9](#ref-9)] — and the type system could not check
+it; Cook, Hill and Canning showed the two hierarchies come apart
+[[8](#ref-8)]. The arrow keeps the part of the promise that was true and gets
+the law for free.
+
+Note the quantifier. One arrow between two *fixed* containers is
+rank-1 polymorphism — `def toList[A](s: Stack[A]): List[A]`,
+`toList :: Stack a -> [a]` — available in any language with generics,
+Java included. Higher-kinded types enter only when the *functors*
+become the parameters: Scala's polymorphic function types
+`[A] => Stack[A] => List[A]` and cats' `FunctionK` (`F ~> G`), or
+Haskell's `type f ~> g = forall a. f a -> g a`, name the concept so
+that interpreters and effect stacks can abstract over it. That is
+deliberately out of scope here: this entry needs no higher kinds,
+which is why it sits in this group of the catalogue, with the
+final-tagless and type-class entries next door.
+
+
+
+
+## Verification
+
+Because the replacement is an equation, its correctness is a
+property: for all inputs *x* in the domain of the entry point,
+`Before x == After x`. That is a one-line property in the sense
+Claessen and Hughes introduced with QuickCheck [[14](#ref-14)], stated here
+with hedgehog in both languages [[15](#ref-15)], whose integrated shrinking
+reports a minimal failing input that obeys the generators'
+invariants. Each example carries a second property, the naturality
+square of its arrow. Parametricity makes the square a theorem, so
+the property cannot fail while the arrow stays honestly polymorphic —
+it is the tripwire that fires if someone later specializes the
+conversion to inspect elements (an `instanceof`, an `asInstanceOf`, a
+type test) and silently breaks the contract the is-a once implied.
+
+A property is only worth having if it can fail, so each spec is
+mutation-checked before an entry ships: change `After` so it is no
+longer equivalent — drop the key-filter in `put`, swap `dropRight(1)`
+for `drop(1)`, invert the sign guard — and confirm the property reports
+and shrinks a counterexample, then restore `After`. A property that
+does not fail under mutation is testing the generator, not the
+refactoring.
+
+To run everything on this page yourself, from a checkout of
+[the site repository](https://github.com/Constructive-Programming/website):
+
+```sh
+sh pages/refactorings/replace-inheritance-with-natural-transformation/run.sh
+```
+
+It needs [scala-cli](https://scala-cli.virtuslab.org/) and either GHC
+with hedgehog installed or Docker, and ends with `all properties passed`.
+
+## References
+
+
+
Martin Fowler. Refactoring: Improving the Design of Existing Code, second edition. Addison-Wesley, 2018. Catalogue entry “Replace Superclass with Delegate” (alias “Replace Inheritance with Delegation”). https://refactoring.com/catalog/replaceSuperclassWithDelegate.html
+
Martin Fowler, with contributions by Kent Beck, John Brant, William Opdyke and Don Roberts. Refactoring: Improving the Design of Existing Code. Addison-Wesley, 1999. Catalogue entry “Replace Inheritance with Delegation”. https://martinfowler.com/books/refactoring.html
Java Platform, Standard Edition API Specification, class java.util.Stack: “A more complete and consistent set of LIFO stack operations is provided by the Deque interface and its implementations, which should be used in preference to this class.” https://docs.oracle.com/en/java/javase/21/docs/api/java.base/java/util/Stack.html
William R. Cook. “Interfaces and Specifications for the Smalltalk-80 Collection Classes”. In OOPSLA 1992, pp. 1–15. https://doi.org/10.1145/141936.141938
+
William R. Cook, Walter L. Hill and Peter S. Canning. “Inheritance Is Not Subtyping”. In POPL 1990, pp. 125–135. https://doi.org/10.1145/96709.96721
+
Barbara H. Liskov and Jeannette M. Wing. “A Behavioral Notion of Subtyping”. ACM Transactions on Programming Languages and Systems 16(6):1811–1841, 1994. https://doi.org/10.1145/197320.197383
+
Samuel Eilenberg and Saunders Mac Lane. “General Theory of Natural Equivalences”. Transactions of the American Mathematical Society 58:231–294, 1945. https://doi.org/10.1090/S0002-9947-1945-0013131-6
+
Saunders Mac Lane. Categories for the Working Mathematician, second edition. Graduate Texts in Mathematics 5, Springer, 1998. https://doi.org/10.1007/978-1-4757-4721-8
Philip Wadler. “Theorems for Free!”. In Functional Programming Languages and Computer Architecture (FPCA 1989), pp. 347–359. https://doi.org/10.1145/99370.99404
+
Koen Claessen and John Hughes. “QuickCheck: a lightweight tool for random testing of Haskell programs”. In Proceedings of the ACM SIGPLAN International Conference on Functional Programming (ICFP 2000), pp. 268–279. https://doi.org/10.1145/351240.351266
+
diff --git a/pages/refactorings/replace-inheritance-with-natural-transformation/01-stack-vector/After.hs b/pages/refactorings/replace-inheritance-with-natural-transformation/01-stack-vector/After.hs
new file mode 100644
index 0000000..a545f19
--- /dev/null
+++ b/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
diff --git a/pages/refactorings/replace-inheritance-with-natural-transformation/01-stack-vector/After.scala b/pages/refactorings/replace-inheritance-with-natural-transformation/01-stack-vector/After.scala
new file mode 100644
index 0000000..0a73a80
--- /dev/null
+++ b/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
diff --git a/pages/refactorings/replace-inheritance-with-natural-transformation/01-stack-vector/Before.hs b/pages/refactorings/replace-inheritance-with-natural-transformation/01-stack-vector/Before.hs
new file mode 100644
index 0000000..506ec98
--- /dev/null
+++ b/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
diff --git a/pages/refactorings/replace-inheritance-with-natural-transformation/01-stack-vector/Before.scala b/pages/refactorings/replace-inheritance-with-natural-transformation/01-stack-vector/Before.scala
new file mode 100644
index 0000000..64705e6
--- /dev/null
+++ b/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
diff --git a/pages/refactorings/replace-inheritance-with-natural-transformation/01-stack-vector/Spec.hs b/pages/refactorings/replace-inheritance-with-natural-transformation/01-stack-vector/Spec.hs
new file mode 100644
index 0000000..7c9aedc
--- /dev/null
+++ b/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
diff --git a/pages/refactorings/replace-inheritance-with-natural-transformation/01-stack-vector/Spec.scala b/pages/refactorings/replace-inheritance-with-natural-transformation/01-stack-vector/Spec.scala
new file mode 100644
index 0000000..1258047
--- /dev/null
+++ b/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)
diff --git a/pages/refactorings/replace-inheritance-with-natural-transformation/01-stack-vector/diagram.svg b/pages/refactorings/replace-inheritance-with-natural-transformation/01-stack-vector/diagram.svg
new file mode 100644
index 0000000..c882ed2
--- /dev/null
+++ b/pages/refactorings/replace-inheritance-with-natural-transformation/01-stack-vector/diagram.svg
@@ -0,0 +1,51 @@
+
diff --git a/pages/refactorings/replace-inheritance-with-natural-transformation/02-dictionary-set/After.hs b/pages/refactorings/replace-inheritance-with-natural-transformation/02-dictionary-set/After.hs
new file mode 100644
index 0000000..80fcdac
--- /dev/null
+++ b/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))
diff --git a/pages/refactorings/replace-inheritance-with-natural-transformation/02-dictionary-set/After.scala b/pages/refactorings/replace-inheritance-with-natural-transformation/02-dictionary-set/After.scala
new file mode 100644
index 0000000..062dd92
--- /dev/null
+++ b/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))
diff --git a/pages/refactorings/replace-inheritance-with-natural-transformation/02-dictionary-set/Before.hs b/pages/refactorings/replace-inheritance-with-natural-transformation/02-dictionary-set/Before.hs
new file mode 100644
index 0000000..7acc90d
--- /dev/null
+++ b/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)
diff --git a/pages/refactorings/replace-inheritance-with-natural-transformation/02-dictionary-set/Before.scala b/pages/refactorings/replace-inheritance-with-natural-transformation/02-dictionary-set/Before.scala
new file mode 100644
index 0000000..0fa6b85
--- /dev/null
+++ b/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)
diff --git a/pages/refactorings/replace-inheritance-with-natural-transformation/02-dictionary-set/Spec.hs b/pages/refactorings/replace-inheritance-with-natural-transformation/02-dictionary-set/Spec.hs
new file mode 100644
index 0000000..46b8b7c
--- /dev/null
+++ b/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
diff --git a/pages/refactorings/replace-inheritance-with-natural-transformation/02-dictionary-set/Spec.scala b/pages/refactorings/replace-inheritance-with-natural-transformation/02-dictionary-set/Spec.scala
new file mode 100644
index 0000000..35a3ef9
--- /dev/null
+++ b/pages/refactorings/replace-inheritance-with-natural-transformation/02-dictionary-set/Spec.scala
@@ -0,0 +1,42 @@
+//> 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("common: Before == After", commonAgrees),
+ property("entries is natural in V", entriesIsNatural),
+ )
+
+ // Five names and ten numbers, so books collide on keys often and
+ // later-wins is exercised with equal and unequal values.
+ val genBook: Gen[List[(String, Int)]] =
+ (for
+ k <- Gen.element1("ann", "bo", "cy", "dee", "ed")
+ v <- Gen.int(Range.linear(0, 9))
+ yield (k, v)).list(Range.linear(0, 12))
+
+ def commonAgrees: Property =
+ for
+ xs <- genBook.forAll
+ ys <- genBook.forAll
+ yield Before.common(xs, ys) ==== After.common(xs, ys)
+
+ def entriesIsNatural: Property =
+ for xs <- genBook.forAll
+ yield
+ val m = After.fill(xs)
+ val f = (v: Int) => v % 3 // not injective, on purpose
+ After.entries(m.map((k, v) => (k, f(v)))) ====
+ After.entries(m).map((k, v) => (k, f(v)))
+
+@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)
diff --git a/pages/refactorings/replace-inheritance-with-natural-transformation/02-dictionary-set/diagram.svg b/pages/refactorings/replace-inheritance-with-natural-transformation/02-dictionary-set/diagram.svg
new file mode 100644
index 0000000..8f5da4f
--- /dev/null
+++ b/pages/refactorings/replace-inheritance-with-natural-transformation/02-dictionary-set/diagram.svg
@@ -0,0 +1,50 @@
+
diff --git a/pages/refactorings/replace-inheritance-with-natural-transformation/03-either-option/After.hs b/pages/refactorings/replace-inheritance-with-natural-transformation/03-either-option/After.hs
new file mode 100644
index 0000000..ab53d5f
--- /dev/null
+++ b/pages/refactorings/replace-inheritance-with-natural-transformation/03-either-option/After.hs
@@ -0,0 +1,17 @@
+-- Order quantity from a raw form field. One canonical type at
+-- the boundary; each view is an arrow, not a superclass.
+module After where
+
+import Text.Read (readMaybe)
+
+parse :: String -> Either String Int
+parse raw = case readMaybe raw of
+ Just n | n > 0 -> Right n
+ Just _ -> Left "not positive"
+ Nothing -> Left "not a number"
+
+toMaybe :: Either e a -> Maybe a -- natural in a
+toMaybe = either (const Nothing) Just
+
+quantity :: String -> Maybe Int
+quantity raw = toMaybe (parse raw)
diff --git a/pages/refactorings/replace-inheritance-with-natural-transformation/03-either-option/After.scala b/pages/refactorings/replace-inheritance-with-natural-transformation/03-either-option/After.scala
new file mode 100644
index 0000000..dab463d
--- /dev/null
+++ b/pages/refactorings/replace-inheritance-with-natural-transformation/03-either-option/After.scala
@@ -0,0 +1,14 @@
+// Order quantity from a raw form field. One canonical type at
+// the boundary; each view is an arrow, not a superclass.
+object After:
+ def parse(raw: String): Either[String, Int] =
+ raw.toIntOption match
+ case Some(n) if n > 0 => Right(n)
+ case Some(_) => Left("not positive")
+ case None => Left("not a number")
+
+ def toOption[E, A](e: Either[E, A]): Option[A] = // natural in A
+ e.fold(_ => None, Some(_))
+
+ def quantity(raw: String): Option[Int] =
+ toOption(parse(raw))
diff --git a/pages/refactorings/replace-inheritance-with-natural-transformation/03-either-option/Before.hs b/pages/refactorings/replace-inheritance-with-natural-transformation/03-either-option/Before.hs
new file mode 100644
index 0000000..755a6bb
--- /dev/null
+++ b/pages/refactorings/replace-inheritance-with-natural-transformation/03-either-option/Before.hs
@@ -0,0 +1,25 @@
+-- Order quantity from a raw form field. One result type carries
+-- two views at once: the diagnosis and the presence. Every caller
+-- of either view is coupled to the type that owns both.
+module Before where
+
+import Text.Read (readMaybe)
+
+data Result = Bad String | Ok Int
+
+err :: Result -> Maybe String -- the diagnosis view
+err (Bad why) = Just why
+err (Ok _) = Nothing
+
+value :: Result -> Maybe Int -- the presence view
+value (Bad _) = Nothing
+value (Ok n) = Just n
+
+parse :: String -> Result
+parse raw = case readMaybe raw of
+ Just n | n > 0 -> Ok n
+ Just _ -> Bad "not positive"
+ Nothing -> Bad "not a number"
+
+quantity :: String -> Maybe Int
+quantity raw = value (parse raw)
diff --git a/pages/refactorings/replace-inheritance-with-natural-transformation/03-either-option/Before.scala b/pages/refactorings/replace-inheritance-with-natural-transformation/03-either-option/Before.scala
new file mode 100644
index 0000000..045523c
--- /dev/null
+++ b/pages/refactorings/replace-inheritance-with-natural-transformation/03-either-option/Before.scala
@@ -0,0 +1,27 @@
+// Order quantity from a raw form field. One result class is-a
+// two views at once: the diagnosis and the presence. Every caller
+// of either view is coupled to the class that owns both.
+object Before:
+ trait Diagnosed { def err: Option[String] }
+ trait Present { def value: Option[Int] }
+
+ enum Result extends Diagnosed, Present:
+ case Bad(why: String)
+ case Ok(n: Int)
+
+ def err: Option[String] = this match
+ case Bad(why) => Some(why)
+ case Ok(_) => None
+
+ def value: Option[Int] = this match
+ case Bad(_) => None
+ case Ok(n) => Some(n)
+
+ def parse(raw: String): Result =
+ raw.toIntOption match
+ case Some(n) if n > 0 => Result.Ok(n)
+ case Some(_) => Result.Bad("not positive")
+ case None => Result.Bad("not a number")
+
+ def quantity(raw: String): Option[Int] =
+ parse(raw).value
diff --git a/pages/refactorings/replace-inheritance-with-natural-transformation/03-either-option/Spec.hs b/pages/refactorings/replace-inheritance-with-natural-transformation/03-either-option/Spec.hs
new file mode 100644
index 0000000..62f6c9b
--- /dev/null
+++ b/pages/refactorings/replace-inheritance-with-natural-transformation/03-either-option/Spec.hs
@@ -0,0 +1,38 @@
+{-# 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
+
+-- Numerals around zero hit both error branches; letter noise
+-- covers the unparsable, digit runs the plain positives.
+genRaw :: Gen String
+genRaw = Gen.choice
+ [ show <$> Gen.int (Range.linear (-20) 20)
+ , Gen.string (Range.linear 0 4) Gen.alpha
+ , Gen.string (Range.linear 1 4) Gen.digit
+ ]
+
+prop_quantity_agrees :: Property
+prop_quantity_agrees = property $ do
+ raw <- forAll genRaw
+ Before.quantity raw === After.quantity raw
+
+prop_toMaybe_natural :: Property
+prop_toMaybe_natural = property $ do
+ raw <- forAll genRaw
+ let e = After.parse raw
+ After.toMaybe ((* 2) <$> e) === ((* 2) <$> After.toMaybe e)
+
+main :: IO ()
+main = do
+ ok <- checkParallel $ Group "Props"
+ [ ("quantity: Before == After", prop_quantity_agrees)
+ , ("toMaybe is natural in a", prop_toMaybe_natural)
+ ]
+ unless ok exitFailure
diff --git a/pages/refactorings/replace-inheritance-with-natural-transformation/03-either-option/Spec.scala b/pages/refactorings/replace-inheritance-with-natural-transformation/03-either-option/Spec.scala
new file mode 100644
index 0000000..1a2eccc
--- /dev/null
+++ b/pages/refactorings/replace-inheritance-with-natural-transformation/03-either-option/Spec.scala
@@ -0,0 +1,40 @@
+//> 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("quantity: Before == After", quantityAgrees),
+ property("toOption is natural in A", toOptionIsNatural),
+ )
+
+ // Numerals around zero hit both error branches; letter noise
+ // covers the unparsable, digit runs the plain positives.
+ val genRaw: Gen[String] =
+ Gen.choice1(
+ Gen.int(Range.linear(-20, 20)).map(_.toString),
+ Gen.string(Gen.alpha, Range.linear(0, 4)),
+ Gen.string(Gen.digit, Range.linear(1, 4)),
+ )
+
+ def quantityAgrees: Property =
+ for raw <- genRaw.forAll
+ yield Before.quantity(raw) ==== After.quantity(raw)
+
+ def toOptionIsNatural: Property =
+ for raw <- genRaw.forAll
+ yield
+ val e = After.parse(raw)
+ After.toOption(e.map(_ * 2)) ====
+ After.toOption(e).map(_ * 2)
+
+@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)
diff --git a/pages/refactorings/replace-inheritance-with-natural-transformation/03-either-option/diagram.svg b/pages/refactorings/replace-inheritance-with-natural-transformation/03-either-option/diagram.svg
new file mode 100644
index 0000000..24363d9
--- /dev/null
+++ b/pages/refactorings/replace-inheritance-with-natural-transformation/03-either-option/diagram.svg
@@ -0,0 +1,51 @@
+
diff --git a/pages/refactorings/replace-inheritance-with-natural-transformation/diagrams/koan.svg b/pages/refactorings/replace-inheritance-with-natural-transformation/diagrams/koan.svg
new file mode 100644
index 0000000..9bc4fcb
--- /dev/null
+++ b/pages/refactorings/replace-inheritance-with-natural-transformation/diagrams/koan.svg
@@ -0,0 +1,63 @@
+
diff --git a/pages/refactorings/replace-inheritance-with-natural-transformation/run.sh b/pages/refactorings/replace-inheritance-with-natural-transformation/run.sh
new file mode 100644
index 0000000..7b8cb88
--- /dev/null
+++ b/pages/refactorings/replace-inheritance-with-natural-transformation/run.sh
@@ -0,0 +1,24 @@
+#!/bin/sh
+# Runs every hedgehog property for this refactoring, in both languages.
+# Each NN-*/ directory holds Before + After + Spec in Scala 3 and Haskell;
+# Spec generates inputs and asserts Before and After agree on all of them.
+#
+# Needs: scala-cli (https://scala-cli.virtuslab.org) and either ghc with
+# hedgehog on the package path, or docker (the image is built on first use).
+set -eu
+cd "$(dirname "$0")"
+
+if command -v ghc >/dev/null 2>&1 && ghc-pkg list hedgehog 2>/dev/null | grep -q hedgehog; then
+ hs() { runghc -i"$1" "$1/Spec.hs"; }
+else
+ docker image inspect cp-hedgehog >/dev/null 2>&1 || \
+ printf 'FROM haskell:9.8-slim\nRUN cabal update && cabal install --lib hedgehog\n' | docker build -t cp-hedgehog -
+ hs() { docker run --rm -v "$PWD:/w" -w /w cp-hedgehog runghc -i"$1" "$1/Spec.hs"; }
+fi
+
+for d in [0-9][0-9]-*/; do
+ d=${d%/}
+ echo "== $d (scala)"; scala-cli run "$d" --main-class spec
+ echo "== $d (haskell)"; hs "$d"
+done
+echo "all properties passed"