diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,13 @@
+#### 0.9.0 (2024-01-16)
+
+* Split the package into the machinery that abstracts over whichever diffing
+  implementation is in use (via the `CanDiff` class), and the implementation of
+  that class via the vendored tree-diff. See the
+  [README](https://github.com/stevana/quickcheck-state-machine#using-quickcheck-state-machine-as-a-dependency)
+  for more details on how to depend on either.
+
+* Support building with ghc-9.8.1.
+
 #### 0.8.0 (2023-11-17)
 
 * BREAKING CHANGE: Remove `markov-chain-usage-model` dependency and the related
diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md
--- a/CONTRIBUTING.md
+++ b/CONTRIBUTING.md
@@ -1,14 +1,11 @@
 ## Contributing
 
-### Release checklist
+Contributions are most welcome!
 
+Please open an issue before embarking on a big change. Before you open a PR,
+try to:
+
   1. Update CHANGELOG.md;
-  2. Bump version in .cabal file and fix bounds;
-  3. Check cabal file with `cabal check`;
-  4. Make tarball with `cabal sdist`;
-  5. Upload tarball as a
-     package
-     [candidate](https://hackage.haskell.org/packages/candidates/upload), and if
-     everything looks good then release it;
-  6. Git tag the version: `git tag -a v$VERSION -m "Tag v$VERISON" && git push
-     origin v$VERSION`.
+  2. Add `@since $VERSION`, if appropriate;
+  3. Update CI in `.github/workflows/main.yaml` if, for example, new GHC support
+     is added.
diff --git a/LICENSE b/LICENSE
--- a/LICENSE
+++ b/LICENSE
@@ -1,7 +1,7 @@
-Copyright (c) 2017-2023 Stevan Andjelkovic, Daniel Gustafsson, Jacob Stanley,
+Copyright (c) 2017-2024 Stevan Andjelkovic, Daniel Gustafsson, Jacob Stanley,
                         Xia Li-yao, Robert Danitz, Thomas Winant, Edsko de
                         Vries, Momoko Hattori, Kostas Dermentzis, Adam Boniecki,
-                        Javier Sagredo, Oleg Grenrus
+                        Javier Sagredo, Oleg Grenrus, Erik de Castro Lopo
 
 All rights reserved.
 
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -667,6 +667,43 @@
     [tests](https://github.com/stevana/raft/blob/master/test/QuickCheckStateMachine.hs)
     combined with fault injection (node and network failures).
 
+### Using `quickcheck-state-machine` as a dependency
+
+In order to bring `quickcheck-state-machine` into your code, add it to the
+`build-depends` section in your cabal file:
+
+``` cabal
+test-suite ...
+  build-depends:
+    , quickcheck-state-machine
+```
+
+This dependency can be used out of the box, however, it comes with an fork of an
+old version of
+[`tree-diff`](https://hackage.haskell.org/package/tree-diff-0.0.2.1) vendored
+inside.
+
+> For `quickcheck-state-machine` to remain BSD-style licensed, it could not
+> depend on the `tree-diff` package as that one changed its license to `GPL`,
+> therefore the solution was to vendor an older BSD-style licensed version of
+> it. Using this vendored version, your code regardless of whether it is testing
+> code or not, can remain BSD-style licensed.
+
+In case you want to make use of the upstream `tree-diff` package, you can depend
+on a slightly different library name:
+
+``` cabal
+test-suite ...
+  build-depends:
+    , quickcheck-state-machine:no-vendored-treediff
+```
+
+For this to compile properly, you will have to provide your own machinery to
+implement the `CanDiff` class with the upstream `tree-diff` definitions. You
+will have to implement something very similar to [this
+module](./tree-diff/Test/StateMachine/TreeDiff/Diffing.hs) (which is doing
+exactly this but with an old `tree-diff` version).
+
 ### How to contribute
 
 The `quickcheck-state-machine` library is still very experimental.
diff --git a/quickcheck-state-machine.cabal b/quickcheck-state-machine.cabal
--- a/quickcheck-state-machine.cabal
+++ b/quickcheck-state-machine.cabal
@@ -1,6 +1,6 @@
 cabal-version:   3.0
 name:            quickcheck-state-machine
-version:         0.8.0
+version:         0.9.0
 synopsis:        Test monadic programs using state machine based models
 description:
   See README at <https://github.com/stevana/quickcheck-state-machine#readme>
@@ -13,7 +13,7 @@
 copyright:
   Copyright (C) 2017-2018, ATS Advanced Telematic Systems GmbH;
   2018-2019, HERE Europe B.V.;
-  2019-2023, Stevan Andjelkovic.
+  2019-2024, Stevan Andjelkovic.
 
 category:        Testing
 build-type:      Simple
@@ -22,15 +22,24 @@
   CONTRIBUTING.md
   README.md
 
-tested-with:     GHC ==8.8.4 || ==8.10.7 || ==9.2.8 || ==9.4.7 || ==9.6.3
+tested-with:
+  GHC ==8.8.4 || ==8.10.7 || ==9.2.8 || ==9.4.7 || ==9.6.3 || ==9.8.1
 
-library
+-- Due to `tree-diff` being `GPL`, this library makes use of an interface
+-- (@CanDiff@) to diff models. This can be implemented with the vendored
+-- tree-diff or with the upstream one, but we only provide the former in the
+-- main library of the package below. See
+-- https://github.com/stevana/quickcheck-state-machine#readme for how to depend
+-- on either version.
+library no-vendored-treediff
+  visibility:       public
   hs-source-dirs:   src
   ghc-options:      -Wall
   exposed-modules:
     Test.StateMachine
     Test.StateMachine.BoxDrawer
     Test.StateMachine.ConstructorName
+    Test.StateMachine.Diffing
     Test.StateMachine.DotDrawing
     Test.StateMachine.Labelling
     Test.StateMachine.Lockstep.Auxiliary
@@ -39,12 +48,6 @@
     Test.StateMachine.Logic
     Test.StateMachine.Parallel
     Test.StateMachine.Sequential
-    Test.StateMachine.TreeDiff
-    Test.StateMachine.TreeDiff.Class
-    Test.StateMachine.TreeDiff.Expr
-    Test.StateMachine.TreeDiff.List
-    Test.StateMachine.TreeDiff.Pretty
-    Test.StateMachine.TreeDiff.Tree
     Test.StateMachine.Types
     Test.StateMachine.Types.Environment
     Test.StateMachine.Types.GenSym
@@ -54,25 +57,20 @@
     Test.StateMachine.Utils
     Test.StateMachine.Z
 
-  other-modules:    Paths_quickcheck_state_machine
-  autogen-modules:  Paths_quickcheck_state_machine
-
   -- GHC boot library dependencies:
   -- (https://gitlab.haskell.org/ghc/ghc/-/blob/master/packages)
   build-depends:
     , base        >=4.10    && <5
-    , containers  >=0.5.7.1 && <0.7
+    , containers  >=0.5.7.1 && <0.8
     , directory   >=1.0.0.0 && <1.4
     , exceptions  >=0.8.3   && <0.11
-    , filepath    >=1.0     && <1.5
+    , filepath    >=1.0     && <1.6
     , mtl         >=2.2.1   && <2.4
-    , process     >=1.2.0.0 && <1.7
-    , text        >=1.2.3.1 && <2.1
+    , text        >=1.2.3.1 && <2.2
     , time        >=1.7     && <1.13
 
   build-depends:
     , ansi-wl-pprint  >=0.6.7.3     && <1.1
-    , generic-data    >=0.3.0.0     && <1.2
     , graphviz        >=2999.20.0.3 && <2999.21
     , pretty-show     >=1.6.16      && <1.11
     , QuickCheck      >=2.12        && <2.15
@@ -81,23 +79,72 @@
     , split           >=0.2.3.5     && <0.3
     , unliftio        >=0.2.7.0     && <0.3
 
+  default-language: Haskell2010
+
+library
+  hs-source-dirs:     tree-diff
+  ghc-options:        -Wall
+  exposed-modules:
+    Test.StateMachine.TreeDiff
+    Test.StateMachine.TreeDiff.Class
+    Test.StateMachine.TreeDiff.Diffing
+    Test.StateMachine.TreeDiff.Expr
+    Test.StateMachine.TreeDiff.List
+    Test.StateMachine.TreeDiff.Pretty
+    Test.StateMachine.TreeDiff.Tree
+
+  reexported-modules:
+    Test.StateMachine,
+    Test.StateMachine.BoxDrawer,
+    Test.StateMachine.ConstructorName,
+    Test.StateMachine.Diffing,
+    Test.StateMachine.DotDrawing,
+    Test.StateMachine.Labelling,
+    Test.StateMachine.Lockstep.Auxiliary,
+    Test.StateMachine.Lockstep.NAry,
+    Test.StateMachine.Lockstep.Simple,
+    Test.StateMachine.Logic,
+    Test.StateMachine.Parallel,
+    Test.StateMachine.Sequential,
+    Test.StateMachine.Types,
+    Test.StateMachine.Types.Environment,
+    Test.StateMachine.Types.GenSym,
+    Test.StateMachine.Types.History,
+    Test.StateMachine.Types.Rank2,
+    Test.StateMachine.Types.References,
+    Test.StateMachine.Utils,
+    Test.StateMachine.Z
+
+  -- GHC boot library dependencies:
+  -- (https://gitlab.haskell.org/ghc/ghc/-/blob/master/packages)
+  build-depends:
+    , base
+    , containers
+    , text
+    , time
+
+  build-depends:
+    , ansi-wl-pprint
+    , QuickCheck
+    , sop-core
+
   -- tree-diff dependencies:
   build-depends:
-    , base-compat   >=0.9.3    && <0.14
-    , bytestring    >=0.10.4.0 && <0.12
-    , generics-sop  >=0.3.1.0  && <0.6
-    , MemoTrie      >=0.6.8    && <0.7
-    , pretty        >=1.1.1.1  && <1.2
-    , vector        >=0.12.0.1 && <0.14
+    , base-compat                                    >=0.9.3    && <0.14
+    , bytestring                                     >=0.10.4.0 && <0.13
+    , generics-sop                                   >=0.3.1.0  && <0.6
+    , MemoTrie                                       >=0.6.8    && <0.7
+    , pretty                                         >=1.1.1.1  && <1.2
+    , quickcheck-state-machine:no-vendored-treediff
+    , vector                                         >=0.12.0.1 && <0.14
 
-  default-language: Haskell2010
+  default-language:   Haskell2010
 
 test-suite test
   type:             exitcode-stdio-1.0
   hs-source-dirs:   test
   main-is:          Spec.hs
   build-depends:
-    , aeson                     >=1.4.6.0  && <2.3
     , array                     >=0.5.4.0  && <0.6
     , base
     , bifunctors                >=5.5.7    && <5.7
@@ -116,7 +163,6 @@
     , persistent                >=2.10.5.2 && <2.15
     , persistent-postgresql     >=2.10.1.2 && <2.14
     , persistent-sqlite         >=2.10.6.2 && <2.14
-    , persistent-template       >=2.8.2.3  && <2.13
     , postgresql-simple         >=0.6.2    && <0.8
     , pretty-show
     , process
@@ -126,7 +172,6 @@
     , random
     , resource-pool             >=0.2.3.2  && <0.5
     , resourcet                 >=1.2.3    && <1.4
-    , servant                   >=0.16.2   && <0.21
     , servant-client            >=0.16.0.1 && <0.21
     , servant-server            >=0.16.2   && <0.21
     , split                     >=0.2.3.5  && <0.3
@@ -140,7 +185,6 @@
     , unliftio
     , unliftio-core             >=0.1.2.0  && <0.3
     , vector
-    , wai                       >=3.2.2.1  && <3.3
     , warp                      >=3.3.9    && <3.4
 
   other-modules:
diff --git a/src/Test/StateMachine.hs b/src/Test/StateMachine.hs
--- a/src/Test/StateMachine.hs
+++ b/src/Test/StateMachine.hs
@@ -70,19 +70,16 @@
 
   , module Test.StateMachine.Logic
 
-    -- * Re-export
-  , ToExpr
-  , toExpr
-
+  -- * Diffing class
+  , CanDiff (..)
   ) where
 
 import           Prelude
                    ()
 
 import           Test.StateMachine.ConstructorName
+import           Test.StateMachine.Diffing
 import           Test.StateMachine.Logic
 import           Test.StateMachine.Parallel
 import           Test.StateMachine.Sequential
-import           Test.StateMachine.TreeDiff
-                   (ToExpr, toExpr)
 import           Test.StateMachine.Types
diff --git a/src/Test/StateMachine/Diffing.hs b/src/Test/StateMachine/Diffing.hs
new file mode 100644
--- /dev/null
+++ b/src/Test/StateMachine/Diffing.hs
@@ -0,0 +1,39 @@
+{-# LANGUAGE FlexibleInstances      #-}
+{-# LANGUAGE ScopedTypeVariables    #-}
+{-# LANGUAGE TypeApplications       #-}
+{-# LANGUAGE TypeFamilyDependencies #-}
+{-# LANGUAGE UndecidableInstances   #-}
+
+-- | Class that will be used when diffing values. It ought to be instantiated
+-- with our vendored @tree-diff@ (see "Test.StateMachine.Diffing.TreeDiff"), or
+-- other akin implementations.
+
+module Test.StateMachine.Diffing (CanDiff(..), ediff) where
+
+import           Data.Proxy
+                   (Proxy(..))
+import qualified Text.PrettyPrint.ANSI.Leijen as WL
+
+class CanDiff x where
+  -- | Expressions that will be diffed
+  type AnExpr x
+  -- | What will the diff of two @AnExpr@s result in
+  type ADiff x
+
+  -- | Extract the expression from the data
+  toDiff :: x -> AnExpr x
+
+  -- | Diff two expressions
+  exprDiff :: Proxy x -> AnExpr x -> AnExpr x -> ADiff x
+
+  -- | Output a diff in compact form
+  diffToDocCompact :: Proxy x -> ADiff x -> WL.Doc
+
+  -- | Output a diff
+  diffToDoc :: Proxy x -> ADiff x -> WL.Doc
+
+  -- | Output an expression
+  exprToDoc :: Proxy x -> AnExpr x -> WL.Doc
+
+ediff :: forall x. CanDiff x => x -> x -> ADiff x
+ediff x y = exprDiff (Proxy @x) (toDiff x) (toDiff y)
diff --git a/src/Test/StateMachine/Lockstep/NAry.hs b/src/Test/StateMachine/Lockstep/NAry.hs
--- a/src/Test/StateMachine/Lockstep/NAry.hs
+++ b/src/Test/StateMachine/Lockstep/NAry.hs
@@ -22,7 +22,7 @@
   , Cmd
   , Resp
   , RealHandles
-  , MockHandle
+  , MockHandleN
   , Test
   , Tag
     -- * Test term-level parameters
@@ -71,7 +71,6 @@
 import qualified Test.StateMachine.Types.Rank2        as Rank2
 
 import           Test.StateMachine.Lockstep.Auxiliary
-import qualified Test.StateMachine.TreeDiff           as TD
 
 {-------------------------------------------------------------------------------
   Test type-level parameters
@@ -94,8 +93,8 @@
 
 -- | Mock handles
 --
--- For each real handle @a@, @MockHandle t a@ is the corresponding mock handle.
-data family MockHandle t a :: Type
+-- For each real handle @a@, @MockHandleN t a@ is the corresponding mock handle.
+data family MockHandleN t a :: Type
 
 -- | Commands
 --
@@ -103,7 +102,7 @@
 -- functor applied to each of them. Two typical instantiations are
 --
 -- > Cmd t I              (RealHandles t)   -- for the system under test
--- > Cmd t (MockHandle t) (RealHandles t)   -- for the mock
+-- > Cmd t (MockHandleN t) (RealHandles t)   -- for the mock
 data family Cmd t :: (Type -> Type) -> [Type] -> Type
 
 -- | Responses
@@ -111,7 +110,7 @@
 -- The type arguments are similar to those of @Cmd@. Two typical instances:
 --
 -- > Resp t I              (RealHandles t)  -- for the system under test
--- > Resp t (MockHandle t) (RealHandles t)  -- for the mock
+-- > Resp t (MockHandleN t) (RealHandles t)  -- for the mock
 data family Resp t :: (Type -> Type) -> [Type] -> Type
 
 -- | Tags
@@ -126,43 +125,28 @@
 -------------------------------------------------------------------------------}
 
 -- | Relation between real and mock references for single handle type @a@
-newtype Refs t r a = Refs { unRefs :: [(Reference a r, MockHandle t a)] }
+newtype Refs t r a = Refs { unRefs :: [(Reference a r, MockHandleN t a)] }
   deriving newtype (Semigroup, Monoid, Generic)
 
 deriving
   stock
-  instance (Show1 r, Show a, Show (MockHandle t a)) => Show (Refs t r a)
-
-deriving
-  newtype
-  instance (ToExpr a, ToExpr (MockHandle t a)) => ToExpr (Refs t Concrete a)
+  instance (Show1 r, Show a, Show (MockHandleN t a)) => Show (Refs t r a)
 
 -- | Relation between real and mock references for /all/ handle types
 newtype Refss t r = Refss { unRefss :: NP (Refs t r) (RealHandles t) }
 
 instance ( Show1 r
-         , All (And Show (Compose Show (MockHandle t))) (RealHandles t)
+         , All (And Show (Compose Show (MockHandleN t))) (RealHandles t)
          ) => Show (Refss t r) where
   show = unlines
        . hcollapse
-       . hcmap (Proxy @(And Show (Compose Show (MockHandle t)))) showOne
+       . hcmap (Proxy @(And Show (Compose Show (MockHandleN t)))) showOne
        . unRefss
     where
-      showOne :: (Show a, Show (MockHandle t a))
+      showOne :: (Show a, Show (MockHandleN t a))
               => Refs t r a -> K String a
       showOne = K . show
 
-instance All (And ToExpr (Compose ToExpr (MockHandle t))) (RealHandles t)
-      => ToExpr (Refss t Concrete) where
-  toExpr = TD.Lst
-         . hcollapse
-         . hcmap (Proxy @(And ToExpr (Compose ToExpr (MockHandle t)))) toExprOne
-         . unRefss
-    where
-      toExprOne :: (ToExpr a, ToExpr (MockHandle t a))
-                => Refs t Concrete a -> K TD.Expr a
-      toExprOne = K . toExpr
-
 instance SListI (RealHandles t) => Semigroup (Refss t r) where
   Refss rss <> Refss rss' = Refss $ hzipWith (<>) rss rss'
 
@@ -201,13 +185,9 @@
 
 deriving stock instance ( Show1 r
                         , Show (MockState t)
-                        , All (And Show (Compose Show (MockHandle t))) (RealHandles t)
+                        , All (And Show (Compose Show (MockHandleN t))) (RealHandles t)
                         ) => Show (Model t r)
 
-instance ( ToExpr (MockState t)
-         , All (And ToExpr (Compose ToExpr (MockHandle t))) (RealHandles t)
-         ) => ToExpr (Model t Concrete)
-
 initModel :: StateMachineTest t m -> Model t r
 initModel StateMachineTest{..} = Model initMock (Refss (hpure (Refs [])))
 
@@ -222,14 +202,14 @@
 data StateMachineTest t m =
     ( Monad m
     -- Requirements on the handles
-    , All Typeable                                     (RealHandles t)
-    , All Eq                                           (RealHandles t)
-    , All (And Show   (Compose Show   (MockHandle t))) (RealHandles t)
-    , All (And ToExpr (Compose ToExpr (MockHandle t))) (RealHandles t)
+    , All Typeable                                       (RealHandles t)
+    , All Eq                                             (RealHandles t)
+    , All (And Show    (Compose Show    (MockHandleN t))) (RealHandles t)
+    , All (And CanDiff (Compose CanDiff (MockHandleN t))) (RealHandles t)
     -- Response
     , NTraversable (Resp t)
-    , Eq   (Resp t (MockHandle t)     (RealHandles t))
-    , Show (Resp t (MockHandle t)     (RealHandles t))
+    , Eq   (Resp t (MockHandleN t)     (RealHandles t))
+    , Show (Resp t (MockHandleN t)     (RealHandles t))
     , Show (Resp t (FlipRef Symbolic) (RealHandles t))
     , Show (Resp t (FlipRef Concrete) (RealHandles t))
     -- Command
@@ -238,11 +218,13 @@
     , Show (Cmd t (FlipRef Concrete) (RealHandles t))
     -- MockState
     , Show   (MockState t)
-    , ToExpr (MockState t)
+    , CanDiff (MockState t)
     -- Tags
     , Show (Tag t)
+    -- Model
+    , CanDiff (Model t Concrete)
     ) => StateMachineTest {
-      runMock    :: Cmd t (MockHandle t) (RealHandles t) -> MockState t -> (Resp t (MockHandle t) (RealHandles t), MockState t)
+      runMock    :: Cmd t (MockHandleN t) (RealHandles t) -> MockState t -> (Resp t (MockHandleN t) (RealHandles t), MockState t)
     , runReal    :: Cmd t I              (RealHandles t) -> m (Resp t I (RealHandles t))
     , initMock   :: MockState t
     , newHandles :: forall f. Resp t f (RealHandles t) -> NP ([] :.: f) (RealHandles t)
@@ -288,30 +270,30 @@
 -- > toMock :: Refss t Symbolic
 --          -> Cmd (FlipRef r) (Handles t)
 --          -> Cmd  ToMock     (Handles t)
-toMockHandles :: (NTraversable f, t ~ Test f, All Eq (RealHandles t), Eq1 r)
-              => Refss t r -> f :@ r -> f (MockHandle t) (RealHandles t)
-toMockHandles rss (At fr) =
+toMockHandleNs :: (NTraversable f, t ~ Test f, All Eq (RealHandles t), Eq1 r)
+              => Refss t r -> f :@ r -> f (MockHandleN t) (RealHandles t)
+toMockHandleNs rss (At fr) =
     ncfmap (Proxy @Eq) (\pf -> find (unRefss rss) pf . unFlipRef) fr
   where
     find :: (Eq a, Eq1 r)
          => NP (Refs t r) (RealHandles t)
          -> Elem (RealHandles t) a
-         -> Reference a r -> MockHandle t a
+         -> Reference a r -> MockHandleN t a
     find refss ix r = unRefs (npAt refss ix) ! r
 
 step :: Eq1 r
      => StateMachineTest t m
      -> Model t r
      -> Cmd t :@ r
-     -> (Resp t (MockHandle t) (RealHandles t), MockState t)
+     -> (Resp t (MockHandleN t) (RealHandles t), MockState t)
 step StateMachineTest{..} (Model st rss) cmd =
-    runMock (toMockHandles rss cmd) st
+    runMock (toMockHandleNs rss cmd) st
 
 data Event t r = Event {
       before   :: Model t    r
     , cmd      :: Cmd   t :@ r
     , after    :: Model t    r
-    , mockResp :: Resp t (MockHandle t) (RealHandles t)
+    , mockResp :: Resp t (MockHandleN t) (RealHandles t)
     }
 
 lockstep :: forall t m r. Eq1 r
@@ -346,7 +328,7 @@
               -> Resp  t :@ Concrete
               -> Logic
 postcondition sm@StateMachineTest{} m c r =
-    toMockHandles (modelRefss $ after e) r .== mockResp e
+    toMockHandleNs (modelRefss $ after e) r .== mockResp e
   where
     e = lockstep sm m c r
 
@@ -543,9 +525,9 @@
 
 zipHandles :: SListI (RealHandles t)
            => NP ([] :.: FlipRef r)    (RealHandles t)
-           -> NP ([] :.: MockHandle t) (RealHandles t)
+           -> NP ([] :.: MockHandleN t) (RealHandles t)
            -> Refss t r
 zipHandles = \real mock -> Refss $ hzipWith zip' real mock
   where
-    zip' :: (:.:) [] (FlipRef r) a -> (:.:) [] (MockHandle t) a -> Refs t r a
+    zip' :: (:.:) [] (FlipRef r) a -> (:.:) [] (MockHandleN t) a -> Refs t r a
     zip' (Comp real) (Comp mock) = Refs $ zip (map unFlipRef real) mock
diff --git a/src/Test/StateMachine/Lockstep/Simple.hs b/src/Test/StateMachine/Lockstep/Simple.hs
--- a/src/Test/StateMachine/Lockstep/Simple.hs
+++ b/src/Test/StateMachine/Lockstep/Simple.hs
@@ -33,6 +33,9 @@
   , prop_parallel
     -- * Translate to n-ary model model
   , fromSimple
+    -- * For orphan ToExpr instances
+  , Simple
+  , NAry.MockHandleN(SimpleToMock)
   ) where
 
 import           Data.Bifunctor
@@ -144,7 +147,7 @@
 cmdAtToSimple = At . fmap NAry.unFlipRef . unSimpleCmd . NAry.unAt
 
 cmdMockToSimple :: Functor (Cmd t)
-                => NAry.Cmd (Simple t) (NAry.MockHandle (Simple t)) '[RealHandle t]
+                => NAry.Cmd (Simple t) (NAry.MockHandleN (Simple t)) '[RealHandle t]
                 -> Cmd t (MockHandle t)
 cmdMockToSimple = fmap unSimpleToMock . unSimpleCmd
 
@@ -155,11 +158,11 @@
 
 respMockFromSimple :: Functor (Resp t)
                    => Resp t (MockHandle t)
-                   -> NAry.Resp (Simple t) (NAry.MockHandle (Simple t)) '[RealHandle t]
+                   -> NAry.Resp (Simple t) (NAry.MockHandleN (Simple t)) '[RealHandle t]
 respMockFromSimple = SimpleResp . fmap SimpleToMock
 
 respMockToSimple :: Functor (Resp t)
-                 => NAry.Resp (Simple t) (NAry.MockHandle (Simple t)) '[RealHandle t]
+                 => NAry.Resp (Simple t) (NAry.MockHandleN (Simple t)) '[RealHandle t]
                  -> Resp t (MockHandle t)
 respMockToSimple = fmap unSimpleToMock . unSimpleResp
 
@@ -191,18 +194,21 @@
     , Show (Cmd t (Reference (RealHandle t) Concrete))
     , Traversable (Cmd t)
       -- Real handles
-    , Eq     (RealHandle t)
-    , Show   (RealHandle t)
-    , ToExpr (RealHandle t)
+    , Eq      (RealHandle t)
+    , Show    (RealHandle t)
+    , CanDiff (RealHandle t)
       -- Mock handles
-    , Eq     (MockHandle t)
-    , Show   (MockHandle t)
-    , ToExpr (MockHandle t)
+    , Eq      (MockHandle t)
+    , Show    (MockHandle t)
+    , CanDiff (MockHandle t)
+    , CanDiff (NAry.MockHandleN (Simple t) (RealHandle t))
       -- Mock state
-    , Show   (MockState t)
-    , ToExpr (MockState t)
+    , Show    (MockState t)
+    , CanDiff (MockState t)
       -- Tags
     , Show (Tag t)
+      -- Model
+    , CanDiff (NAry.Model (Simple t) Concrete)
     ) => StateMachineTest {
       runMock    :: Cmd t (MockHandle t) -> MockState t -> (Resp t (MockHandle t), MockState t)
     , runReal    :: Cmd t (RealHandle t) -> IO (Resp t (RealHandle t))
@@ -226,7 +232,7 @@
 data instance NAry.Resp (Simple _) _f _hs where
     SimpleResp :: Resp t (f h) -> NAry.Resp (Simple t) f '[h]
 
-newtype instance NAry.MockHandle (Simple t) (RealHandle t) =
+newtype instance NAry.MockHandleN (Simple t) (RealHandle t) =
     SimpleToMock { unSimpleToMock :: MockHandle t }
 
 unSimpleCmd :: NAry.Cmd (Simple t) f '[h] -> Cmd t (f h)
@@ -238,12 +244,12 @@
 instance ( Functor (Resp t)
          , Eq (Resp t (MockHandle t))
          , Eq (MockHandle t)
-         ) => Eq (NAry.Resp (Simple t) (NAry.MockHandle (Simple t)) '[RealHandle t]) where
+         ) => Eq (NAry.Resp (Simple t) (NAry.MockHandleN (Simple t)) '[RealHandle t]) where
   SimpleResp r == SimpleResp r' = (unSimpleToMock <$> r) == (unSimpleToMock <$> r')
 
 instance ( Functor (Resp t)
          , Show (Resp t (MockHandle t))
-         ) => Show (NAry.Resp (Simple t) (NAry.MockHandle (Simple t)) '[RealHandle t]) where
+         ) => Show (NAry.Resp (Simple t) (NAry.MockHandleN (Simple t)) '[RealHandle t]) where
   show (SimpleResp r) = show (unSimpleToMock <$> r)
 
 instance ( Functor (Resp t)
@@ -258,18 +264,14 @@
          ) => Show (NAry.Cmd (Simple t) (NAry.FlipRef r) '[RealHandle t]) where
   show (SimpleCmd r) = show (NAry.unFlipRef <$> r)
 
-deriving stock instance Eq   (MockHandle t) => Eq   (NAry.MockHandle (Simple t) (RealHandle t))
-deriving stock instance Show (MockHandle t) => Show (NAry.MockHandle (Simple t) (RealHandle t))
+deriving stock instance Eq   (MockHandle t) => Eq   (NAry.MockHandleN (Simple t) (RealHandle t))
+deriving stock instance Show (MockHandle t) => Show (NAry.MockHandleN (Simple t) (RealHandle t))
 
 instance Traversable (Resp t) => NTraversable (NAry.Resp (Simple t)) where
   nctraverse _ f (SimpleResp x) = SimpleResp <$> traverse (f ElemHead) x
 
 instance Traversable (Cmd t) => NTraversable (NAry.Cmd (Simple t)) where
   nctraverse _ f (SimpleCmd x) = SimpleCmd <$> traverse (f ElemHead) x
-
-instance ToExpr (MockHandle t)
-      => ToExpr (NAry.MockHandle (Simple t) (RealHandle t)) where
-  toExpr (SimpleToMock h) = toExpr h
 
 fromSimple :: StateMachineTest t -> NAry.StateMachineTest (Simple t) IO
 fromSimple StateMachineTest{..} = NAry.StateMachineTest {
diff --git a/src/Test/StateMachine/Sequential.hs b/src/Test/StateMachine/Sequential.hs
--- a/src/Test/StateMachine/Sequential.hs
+++ b/src/Test/StateMachine/Sequential.hs
@@ -1,11 +1,13 @@
 {-# LANGUAGE BangPatterns          #-}
 {-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE MonoLocalBinds        #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NamedFieldPuns        #-}
 {-# LANGUAGE PolyKinds             #-}
 {-# LANGUAGE RecordWildCards       #-}
 {-# LANGUAGE ScopedTypeVariables   #-}
 {-# LANGUAGE TupleSections         #-}
+{-# LANGUAGE TypeApplications      #-}
 
 -----------------------------------------------------------------------------
 -- |
@@ -111,11 +113,11 @@
                    (throwIO)
 
 import           Test.StateMachine.ConstructorName
+import           Test.StateMachine.Diffing
+                   (CanDiff(..), ediff)
 import           Test.StateMachine.Labelling
                    (Event(..), execCmds)
 import           Test.StateMachine.Logic
-import           Test.StateMachine.TreeDiff
-                   (ToExpr, ansiWlBgEditExprCompact, ediff)
 import           Test.StateMachine.Types
 import qualified Test.StateMachine.Types.Rank2     as Rank2
 import           Test.StateMachine.Utils
@@ -462,10 +464,12 @@
 getUsedConcrete :: Rank2.Foldable f => f Concrete -> [Dynamic]
 getUsedConcrete = Rank2.foldMap (\(Concrete x) -> [toDyn x])
 
-modelDiff :: ToExpr (model r) => model r -> Maybe (model r) -> Doc
-modelDiff model = ansiWlBgEditExprCompact . flip ediff model . fromMaybe model
+modelDiff :: forall model r. CanDiff (model r) => model r -> Maybe (model r) -> Doc
+modelDiff model = diffToDocCompact p . flip ediff model . fromMaybe model
+ where
+   p = Proxy @(model r)
 
-prettyPrintHistory :: forall model cmd m resp. ToExpr (model Concrete)
+prettyPrintHistory :: forall model cmd m resp. CanDiff (model Concrete)
                    => (Show (cmd Concrete), Show (resp Concrete))
                    => StateMachine model cmd m resp
                    -> History cmd resp
@@ -510,7 +514,7 @@
         ]
     go _ _ _ = error "prettyPrintHistory: impossible."
 
-prettyCommands :: (MonadIO m, ToExpr (model Concrete))
+prettyCommands :: (MonadIO m, CanDiff (model Concrete))
                => (Show (cmd Concrete), Show (resp Concrete))
                => StateMachine model cmd m resp
                -> History cmd resp
@@ -518,8 +522,8 @@
                -> PropertyM m ()
 prettyCommands sm hist prop = prettyPrintHistory sm hist `whenFailM` prop
 
-prettyPrintHistory' :: forall model cmd m resp tag. ToExpr (model Concrete)
-                    => (Show (cmd Concrete), Show (resp Concrete), ToExpr tag)
+prettyPrintHistory' :: forall model cmd m resp tag. CanDiff (model Concrete)
+                    => (Show (cmd Concrete), Show (resp Concrete), CanDiff [tag])
                     => StateMachine model cmd m resp
                     -> ([Event model cmd resp Symbolic] -> [tag])
                     -> Commands cmd resp
@@ -532,7 +536,7 @@
   . unHistory
   where
     tagsDiff :: [tag] -> [tag] -> Doc
-    tagsDiff old new = ansiWlBgEditExprCompact (ediff old new)
+    tagsDiff old new = diffToDocCompact (Proxy @[tag]) (ediff old new)
 
     go :: model Concrete -> Maybe (model Concrete) -> [tag] -> [[tag]]
        -> [Operation cmd resp] -> Doc
@@ -577,7 +581,7 @@
 
 -- | Variant of 'prettyCommands' that also prints the @tag@s covered by each
 -- command.
-prettyCommands' :: (MonadIO m, ToExpr (model Concrete), ToExpr tag)
+prettyCommands' :: (MonadIO m, CanDiff (model Concrete), CanDiff [tag])
                 => (Show (cmd Concrete), Show (resp Concrete))
                 => StateMachine model cmd m resp
                 -> ([Event model cmd resp Symbolic] -> [tag])
diff --git a/src/Test/StateMachine/TreeDiff.hs b/src/Test/StateMachine/TreeDiff.hs
deleted file mode 100644
--- a/src/Test/StateMachine/TreeDiff.hs
+++ /dev/null
@@ -1,21 +0,0 @@
--- | Diffing of (expression) trees.
---
--- Diffing arbitrary Haskell data. First we convert values to untyped
--- haskell-like expression 'Expr' using generically derivable 'ToExpr' class.
--- Then we can diff two 'Expr' values.
--- The conversion and diffing is done by 'ediff' function.
--- See type and function haddocks for an examples.
---
--- Interesting modules:
---
--- * "Data.TreeDiff.Class" for a 'ToExpr' class and 'ediff' utility.
---
-module Test.StateMachine.TreeDiff (
-    module Test.StateMachine.TreeDiff.Expr,
-    module Test.StateMachine.TreeDiff.Class,
-    module Test.StateMachine.TreeDiff.Pretty,
-    ) where
-
-import Test.StateMachine.TreeDiff.Expr
-import Test.StateMachine.TreeDiff.Class
-import Test.StateMachine.TreeDiff.Pretty
diff --git a/src/Test/StateMachine/TreeDiff/Class.hs b/src/Test/StateMachine/TreeDiff/Class.hs
deleted file mode 100644
--- a/src/Test/StateMachine/TreeDiff/Class.hs
+++ /dev/null
@@ -1,481 +0,0 @@
-{-# LANGUAGE CPP                 #-}
-{-# LANGUAGE ConstraintKinds     #-}
-{-# LANGUAGE DefaultSignatures   #-}
-{-# LANGUAGE FlexibleContexts    #-}
-{-# LANGUAGE GADTs               #-}
-{-# LANGUAGE RankNTypes          #-}
-{-# LANGUAGE ScopedTypeVariables #-}
--- | A 'ToExpr' class.
-module Test.StateMachine.TreeDiff.Class (
-    ediff,
-    ediff',
-    ToExpr (..),
-    defaultExprViaShow,
-    -- * SOP
-    sopToExpr,
-    ) where
-
-import Data.Foldable      (toList)
-import Data.Proxy         (Proxy (..))
-import Test.StateMachine.TreeDiff.Expr
-import Data.List.Compat      (uncons)
-import Generics.SOP
-       (All, All2, ConstructorInfo (..), DatatypeInfo (..), FieldInfo (..),
-       I (..), K (..), NP (..), SOP (..), constructorInfo, hcliftA2, hcmap,
-       hcollapse, mapIK)
-import Generics.SOP.GGP   (GCode, GDatatypeInfo, GFrom, gdatatypeInfo, gfrom)
-import GHC.Generics       (Generic)
-
-import qualified Data.Map as Map
-
--- Instances
-import Control.Applicative   (Const (..), ZipList (..))
-import Data.Fixed            (Fixed, HasResolution)
-import Data.Functor.Identity (Identity (..))
-import Data.Int
-import Data.List.NonEmpty    (NonEmpty (..))
-import Data.Void             (Void)
-import Data.Word
-import Numeric.Natural       (Natural)
-
-import qualified Data.Monoid    as Mon
-import qualified Data.Ratio     as Ratio
-import qualified Data.Semigroup as Semi
-
--- containers
-import qualified Data.IntMap   as IntMap
-import qualified Data.IntSet   as IntSet
-import qualified Data.Sequence as Seq
-import qualified Data.Set      as Set
-import qualified Data.Tree     as Tree
-
--- text
-import qualified Data.Text      as T
-import qualified Data.Text.Lazy as LT
-
--- time
-import qualified Data.Time as Time
-
--- bytestring
-import qualified Data.ByteString       as BS
-import qualified Data.ByteString.Lazy  as LBS
--- import qualified Data.ByteString.Short as SBS
-
--- scientific
--- import qualified Data.Scientific as Sci
-
--- uuid-types
--- import qualified Data.UUID.Types as UUID
-
--- vector
-import qualified Data.Vector           as V
-import qualified Data.Vector.Primitive as VP
-import qualified Data.Vector.Storable  as VS
-import qualified Data.Vector.Unboxed   as VU
-
--- tagged
--- import Data.Tagged (Tagged (..))
-
--- hashable
--- import Data.Hashable (Hashed, unhashed)
-
--- unordered-containers
--- import qualified Data.HashMap.Strict as HM
--- import qualified Data.HashSet        as HS
-
--- aeson
--- import qualified Data.Aeson as Aeson
-
--- | Difference between two 'ToExpr' values.
---
--- >>> let x = (1, Just 2) :: (Int, Maybe Int)
--- >>> let y = (1, Nothing)
--- >>> prettyEditExpr (ediff x y)
--- _×_ 1 -(Just 2) +Nothing
---
--- >>> data Foo = Foo { fooInt :: Either Char Int, fooBool :: [Maybe Bool], fooString :: String } deriving (Eq, Generic)
--- >>> instance ToExpr Foo
---
--- >>> prettyEditExpr $ ediff (Foo (Right 2) [Just True] "fo") (Foo (Right 3) [Just True] "fo")
--- Foo {fooBool = [Just True], fooInt = Right -2 +3, fooString = "fo"}
---
--- >>> prettyEditExpr $ ediff (Foo (Right 42) [Just True, Just False] "old") (Foo (Right 42) [Nothing, Just False, Just True] "new")
--- Foo
---   {fooBool = [-Just True, +Nothing, Just False, +Just True],
---    fooInt = Right 42,
---    fooString = -"old" +"new"}
---
-ediff :: ToExpr a => a -> a -> Edit EditExpr
-ediff x y = exprDiff (toExpr x) (toExpr y)
-
--- | Compare different types.
---
--- /Note:/ Use with care as you can end up comparing apples with oranges.
---
--- >>> prettyEditExpr $ ediff' ["foo", "bar"] [Just "foo", Nothing]
--- [-"foo", +Just "foo", -"bar", +Nothing]
---
-ediff' :: (ToExpr a, ToExpr b) => a -> b -> Edit EditExpr
-ediff' x y = exprDiff (toExpr x) (toExpr y)
-
--- | 'toExpr' converts a Haskell value into
--- untyped Haskell-like syntax tree, 'Expr'.
---
--- >>> toExpr ((1, Just 2) :: (Int, Maybe Int))
--- App "_\215_" [App "1" [],App "Just" [App "2" []]]
---
-class ToExpr a where
-    toExpr :: a -> Expr
-    default toExpr
-        :: (Generic a, All2 ToExpr (GCode a), GFrom a, GDatatypeInfo a)
-        => a -> Expr
-    toExpr x = sopToExpr (gdatatypeInfo (Proxy :: Proxy a)) (gfrom x)
-
-    listToExpr :: [a] -> Expr
-    listToExpr = Lst . map toExpr
-
-instance ToExpr Expr where
-    toExpr = id
-
--- | An alternative implementation for literal types. We use 'show'
--- representation of them.
-defaultExprViaShow :: Show a => a -> Expr
-defaultExprViaShow x = App (show x) []
-
--- | >>> prettyExpr $ sopToExpr (gdatatypeInfo (Proxy :: Proxy String)) (gfrom "foo")
--- _:_ 'f' "oo"
-sopToExpr :: (All2 ToExpr xss) => DatatypeInfo xss -> SOP I xss -> Expr
-sopToExpr di (SOP xss) = hcollapse $ hcliftA2
-    (Proxy :: Proxy (All ToExpr))
-    (\ci xs -> K (sopNPToExpr isNewtype ci xs))
-    (constructorInfo di)
-    xss
-  where
-    isNewtype = case di of
-        Newtype {} -> True
-        ADT {}     -> False
-
-sopNPToExpr :: All ToExpr xs => Bool -> ConstructorInfo xs -> NP I xs -> Expr
-sopNPToExpr _ (Infix cn _ _) xs = App ("_" ++ cn ++ "_") $ hcollapse $
-    hcmap (Proxy :: Proxy ToExpr) (mapIK toExpr) xs
-sopNPToExpr _ (Constructor cn) xs = App cn $ hcollapse $
-    hcmap (Proxy :: Proxy ToExpr) (mapIK toExpr) xs
-sopNPToExpr True (Record cn _) xs = App cn $ hcollapse $
-    hcmap (Proxy :: Proxy ToExpr) (mapIK toExpr) xs
-sopNPToExpr False (Record cn fi) xs = Rec cn $ Map.fromList $ hcollapse $
-    hcliftA2 (Proxy :: Proxy ToExpr) mk fi xs
-  where
-    mk :: ToExpr x => FieldInfo x -> I x -> K (FieldName, Expr) x
-    mk (FieldInfo fn) (I x) = K (fn, toExpr x)
-
--------------------------------------------------------------------------------
--- Instances
--------------------------------------------------------------------------------
-
-instance ToExpr () where toExpr = defaultExprViaShow
-instance ToExpr Bool where toExpr = defaultExprViaShow
-instance ToExpr Ordering where toExpr = defaultExprViaShow
-
-instance ToExpr Integer where toExpr = defaultExprViaShow
-instance ToExpr Natural where toExpr = defaultExprViaShow
-
-instance ToExpr Float where toExpr = defaultExprViaShow
-instance ToExpr Double where toExpr = defaultExprViaShow
-
-instance ToExpr Int where toExpr = defaultExprViaShow
-instance ToExpr Int8 where toExpr = defaultExprViaShow
-instance ToExpr Int16 where toExpr = defaultExprViaShow
-instance ToExpr Int32 where toExpr = defaultExprViaShow
-instance ToExpr Int64 where toExpr = defaultExprViaShow
-
-instance ToExpr Word where toExpr = defaultExprViaShow
-instance ToExpr Word8 where toExpr = defaultExprViaShow
-instance ToExpr Word16 where toExpr = defaultExprViaShow
-instance ToExpr Word32 where toExpr = defaultExprViaShow
-instance ToExpr Word64 where toExpr = defaultExprViaShow
-
-instance ToExpr (Proxy a) where toExpr = defaultExprViaShow
-
--- | >>> prettyExpr $ toExpr 'a'
--- 'a'
---
--- >>> prettyExpr $ toExpr "Hello world"
--- "Hello world"
---
--- >>> prettyExpr $ toExpr "Hello\nworld"
--- concat ["Hello\n", "world"]
---
--- >>> traverse_ (print . prettyExpr . toExpr) ["", "\n", "foo", "foo\n", "foo\nbar", "foo\nbar\n"]
--- ""
--- "\n"
--- "foo"
--- "foo\n"
--- concat ["foo\n", "bar"]
--- concat ["foo\n", "bar\n"]
---
-instance ToExpr Char where
-    toExpr = defaultExprViaShow
-    listToExpr = stringToExpr "concat" . unconcat uncons
-
-stringToExpr
-    :: Show a
-    => String -- ^ name of concat
-    -> [a]
-    -> Expr
-stringToExpr _  []  = App "\"\"" []
-stringToExpr _  [l] = defaultExprViaShow l
-stringToExpr cn ls  = App cn [Lst (map defaultExprViaShow ls)]
-
--- | Split on '\n'.
---
--- prop> \xs -> xs == concat (unconcat uncons xs)
-unconcat :: forall a. (a -> Maybe (Char, a)) -> a -> [String]
-unconcat uncons_ = go where
-    go :: a -> [String]
-    go xs = case span_ xs of
-        ~(ys, zs)
-            | null ys   -> []
-            | otherwise -> ys : go zs
-
-    span_ :: a -> (String, a)
-    span_ xs = case uncons_ xs of
-        Nothing         -> ("", xs)
-        Just ~(x, xs')
-            | x == '\n' -> ("\n", xs')
-            | otherwise -> case span_ xs' of
-            ~(ys, zs) -> (x : ys, zs)
-
-instance ToExpr a => ToExpr (Maybe a) where
-    toExpr Nothing  = App "Nothing" []
-    toExpr (Just x) = App "Just" [toExpr x]
-
-instance (ToExpr a, ToExpr b) => ToExpr (Either a b) where
-    toExpr (Left x)  = App "Left"  [toExpr x]
-    toExpr (Right y) = App "Right" [toExpr y]
-
-instance ToExpr a => ToExpr [a] where
-    toExpr = listToExpr
-
-instance (ToExpr a, ToExpr b) => ToExpr (a, b) where
-    toExpr (a, b) = App "_×_" [toExpr a, toExpr b]
-instance (ToExpr a, ToExpr b, ToExpr c) => ToExpr (a, b, c) where
-    toExpr (a, b, c) = App "_×_×_" [toExpr a, toExpr b, toExpr c]
-instance (ToExpr a, ToExpr b, ToExpr c, ToExpr d) => ToExpr (a, b, c, d) where
-    toExpr (a, b, c, d) = App "_×_×_×_" [toExpr a, toExpr b, toExpr c, toExpr d]
-instance (ToExpr a, ToExpr b, ToExpr c, ToExpr d, ToExpr e) => ToExpr (a, b, c, d, e) where
-    toExpr (a, b, c, d, e) = App "_×_×_×_×_" [toExpr a, toExpr b, toExpr c, toExpr d, toExpr e]
-
--- | >>> prettyExpr $ toExpr (3 % 12 :: Rational)
--- _%_ 1 4
-instance (ToExpr a, Integral a) => ToExpr (Ratio.Ratio a) where
-    toExpr r = App "_%_" [ toExpr $ Ratio.numerator r, toExpr $ Ratio.denominator r ]
-instance HasResolution a => ToExpr (Fixed a) where toExpr = defaultExprViaShow
-
--- | >>> prettyExpr $ toExpr $ Identity 'a'
--- Identity 'a'
-instance ToExpr a => ToExpr (Identity a) where
-    toExpr (Identity x) = App "Identity" [toExpr x]
-
-instance ToExpr a => ToExpr (Const a b)
-instance ToExpr a => ToExpr (ZipList a)
-
-instance ToExpr a => ToExpr (NonEmpty a) where
-    toExpr (x :| xs) = App "NE.fromList" [toExpr (x : xs)]
-
-instance ToExpr Void where
-    toExpr _ = App "error" [toExpr "Void"]
-
--------------------------------------------------------------------------------
--- Monoid/semigroups
--------------------------------------------------------------------------------
-
-instance ToExpr a => ToExpr (Mon.Dual a) where
-instance ToExpr a => ToExpr (Mon.Sum a) where
-instance ToExpr a => ToExpr (Mon.Product a) where
-instance ToExpr a => ToExpr (Mon.First a) where
-instance ToExpr a => ToExpr (Mon.Last a) where
-
--- instance ToExpr a => ToExpr (Semi.Option a) where
-instance ToExpr a => ToExpr (Semi.Min a) where
-instance ToExpr a => ToExpr (Semi.Max a) where
-instance ToExpr a => ToExpr (Semi.First a) where
-instance ToExpr a => ToExpr (Semi.Last a) where
-
--------------------------------------------------------------------------------
--- containers
--------------------------------------------------------------------------------
-
-instance ToExpr a => ToExpr (Tree.Tree a) where
-    toExpr (Tree.Node x xs) = App "Node" [toExpr x, toExpr xs]
-
-instance (ToExpr k, ToExpr v) => ToExpr (Map.Map k v) where
-    toExpr x = App "Map.fromList" [ toExpr $ Map.toList x ]
-instance (ToExpr k) => ToExpr (Set.Set k) where
-    toExpr x = App "Set.fromList" [ toExpr $ Set.toList x ]
-instance (ToExpr v) => ToExpr (IntMap.IntMap v) where
-    toExpr x = App "IntMap.fromList" [ toExpr $ IntMap.toList x ]
-instance ToExpr IntSet.IntSet where
-    toExpr x = App "IntSet.fromList" [ toExpr $ IntSet.toList x ]
-instance (ToExpr v) => ToExpr (Seq.Seq v) where
-    toExpr x = App "Seq.fromList" [ toExpr $ toList x ]
-
--------------------------------------------------------------------------------
--- text
--------------------------------------------------------------------------------
-
--- | >>> traverse_ (print . prettyExpr . toExpr . LT.pack) ["", "\n", "foo", "foo\n", "foo\nbar", "foo\nbar\n"]
--- ""
--- "\n"
--- "foo"
--- "foo\n"
--- LT.concat ["foo\n", "bar"]
--- LT.concat ["foo\n", "bar\n"]
-instance ToExpr LT.Text where
-    toExpr = stringToExpr "LT.concat" . unconcat LT.uncons
-
--- | >>> traverse_ (print . prettyExpr . toExpr . T.pack) ["", "\n", "foo", "foo\n", "foo\nbar", "foo\nbar\n"]
--- ""
--- "\n"
--- "foo"
--- "foo\n"
--- T.concat ["foo\n", "bar"]
--- T.concat ["foo\n", "bar\n"]
-instance ToExpr T.Text where
-    toExpr = stringToExpr "T.concat" . unconcat T.uncons
-
--------------------------------------------------------------------------------
--- time
--------------------------------------------------------------------------------
-
--- | >>> prettyExpr $ toExpr $ ModifiedJulianDay 58014
--- Day "2017-09-18"
-instance ToExpr Time.Day where
-    toExpr d = App "Day" [ toExpr (show d) ]
-
-instance ToExpr Time.UTCTime where
-    toExpr t = App "UTCTime" [ toExpr (show t) ]
-
--------------------------------------------------------------------------------
--- bytestring
--------------------------------------------------------------------------------
-
--- | >>> traverse_ (print . prettyExpr . toExpr . LBS8.pack) ["", "\n", "foo", "foo\n", "foo\nbar", "foo\nbar\n"]
--- ""
--- "\n"
--- "foo"
--- "foo\n"
--- LBS.concat ["foo\n", "bar"]
--- LBS.concat ["foo\n", "bar\n"]
-instance ToExpr LBS.ByteString where
-    toExpr = stringToExpr "LBS.concat" . bsUnconcat LBS.null LBS.elemIndex LBS.splitAt
-
--- | >>> traverse_ (print . prettyExpr . toExpr . BS8.pack) ["", "\n", "foo", "foo\n", "foo\nbar", "foo\nbar\n"]
--- ""
--- "\n"
--- "foo"
--- "foo\n"
--- BS.concat ["foo\n", "bar"]
--- BS.concat ["foo\n", "bar\n"]
-instance ToExpr BS.ByteString where
-    toExpr = stringToExpr "BS.concat" . bsUnconcat BS.null BS.elemIndex BS.splitAt
-
--- | >>> traverse_ (print . prettyExpr . toExpr . SBS.toShort . BS8.pack) ["", "\n", "foo", "foo\n", "foo\nbar", "foo\nbar\n"]
--- ""
--- "\n"
--- "foo"
--- "foo\n"
--- mconcat ["foo\n", "bar"]
--- mconcat ["foo\n", "bar\n"]
--- instance ToExpr SBS.ShortByteString where
---     toExpr = stringToExpr "mconcat" . bsUnconcat BS.null BS.elemIndex BS.splitAt . SBS.fromShort
-
-bsUnconcat
-    :: forall bs int. Num int
-    => (bs -> Bool)
-    -> (Word8 -> bs -> Maybe int)
-    -> (int -> bs -> (bs, bs))
-    -> bs
-    -> [bs]
-bsUnconcat null_ elemIndex_ splitAt_ = go where
-    go :: bs -> [bs]
-    go bs
-        | null_ bs  = []
-        | otherwise = case elemIndex_ 10 bs of
-            Nothing -> [bs]
-            Just i  -> case splitAt_ (i + 1) bs of
-                (bs0, bs1) -> bs0 : go bs1
-
--------------------------------------------------------------------------------
--- scientific
--------------------------------------------------------------------------------
-
--- | >>> prettyExpr $ toExpr (123.456 :: Scientific)
--- scientific 123456 `-3`
--- instance ToExpr Sci.Scientific where
---     toExpr s = App "scientific" [ toExpr $ Sci.coefficient s, toExpr $ Sci.base10Exponent s ]
-
--------------------------------------------------------------------------------
--- uuid-types
--------------------------------------------------------------------------------
-
--- | >>> prettyExpr $ toExpr UUID.nil
--- UUID "00000000-0000-0000-0000-000000000000"
--- instance ToExpr UUID.UUID where
---     toExpr u = App "UUID" [ toExpr $ UUID.toString u ]
-
--------------------------------------------------------------------------------
--- vector
--------------------------------------------------------------------------------
-
-instance ToExpr a => ToExpr (V.Vector a) where
-    toExpr x = App "V.fromList" [ toExpr $ V.toList x ]
-instance (ToExpr a, VU.Unbox a) => ToExpr (VU.Vector a) where
-    toExpr x = App "VU.fromList" [ toExpr $ VU.toList x ]
-instance (ToExpr a, VS.Storable a) => ToExpr (VS.Vector a) where
-    toExpr x = App "VS.fromList" [ toExpr $ VS.toList x ]
-instance (ToExpr a, VP.Prim a) => ToExpr (VP.Vector a) where
-    toExpr x = App "VP.fromList" [ toExpr $ VP.toList x ]
-
--------------------------------------------------------------------------------
--- tagged
--------------------------------------------------------------------------------
-
--- instance ToExpr a => ToExpr (Tagged t a) where
---     toExpr (Tagged x) = App "Tagged" [ toExpr x ]
-
--------------------------------------------------------------------------------
--- hashable
--------------------------------------------------------------------------------
-
--- instance ToExpr a => ToExpr (Hashed a) where
---     toExpr x = App "hashed" [ toExpr $ unhashed x ]
-
--------------------------------------------------------------------------------
--- unordered-containers
--------------------------------------------------------------------------------
-
--- instance (ToExpr k, ToExpr v) => ToExpr (HM.HashMap k v) where
---     toExpr x = App "HM.fromList" [ toExpr $ HM.toList x ]
--- instance (ToExpr k) => ToExpr (HS.HashSet k) where
---     toExpr x = App "HS.fromList" [ toExpr $ HS.toList x ]
-
--------------------------------------------------------------------------------
--- aeson
--------------------------------------------------------------------------------
-
--- instance ToExpr Aeson.Value
-
--------------------------------------------------------------------------------
--- Doctest
--------------------------------------------------------------------------------
-
--- $setup
--- >>> :set -XDeriveGeneric
--- >>> :set -XDeriveGeneric
--- >>> import Data.Foldable (traverse_)
--- >>> import Data.Ratio ((%))
--- >>> import Data.Time (Day (..))
--- >>> import Data.Scientific (Scientific)
--- >>> import Data.TreeDiff.Pretty
--- >>> import qualified Data.ByteString.Char8 as BS8
--- >>> import qualified Data.ByteString.Lazy.Char8 as LBS8
diff --git a/src/Test/StateMachine/TreeDiff/Expr.hs b/src/Test/StateMachine/TreeDiff/Expr.hs
deleted file mode 100644
--- a/src/Test/StateMachine/TreeDiff/Expr.hs
+++ /dev/null
@@ -1,102 +0,0 @@
--- | This module uses 'Expr' for richer diffs than based on 'Tree'.
-module Test.StateMachine.TreeDiff.Expr (
-    -- * Types
-    Expr (..),
-    ConstructorName,
-    FieldName,
-    EditExpr (..),
-    Edit (..),
-    exprDiff,
-    ) where
-
-import Prelude ()
-import Prelude.Compat
-
-import Data.Map           (Map)
-import Test.StateMachine.TreeDiff.List
-
-import qualified Data.Map        as Map
-import qualified Test.QuickCheck as QC
-
--- | Constructor name is a string
-type ConstructorName = String
---
--- | Record field name is a string too.
-type FieldName       = String
-
--- | A untyped Haskell-like expression.
---
--- Having richer structure than just 'Tree' allows to have richer diffs.
-data Expr
-    = App ConstructorName [Expr]                 -- ^ application
-    | Rec ConstructorName (Map FieldName Expr)   -- ^ record constructor
-    | Lst [Expr]                                 -- ^ list constructor
-  deriving (Eq, Show)
-
-instance QC.Arbitrary Expr where
-    arbitrary = QC.scale (min 25) $ QC.sized arb where
-        arb n | n <= 0 = QC.oneof
-            [ (`App` []) <$> arbName
-            ,  (`Rec` mempty) <$> arbName
-            ]
-        arb n | otherwise = do
-            n' <- QC.choose (0, n `div` 3)
-            QC.oneof
-                [ App <$> arbName <*> QC.liftArbitrary (arb n')
-                , Rec <$> arbName <*> QC.liftArbitrary (arb n')
-                , Lst <$> QC.liftArbitrary (arb n')
-                ]
-
-    shrink (Lst es)   = es
-        ++ [ Lst es'    | es' <- QC.shrink es ]
-    shrink (Rec n fs) = Map.elems fs
-        ++ [ Rec n' fs  | n'  <- QC.shrink n  ]
-        ++ [ Rec n  fs' | fs' <- QC.shrink fs ]
-    shrink (App n es) = es
-        ++ [ App n' es  | n'  <- QC.shrink n  ]
-        ++ [ App n  es' | es' <- QC.shrink es ]
-
-arbName :: QC.Gen String
-arbName = QC.frequency
-    [ (10, QC.liftArbitrary $ QC.elements $ ['a'..'z'] ++ ['0' .. '9'] ++ "+-_:")
-    , (1, show <$> (QC.arbitrary :: QC.Gen String))
-    , (1, QC.arbitrary)
-    , (1, QC.elements ["_×_", "_×_×_", "_×_×_×_"])
-    ]
-
--- | Diff two 'Expr'.
---
--- For examples see 'ediff' in "Data.TreeDiff.Class".
-exprDiff :: Expr -> Expr -> Edit EditExpr
-exprDiff = impl
-  where
-    impl ea eb | ea == eb = Cpy (EditExp ea)
-
-    impl ea@(App a as) eb@(App b bs)
-        | a == b = Cpy $ EditApp a (map recurse (diffBy (==) as bs))
-        | otherwise = Swp (EditExp ea) (EditExp eb)
-    impl ea@(Rec a as) eb@(Rec b bs)
-        | a == b = Cpy $ EditRec a $ Map.unions [inter, onlyA, onlyB]
-        | otherwise = Swp (EditExp ea) (EditExp eb)
-      where
-        inter = Map.intersectionWith exprDiff as bs
-        onlyA = fmap (Del . EditExp) (Map.difference as inter)
-        onlyB = fmap (Ins . EditExp) (Map.difference bs inter)
-    impl (Lst as) (Lst bs) =
-        Cpy $ EditLst (map recurse (diffBy (==) as bs))
-
-    -- If higher level doesn't match, just swap.
-    impl a b = Swp (EditExp a) (EditExp b)
-
-    recurse (Ins x)   = Ins (EditExp x)
-    recurse (Del y)   = Del (EditExp y)
-    recurse (Cpy z)   = Cpy (EditExp z)
-    recurse (Swp x y) = impl x y
-
--- | Type used in the result of 'ediff'.
-data EditExpr
-    = EditApp ConstructorName [Edit EditExpr]
-    | EditRec ConstructorName (Map FieldName (Edit EditExpr))
-    | EditLst [Edit EditExpr]
-    | EditExp Expr  -- ^ unchanged tree
-  deriving Show
diff --git a/src/Test/StateMachine/TreeDiff/List.hs b/src/Test/StateMachine/TreeDiff/List.hs
deleted file mode 100644
--- a/src/Test/StateMachine/TreeDiff/List.hs
+++ /dev/null
@@ -1,63 +0,0 @@
-{-# LANGUAGE ScopedTypeVariables #-}
--- | A list diff.
-module Test.StateMachine.TreeDiff.List (diffBy, Edit (..)) where
-
-import Data.List.Compat (sortOn)
-import qualified Data.MemoTrie as M
-import qualified Data.Vector as V
-
--- | List edit operations
---
--- The 'Swp' constructor is redundant, but it let us spot
--- a recursion point when performing tree diffs.
-data Edit a
-    = Ins a    -- ^ insert
-    | Del a    -- ^ delete
-    | Cpy a    -- ^ copy unchanged
-    | Swp a a  -- ^ swap, i.e. delete + insert
-  deriving Show
-
--- | List difference.
---
--- >>> diffBy (==) "hello" "world"
--- [Swp 'h' 'w',Swp 'e' 'o',Swp 'l' 'r',Cpy 'l',Swp 'o' 'd']
---
--- >>> diffBy (==) "kitten" "sitting"
--- [Swp 'k' 's',Cpy 'i',Cpy 't',Cpy 't',Swp 'e' 'i',Cpy 'n',Ins 'g']
---
--- prop> \xs ys -> length (diffBy (==) xs ys) >= max (length xs) (length (ys :: String))
--- prop> \xs ys -> length (diffBy (==) xs ys) <= length xs + length (ys :: String)
---
--- /Note:/ currently this has O(n*m) memory requirements, for the sake
--- of more obviously correct implementation.
---
-diffBy :: forall a. (a -> a -> Bool) -> [a] -> [a] -> [Edit a]
-diffBy eq xs' ys' = reverse (snd (lcs (V.length xs) (V.length ys)))
-  where
-    xs = V.fromList xs'
-    ys = V.fromList ys'
-
-    lcs = M.memo2 impl
-
-    impl :: Int -> Int -> (Int, [Edit a])
-    impl 0 0 = (0, [])
-    impl 0 m = case lcs 0 (m-1) of
-        (w, edit) -> (w + 1, Ins (ys V.! (m - 1)) : edit)
-    impl n 0 = case lcs (n -1) 0 of
-        (w, edit) -> (w + 1, Del (xs V.! (n - 1)) : edit)
-
-    impl n m = head $ sortOn fst
-        [ edit
-        , bimap (+1) (Ins y :) (lcs n (m - 1))
-        , bimap (+1) (Del x :) (lcs (n - 1) m)
-        ]
-      where
-        x = xs V.! (n - 1)
-        y = ys V.! (m - 1)
-
-        edit
-            | eq x y    = bimap id   (Cpy x :)   (lcs (n - 1) (m - 1))
-            | otherwise = bimap (+1) (Swp x y :) (lcs (n -1 ) (m - 1))
-
-bimap :: (a -> c) -> (b -> d) -> (a, b) -> (c, d)
-bimap f g (x, y) = (f x, g y)
diff --git a/src/Test/StateMachine/TreeDiff/Pretty.hs b/src/Test/StateMachine/TreeDiff/Pretty.hs
deleted file mode 100644
--- a/src/Test/StateMachine/TreeDiff/Pretty.hs
+++ /dev/null
@@ -1,253 +0,0 @@
--- | Utilities to pretty print 'Expr' and 'EditExpr'
-module Test.StateMachine.TreeDiff.Pretty (
-    -- * Explicit dictionary
-    Pretty (..),
-    ppExpr,
-    ppEditExpr,
-    ppEditExprCompact,
-    -- * pretty
-    prettyPretty,
-    prettyExpr,
-    prettyEditExpr,
-    prettyEditExprCompact,
-    -- * ansi-wl-pprint
-    ansiWlPretty,
-    ansiWlExpr,
-    ansiWlEditExpr,
-    ansiWlEditExprCompact,
-    -- ** background
-    ansiWlBgPretty,
-    ansiWlBgExpr,
-    ansiWlBgEditExpr,
-    ansiWlBgEditExprCompact,
-    -- * Utilities
-    escapeName,
-    ) where
-
-import Data.Char          (isAlphaNum, isPunctuation, isSymbol, ord)
-import Data.Either        (partitionEithers)
-import Test.StateMachine.TreeDiff.Expr
-import Numeric            (showHex)
-import Text.Read          (readMaybe)
-
-
-import qualified Data.Map                     as Map
-import qualified Text.PrettyPrint             as HJ
-import qualified Text.PrettyPrint.ANSI.Leijen as WL
-
--- | Because we don't want to commit to single pretty printing library,
--- we use explicit dictionary.
-data Pretty doc = Pretty
-    { ppCon        :: ConstructorName -> doc
-    , ppRec        :: [(FieldName, doc)] -> doc
-    , ppLst        :: [doc] -> doc
-    , ppCpy        :: doc -> doc
-    , ppIns        :: doc -> doc
-    , ppDel        :: doc -> doc
-    , ppSep        :: [doc] -> doc
-    , ppParens     :: doc -> doc
-    , ppHang       :: doc -> doc -> doc
-    }
-
--- | Escape field or constructor name
---
--- >>> putStrLn $ escapeName "Foo"
--- Foo
---
--- >>> putStrLn $ escapeName "_×_"
--- _×_
---
--- >>> putStrLn $ escapeName "-3"
--- `-3`
---
--- >>> putStrLn $ escapeName "kebab-case"
--- kebab-case
---
--- >>> putStrLn $ escapeName "inner space"
--- `inner space`
---
--- >>> putStrLn $ escapeName $ show "looks like a string"
--- "looks like a string"
---
--- >>> putStrLn $ escapeName $ show "tricky" ++ "   "
--- `"tricky"   `
---
--- >>> putStrLn $ escapeName "[]"
--- `[]`
---
--- >>> putStrLn $ escapeName "_,_"
--- `_,_`
---
-escapeName :: String -> String
-escapeName n
-    | null n                      = "``"
-    | isValidString n             = n
-    | all valid' n && headNotMP n = n
-    | otherwise                   = "`" ++ concatMap e n ++ "`"
-  where
-    e '`'               = "\\`"
-    e '\\'              = "\\\\"
-    e ' '               = " "
-    e c | not (valid c) = "\\x" ++ showHex (ord c) ";"
-    e c                 = [c]
-
-    valid c = isAlphaNum c || isSymbol c || isPunctuation c
-    valid' c = valid c && c `notElem` "[](){}`\","
-
-    headNotMP ('-' : _) = False
-    headNotMP ('+' : _) = False
-    headNotMP _         = True
-
-    isValidString s
-        | length s >= 2 && head s == '"' && last s == '"' =
-            case readMaybe s :: Maybe String of
-                Just _ -> True
-                Nothing -> False
-    isValidString _         = False
-
--- | Pretty print an 'Expr' using explicit pretty-printing dictionary.
-ppExpr :: Pretty doc -> Expr -> doc
-ppExpr p = ppExpr' p False
-
-ppExpr' :: Pretty doc -> Bool -> Expr -> doc
-ppExpr' p = impl where
-    impl _ (App x []) = ppCon p (escapeName x)
-    impl b (App x xs) = ppParens' b $ ppHang p (ppCon p (escapeName x)) $
-        ppSep p $ map (impl True) xs
-    impl _ (Rec x xs) = ppHang p (ppCon p (escapeName x)) $ ppRec p $
-        map ppField' $ Map.toList xs
-    impl _ (Lst xs)   = ppLst p (map (impl False) xs)
-
-    ppField' (n, e) = (escapeName n, impl False e)
-
-    ppParens' True  = ppParens p
-    ppParens' False = id
-
--- | Pretty print an @'Edit' 'EditExpr'@ using explicit pretty-printing dictionary.
-ppEditExpr :: Pretty doc -> Edit EditExpr -> doc
-ppEditExpr = ppEditExpr' False
-
--- | Like 'ppEditExpr' but print unchanged parts only shallowly
-ppEditExprCompact :: Pretty doc -> Edit EditExpr -> doc
-ppEditExprCompact = ppEditExpr' True
-
-ppEditExpr' :: Bool -> Pretty doc -> Edit EditExpr -> doc
-ppEditExpr' compact p = ppSep p . ppEdit False
-  where
-    ppEdit b (Cpy (EditExp expr)) = [ ppCpy p $ ppExpr' p b expr ]
-    ppEdit b (Cpy expr) = [ ppEExpr b expr ]
-    ppEdit b (Ins expr) = [ ppIns p (ppEExpr b expr) ]
-    ppEdit b (Del expr) = [ ppDel p (ppEExpr b expr) ]
-    ppEdit b (Swp x y) =
-        [ ppDel p (ppEExpr b x)
-        , ppIns p (ppEExpr b y)
-        ]
-
-    ppEExpr _ (EditApp x []) = ppCon p (escapeName x)
-    ppEExpr b (EditApp x xs) = ppParens' b $ ppHang p (ppCon p (escapeName x)) $
-        ppSep p $ concatMap (ppEdit True) xs
-    ppEExpr _ (EditRec x xs) = ppHang p (ppCon p (escapeName x)) $ ppRec p $
-        justs ++ [ (n, ppCon p "...") | n <- take 1 nothings ]
-      where
-        xs' = map ppField' $ Map.toList xs
-        (nothings, justs) = partitionEithers xs'
-
-    ppEExpr _ (EditLst xs)   = ppLst p (concatMap (ppEdit False) xs)
-    ppEExpr b (EditExp x)    = ppExpr' p b x
-
-    ppField' (n, Cpy (EditExp e)) | compact, not (isScalar e) = Left n
-    ppField' (n, e) = Right (escapeName n, ppSep p $ ppEdit False e)
-
-    ppParens' True  = ppParens p
-    ppParens' False = id
-
-    isScalar (App _ []) = True
-    isScalar _          = False
-
--------------------------------------------------------------------------------
--- pretty
--------------------------------------------------------------------------------
-
--- | 'Pretty' via @pretty@ library.
-prettyPretty :: Pretty HJ.Doc
-prettyPretty = Pretty
-    { ppCon    = HJ.text
-    , ppRec    = HJ.braces . HJ.sep . HJ.punctuate HJ.comma
-               . map (\(fn, d) -> HJ.text fn HJ.<+> HJ.equals HJ.<+> d)
-    , ppLst    = HJ.brackets . HJ.sep . HJ.punctuate HJ.comma
-    , ppCpy    = id
-    , ppIns    = \d -> HJ.char '+' HJ.<> d
-    , ppDel    = \d -> HJ.char '-' HJ.<> d
-    , ppSep    = HJ.sep
-    , ppParens = HJ.parens
-    , ppHang   = \d1 d2 -> HJ.hang d1 2 d2
-    }
-
--- | Pretty print 'Expr' using @pretty@.
---
--- >>> prettyExpr $ Rec "ex" (Map.fromList [("[]", App "bar" [])])
--- ex {`[]` = bar}
-prettyExpr :: Expr -> HJ.Doc
-prettyExpr = ppExpr prettyPretty
-
--- | Pretty print @'Edit' 'EditExpr'@ using @pretty@.
-prettyEditExpr :: Edit EditExpr -> HJ.Doc
-prettyEditExpr = ppEditExpr prettyPretty
-
--- | Compact 'prettyEditExpr'.
-prettyEditExprCompact :: Edit EditExpr -> HJ.Doc
-prettyEditExprCompact = ppEditExprCompact prettyPretty
-
--------------------------------------------------------------------------------
--- ansi-wl-pprint
--------------------------------------------------------------------------------
-
--- | 'Pretty' via @ansi-wl-pprint@ library (with colors).
-ansiWlPretty :: Pretty WL.Doc
-ansiWlPretty = Pretty
-    { ppCon    = WL.text
-    , ppRec    = WL.encloseSep WL.lbrace WL.rbrace WL.comma
-               . map (\(fn, d) -> WL.text fn WL.<+> WL.equals WL.</> d)
-    , ppLst    = WL.list
-    , ppCpy    = WL.dullwhite
-    , ppIns    = \d -> WL.green $ WL.plain $ WL.char '+' WL.<> d
-    , ppDel    = \d -> WL.red   $ WL.plain $ WL.char '-' WL.<> d
-    , ppSep    = WL.sep
-    , ppParens = WL.parens
-    , ppHang   = \d1 d2 -> WL.hang 2 (d1 WL.</> d2)
-    }
-
--- | Pretty print 'Expr' using @ansi-wl-pprint@.
-ansiWlExpr :: Expr -> WL.Doc
-ansiWlExpr = ppExpr ansiWlPretty
-
--- | Pretty print @'Edit' 'EditExpr'@ using @ansi-wl-pprint@.
-ansiWlEditExpr :: Edit EditExpr -> WL.Doc
-ansiWlEditExpr = ppEditExpr ansiWlPretty
-
--- | Compact 'ansiWlEditExpr'
-ansiWlEditExprCompact :: Edit EditExpr -> WL.Doc
-ansiWlEditExprCompact = ppEditExprCompact ansiWlPretty
-
--------------------------------------------------------------------------------
--- Background
--------------------------------------------------------------------------------
-
--- | Like 'ansiWlPretty' but color the background.
-ansiWlBgPretty :: Pretty WL.Doc
-ansiWlBgPretty = ansiWlPretty
-    { ppIns    = \d -> WL.ondullgreen $ WL.white $ WL.plain $ WL.char '+' WL.<> d
-    , ppDel    = \d -> WL.ondullred   $ WL.white $ WL.plain $ WL.char '-' WL.<> d
-    }
-
--- | Pretty print 'Expr' using @ansi-wl-pprint@.
-ansiWlBgExpr :: Expr -> WL.Doc
-ansiWlBgExpr = ppExpr ansiWlBgPretty
-
--- | Pretty print @'Edit' 'EditExpr'@ using @ansi-wl-pprint@.
-ansiWlBgEditExpr :: Edit EditExpr -> WL.Doc
-ansiWlBgEditExpr = ppEditExpr ansiWlBgPretty
-
--- | Compact 'ansiWlBgEditExpr'.
-ansiWlBgEditExprCompact :: Edit EditExpr -> WL.Doc
-ansiWlBgEditExprCompact = ppEditExprCompact ansiWlBgPretty
diff --git a/src/Test/StateMachine/TreeDiff/Tree.hs b/src/Test/StateMachine/TreeDiff/Tree.hs
deleted file mode 100644
--- a/src/Test/StateMachine/TreeDiff/Tree.hs
+++ /dev/null
@@ -1,98 +0,0 @@
-{-# LANGUAGE CPP #-}
--- | Tree diffing working on @containers@ 'Tree'.
-module Test.StateMachine.TreeDiff.Tree (treeDiff, EditTree (..), Edit (..)) where
-
-import Data.Tree          (Tree (..))
-import Test.StateMachine.TreeDiff.List
-
-#ifdef __DOCTEST__
-import qualified Text.PrettyPrint as PP
-#endif
-
--- | A breadth-traversal diff.
---
--- It's different from @gdiff@, as it doesn't produce a flat edit script,
--- but edit script iself is a tree. This makes visualising the diff much
--- simpler.
---
--- ==== Examples
---
--- Let's start from simple tree. We pretty print them as s-expressions.
---
--- >>> let x = Node 'a' [Node 'b' [], Node 'c' [return 'd', return 'e'], Node 'f' []]
--- >>> ppTree PP.char x
--- (a b (c d e) f)
---
--- If we modify an argument in a tree, we'll notice it's changed:
---
--- >>> let y = Node 'a' [Node 'b' [], Node 'c' [return 'x', return 'e'], Node 'f' []]
--- >>> ppTree PP.char y
--- (a b (c x e) f)
---
--- >>> ppEditTree PP.char (treeDiff x y)
--- (a b (c -d +x e) f)
---
--- If we modify a constructor, the whole sub-trees is replaced, though there
--- might be common subtrees.
---
--- >>> let z = Node 'a' [Node 'b' [], Node 'd' [], Node 'f' []]
--- >>> ppTree PP.char z
--- (a b d f)
---
--- >>> ppEditTree PP.char (treeDiff x z)
--- (a b -(c d e) +d f)
---
--- If we add arguments, they are spotted too:
---
--- >>> let w = Node 'a' [Node 'b' [], Node 'c' [return 'd', return 'x', return 'e'], Node 'f' []]
--- >>> ppTree PP.char w
--- (a b (c d x e) f)
---
--- >>> ppEditTree PP.char (treeDiff x w)
--- (a b (c d +x e) f)
---
-treeDiff :: Eq a => Tree a -> Tree a -> Edit (EditTree a)
-treeDiff ta@(Node a as) tb@(Node b bs)
-    | a == b = Cpy $ EditNode a (map rec (diffBy (==) as bs))
-    | otherwise = Swp (treeToEdit ta) (treeToEdit tb)
-  where
-    rec (Ins x)   = Ins (treeToEdit x)
-    rec (Del y)   = Del (treeToEdit y)
-    rec (Cpy z)   = Cpy (treeToEdit z)
-    rec (Swp x y) = treeDiff x y
-
--- | Type used in the result of 'treeDiff'.
---
--- It's essentially a 'Tree', but the forest list is changed from
--- @[tree a]@ to @['Edit' (tree a)]@. This highlights that
--- 'treeDiff' performs a list diff on each tree level.
-data EditTree a
-    = EditNode a [Edit (EditTree a)]
-  deriving Show
-
-treeToEdit :: Tree a -> EditTree a
-treeToEdit = go where go (Node x xs) = EditNode x (map (Cpy . go) xs)
-
-#ifdef __DOCTEST__
-ppTree :: (a -> PP.Doc) -> Tree a -> PP.Doc
-ppTree pp = ppT
-  where
-    ppT (Node x []) = pp x
-    ppT (Node x xs) = PP.parens $ PP.hang (pp x) 2 $
-        PP.sep $ map ppT xs
-
-ppEditTree :: (a -> PP.Doc) -> Edit (EditTree a) -> PP.Doc
-ppEditTree pp = PP.sep . ppEdit
-  where
-    ppEdit (Cpy tree) = [ ppTree tree ]
-    ppEdit (Ins tree) = [ PP.char '+' PP.<> ppTree tree ]
-    ppEdit (Del tree) = [ PP.char '-' PP.<> ppTree tree ]
-    ppEdit (Swp a b) =
-        [ PP.char '-' PP.<> ppTree a
-        , PP.char '+' PP.<> ppTree b
-        ]
-
-    ppTree (EditNode x []) = pp x
-    ppTree (EditNode x xs) = PP.parens $ PP.hang (pp x) 2 $
-       PP.sep $ concatMap ppEdit xs
-#endif
diff --git a/src/Test/StateMachine/Types/References.hs b/src/Test/StateMachine/Types/References.hs
--- a/src/Test/StateMachine/Types/References.hs
+++ b/src/Test/StateMachine/Types/References.hs
@@ -43,15 +43,12 @@
                    (Generic)
 import           Prelude
 
-import           Test.StateMachine.TreeDiff
-                   (Expr(App), ToExpr, toExpr)
 import qualified Test.StateMachine.Types.Rank2 as Rank2
 
 ------------------------------------------------------------------------
 
 newtype Var = Var Int
   deriving stock   (Eq, Ord, Show, Generic, Read)
-  deriving newtype (ToExpr)
 
 data Symbolic a where
   Symbolic :: Typeable a => Var -> Symbolic a
@@ -69,9 +66,6 @@
     where
       appPrec = 10
 
-instance ToExpr a => ToExpr (Symbolic a) where
-  toExpr (Symbolic x) = toExpr x
-
 instance Eq1 Symbolic where
   liftEq _ (Symbolic x) (Symbolic y) = x == y
 
@@ -101,16 +95,11 @@
 instance Ord1 Concrete where
   liftCompare comp (Concrete x) (Concrete y) = comp x y
 
-instance ToExpr a => ToExpr (Concrete a) where
-  toExpr (Concrete x) = toExpr x
-
 newtype Reference a r = Reference (r a)
   deriving stock Generic
 
 deriving stock instance Typeable a => Read (Reference a Symbolic)
 
-instance ToExpr (r a) => ToExpr (Reference a r)
-
 instance Rank2.Functor (Reference a) where
   fmap f (Reference r) = Reference (f r)
 
@@ -148,6 +137,3 @@
 
 instance Show (Opaque a) where
   showsPrec _ (Opaque _) = showString "Opaque"
-
-instance ToExpr (Opaque a) where
-  toExpr _ = App "Opaque" []
diff --git a/test/Bookstore.hs b/test/Bookstore.hs
--- a/test/Bookstore.hs
+++ b/test/Bookstore.hs
@@ -58,6 +58,7 @@
                    throwIO)
 
 import           Test.StateMachine
+import           Test.StateMachine.TreeDiff
 import qualified Test.StateMachine.Types.Rank2      as Rank2
 import           Test.StateMachine.Z
                    (codomain, domain)
@@ -143,12 +144,12 @@
   :: Bug -> String -> Connection -> IO (Maybe [Book])
 findByAuthor bug s = case bug of
   Injection -> handleViolations (select templ $ "%"++s++"%")
-  _          -> handleViolations (select templ $ "%"++(sanitize s)++"%")
+  _         -> handleViolations (select templ $ "%"++(sanitize s)++"%")
   where templ = "SELECT * FROM books WHERE author LIKE ?"
 
 findByTitle bug s = case bug of
   Injection -> handleViolations (select templ $ "%"++s++"%")
-  _          -> handleViolations (select templ $ "%"++(sanitize s)++"%")
+  _         -> handleViolations (select templ $ "%"++(sanitize s)++"%")
   where templ = "SELECT * FROM books WHERE title LIKE ?"
 
 findByIsbn :: String -> Connection -> IO (Maybe [Book])
@@ -347,10 +348,10 @@
 transitions :: Model r -> Command r -> Response r -> Model r
 transitions (Model m) cmd _ = Model $ case cmd of
   NewBook New key t a -> (key, Book (getString key) t a 0 0):m
-  AddCopy Exist key -> map (applyForKey key $ incOwned . incAvail) m
-  Borrow  Avail key -> map (applyForKey key decAvail) m
-  Return  Taken key -> map (applyForKey key incAvail) m
-  _ -> m
+  AddCopy Exist key   -> map (applyForKey key $ incOwned . incAvail) m
+  Borrow  Avail key   -> map (applyForKey key decAvail) m
+  Return  Taken key   -> map (applyForKey key incAvail) m
+  _                   -> m
   where
     applyForKey key fn (k, v) = (k, if k == key then fn v else v)
     incOwned row = row { owned = 1 + owned row }
diff --git a/test/CircularBuffer.hs b/test/CircularBuffer.hs
--- a/test/CircularBuffer.hs
+++ b/test/CircularBuffer.hs
@@ -61,6 +61,7 @@
                    (monadicIO)
 
 import           Test.StateMachine
+import           Test.StateMachine.TreeDiff
 import qualified Test.StateMachine.Types.Rank2 as Rank2
 
 ------------------------------------------------------------------------
diff --git a/test/Cleanup.hs b/test/Cleanup.hs
--- a/test/Cleanup.hs
+++ b/test/Cleanup.hs
@@ -41,7 +41,9 @@
 import           Test.QuickCheck.Monadic
                    (monadicIO)
 import           Test.StateMachine
-import qualified Test.StateMachine.Types as QSM (initModel)
+import           Test.StateMachine.TreeDiff
+import qualified Test.StateMachine.Types       as QSM
+                   (initModel)
 import qualified Test.StateMachine.Types.Rank2 as Rank2
 import           Test.StateMachine.Utils
                    (liftProperty, mkModel, whenFailM)
diff --git a/test/CrudWebserverDb.hs b/test/CrudWebserverDb.hs
--- a/test/CrudWebserverDb.hs
+++ b/test/CrudWebserverDb.hs
@@ -131,7 +131,7 @@
 
 import           Test.StateMachine
 import           Test.StateMachine.TreeDiff
-                   (Expr(App))
+                   (Expr(App), ToExpr(toExpr))
 import qualified Test.StateMachine.Types.Rank2 as Rank2
 
 ------------------------------------------------------------------------
diff --git a/test/DieHard.hs b/test/DieHard.hs
--- a/test/DieHard.hs
+++ b/test/DieHard.hs
@@ -41,6 +41,7 @@
                    (monadicIO)
 
 import           Test.StateMachine
+import           Test.StateMachine.TreeDiff
 import qualified Test.StateMachine.Types.Rank2 as Rank2
 
 ------------------------------------------------------------------------
diff --git a/test/Echo.hs b/test/Echo.hs
--- a/test/Echo.hs
+++ b/test/Echo.hs
@@ -39,7 +39,8 @@
                    (TVar, atomically, newTVarIO, readTVar, writeTVar)
 
 import           Test.StateMachine
-import           Test.StateMachine.Types as QC
+import           Test.StateMachine.TreeDiff
+import           Test.StateMachine.Types       as QC
 import qualified Test.StateMachine.Types.Rank2 as Rank2
 
 ------------------------------------------------------------------------
diff --git a/test/ErrorEncountered.hs b/test/ErrorEncountered.hs
--- a/test/ErrorEncountered.hs
+++ b/test/ErrorEncountered.hs
@@ -26,6 +26,7 @@
                    (monadicIO)
 
 import           Test.StateMachine
+import           Test.StateMachine.TreeDiff
 import qualified Test.StateMachine.Types.Rank2 as Rank2
 import           Test.StateMachine.Z
 
diff --git a/test/Hanoi.hs b/test/Hanoi.hs
--- a/test/Hanoi.hs
+++ b/test/Hanoi.hs
@@ -42,6 +42,7 @@
                    (monadicIO)
 
 import           Test.StateMachine
+import           Test.StateMachine.TreeDiff
 import           Test.StateMachine.TreeDiff.Expr
                    ()
 import qualified Test.StateMachine.Types.Rank2   as Rank2
diff --git a/test/IORefs.hs b/test/IORefs.hs
--- a/test/IORefs.hs
+++ b/test/IORefs.hs
@@ -29,6 +29,7 @@
 import qualified Data.Map.Strict                   as Map
 
 import           Test.StateMachine.Lockstep.Simple
+import           Test.StateMachine.TreeDiff
 
 {-------------------------------------------------------------------------------
   Instantiate the simple API
diff --git a/test/MemoryReference.hs b/test/MemoryReference.hs
--- a/test/MemoryReference.hs
+++ b/test/MemoryReference.hs
@@ -38,8 +38,8 @@
 import           System.Random
                    (randomIO, randomRIO)
 import           Test.QuickCheck
-                   (Gen, Property, arbitrary, elements, frequency,
-                   once, shrink, (===))
+                   (Gen, Property, arbitrary, elements, frequency, once,
+                   shrink, (===))
 import           Test.QuickCheck.Monadic
                    (monadicIO)
 
@@ -50,14 +50,15 @@
                    shrinkNParallelCommands, shrinkParallelCommands)
 import           Test.StateMachine.Sequential
                    (ShouldShrink(..))
+import           Test.StateMachine.TreeDiff
+import qualified Test.StateMachine.Types       as Types
 import           Test.StateMachine.Types
                    (Commands(Commands), Reference(..), Symbolic(..),
                    Var(Var))
-import qualified Test.StateMachine.Types       as Types
 import qualified Test.StateMachine.Types.Rank2 as Rank2
 import           Test.StateMachine.Utils
-                   (Shrunk(..), shrinkListS, shrinkListS'',
-                   shrinkPairS, shrinkPairS')
+                   (Shrunk(..), shrinkListS, shrinkListS'', shrinkPairS,
+                   shrinkPairS')
 import           Test.StateMachine.Z
 
 ------------------------------------------------------------------------
diff --git a/test/Mock.hs b/test/Mock.hs
--- a/test/Mock.hs
+++ b/test/Mock.hs
@@ -27,6 +27,7 @@
                    (monadicIO)
 import           Test.StateMachine
 import           Test.StateMachine.DotDrawing
+import           Test.StateMachine.TreeDiff
 import qualified Test.StateMachine.Types.Rank2 as Rank2
 
 ------------------------------------------------------------------------
diff --git a/test/Overflow.hs b/test/Overflow.hs
--- a/test/Overflow.hs
+++ b/test/Overflow.hs
@@ -32,6 +32,7 @@
                    (monadicIO)
 import           Test.StateMachine
 import           Test.StateMachine.DotDrawing
+import           Test.StateMachine.TreeDiff
 import qualified Test.StateMachine.Types.Rank2 as Rank2
 
 ------------------------------------------------------------------------
diff --git a/test/ProcessRegistry.hs b/test/ProcessRegistry.hs
--- a/test/ProcessRegistry.hs
+++ b/test/ProcessRegistry.hs
@@ -80,6 +80,7 @@
 
 import           Test.StateMachine
 import           Test.StateMachine.Labelling
+import           Test.StateMachine.TreeDiff
 import qualified Test.StateMachine.Types.Rank2 as Rank2
 
 
diff --git a/test/SQLite.hs b/test/SQLite.hs
--- a/test/SQLite.hs
+++ b/test/SQLite.hs
@@ -34,7 +34,7 @@
 import           Control.Monad.Reader
 import           Data.Bifoldable
 import           Data.Bifunctor
-import qualified Data.Bifunctor.TH               as TH
+import qualified Data.Bifunctor.TH             as TH
 import           Data.Bitraversable
 import           Data.Functor.Classes
 import           Data.Kind
@@ -46,8 +46,7 @@
                    (Text, pack)
 import           Database.Persist
 import           Database.Persist.Sqlite
-import           Database.Sqlite                 hiding
-                   (step)
+import           Database.Sqlite
 import           GHC.Generics
                    (Generic, Generic1)
 import           Prelude
@@ -56,9 +55,9 @@
 import           Test.QuickCheck.Monadic
 import           Test.StateMachine
 import           Test.StateMachine.DotDrawing
-import           Test.StateMachine.TreeDiff.Expr
+import           Test.StateMachine.TreeDiff
 import           Test.StateMachine.Types
-import qualified Test.StateMachine.Types.Rank2   as Rank2
+import qualified Test.StateMachine.Types.Rank2 as Rank2
 
 import           Schema
 
@@ -161,7 +160,7 @@
     , eventMockResp = mockResp
     }
   where
-    (mockResp, dbModel') = step model cmd
+    (mockResp, dbModel') = stepModel model cmd
     newPerson = zip (getPers $ unAt resp) (getPers mockResp)
     newCars = zip (getCars $ unAt resp) (getCars mockResp)
 
@@ -196,10 +195,10 @@
 canInsertC :: Car -> [Car] -> Bool
 canInsertC c cs = carCid c `notElem` (carCid <$> cs)
 
-step :: Model r
-     -> At Cmd r
-     -> (Resp Int Int, DBModel)
-step Model{..} =  runPure dbModel
+stepModel :: Model r
+          -> At Cmd r
+          -> (Resp Int Int, DBModel)
+stepModel Model{..} =  runPure dbModel
 
 runPure :: DBModel -> At Cmd r -> (Resp Int Int, DBModel)
 runPure dbModel@DBModel{..} cmd  = case unAt cmd of
@@ -220,7 +219,7 @@
 mockImpl :: Model Symbolic -> At Cmd Symbolic -> GenSym (At Resp Symbolic)
 mockImpl model cmdErr = At <$> bitraverse (const genSym) (const genSym) mockResp
     where
-        (mockResp, _model') = step model cmdErr
+        (mockResp, _model') = stepModel model cmdErr
 
 shrinkerImpl :: Model Symbolic -> At Cmd Symbolic -> [At Cmd Symbolic]
 shrinkerImpl _ _ = []
@@ -458,9 +457,14 @@
 
 createSqliteAsyncQueue :: (MonadLoggerIO m, MonadUnliftIO m)
                        => Text -> m (AsyncQueue SqlBackend)
-createSqliteAsyncQueue str = do
+createSqliteAsyncQueue str0 = do
     logFunc <- askLoggerIO
-    liftIO $ asyncQueueBound 1000 $ open' str logFunc
+    liftIO $ asyncQueueBound 1000 $ openWrap str0 logFunc
+  where
+    openWrap :: Text -> LogFunc -> IO SqlBackend
+    openWrap str logFunc = do
+        conn <- open str
+        wrapConnection conn logFunc `onException` close conn
 
 createSqliteAsyncPool :: (MonadLoggerIO m, MonadUnliftIO m)
     => Text -> Int -> m (AsyncWithPool SqlBackend)
@@ -468,11 +472,6 @@
     q <- createSqliteAsyncQueue str
     p <- createSqlitePool str n
     return $ mkAsyncWithPool q p
-
-open' :: Text -> LogFunc -> IO SqlBackend
-open' str logFunc = do
-    conn <- open str
-    wrapConnection conn logFunc `onException` close conn
 
 runSqlAsyncWrite :: MonadUnliftIO m => ReaderT SqlBackend m a -> AsyncWithPool SqlBackend -> m a
 runSqlAsyncWrite r a = runSqlAsyncQueue r (queue a)
diff --git a/test/ShrinkingProps.hs b/test/ShrinkingProps.hs
--- a/test/ShrinkingProps.hs
+++ b/test/ShrinkingProps.hs
@@ -66,7 +66,6 @@
 import qualified Test.StateMachine.Parallel    as QSM
 import qualified Test.StateMachine.Sequential  as QSM
 import           Test.StateMachine.TreeDiff
-                   (defaultExprViaShow)
 import qualified Test.StateMachine.Types       as QSM
 import qualified Test.StateMachine.Types.Rank2 as Rank2
 import           Test.StateMachine.Utils
diff --git a/test/TicketDispenser.hs b/test/TicketDispenser.hs
--- a/test/TicketDispenser.hs
+++ b/test/TicketDispenser.hs
@@ -62,6 +62,7 @@
                    (PropertyM, monadicIO)
 
 import           Test.StateMachine
+import           Test.StateMachine.TreeDiff
 import qualified Test.StateMachine.Types.Rank2 as Rank2
 
 ------------------------------------------------------------------------
diff --git a/test/UnionFind.hs b/test/UnionFind.hs
--- a/test/UnionFind.hs
+++ b/test/UnionFind.hs
@@ -40,6 +40,7 @@
                    (monadicIO)
 
 import           Test.StateMachine
+import           Test.StateMachine.TreeDiff
 import qualified Test.StateMachine.Types.Rank2      as Rank2
 import           Test.StateMachine.Types.References
 import           Test.StateMachine.Z
diff --git a/tree-diff/Test/StateMachine/TreeDiff.hs b/tree-diff/Test/StateMachine/TreeDiff.hs
new file mode 100644
--- /dev/null
+++ b/tree-diff/Test/StateMachine/TreeDiff.hs
@@ -0,0 +1,23 @@
+-- | Diffing of (expression) trees.
+--
+-- Diffing arbitrary Haskell data. First we convert values to untyped
+-- haskell-like expression 'Expr' using generically derivable 'ToExpr' class.
+-- Then we can diff two 'Expr' values.
+-- The conversion and diffing is done by 'ediff' function.
+-- See type and function haddocks for an examples.
+--
+-- Interesting modules:
+--
+-- * "Data.TreeDiff.Class" for a 'ToExpr' class and 'ediff' utility.
+--
+module Test.StateMachine.TreeDiff (
+    module Test.StateMachine.TreeDiff.Expr,
+    module Test.StateMachine.TreeDiff.Class,
+    module Test.StateMachine.TreeDiff.Pretty,
+    ) where
+
+import           Test.StateMachine.TreeDiff.Class
+import           Test.StateMachine.TreeDiff.Diffing
+                   ()
+import           Test.StateMachine.TreeDiff.Expr
+import           Test.StateMachine.TreeDiff.Pretty
diff --git a/tree-diff/Test/StateMachine/TreeDiff/Class.hs b/tree-diff/Test/StateMachine/TreeDiff/Class.hs
new file mode 100644
--- /dev/null
+++ b/tree-diff/Test/StateMachine/TreeDiff/Class.hs
@@ -0,0 +1,491 @@
+{-# LANGUAGE ConstraintKinds     #-}
+{-# LANGUAGE DefaultSignatures   #-}
+{-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE GADTs               #-}
+{-# LANGUAGE RankNTypes          #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+-- | A 'ToExpr' class.
+module Test.StateMachine.TreeDiff.Class (
+    ediff,
+    ediff',
+    ToExpr (..),
+    defaultExprViaShow,
+    -- * SOP
+    sopToExpr,
+    ) where
+
+import           Data.Foldable
+                   (toList)
+import           Data.List.Compat
+                   (uncons)
+import           Data.Proxy
+                   (Proxy(..))
+import           Generics.SOP
+                   (All, All2, ConstructorInfo(..), DatatypeInfo(..),
+                   FieldInfo(..), I(..), K(..), NP(..), SOP(..),
+                   constructorInfo, hcliftA2, hcmap, hcollapse, mapIK)
+import           Generics.SOP.GGP
+                   (GCode, GDatatypeInfo, GFrom, gdatatypeInfo, gfrom)
+import           GHC.Generics
+                   (Generic)
+import           Test.StateMachine.TreeDiff.Expr
+
+import qualified Data.Map                        as Map
+
+-- Instances
+import           Control.Applicative
+                   (Const(..), ZipList(..))
+import           Data.Fixed
+                   (Fixed, HasResolution)
+import           Data.Functor.Identity
+                   (Identity(..))
+import           Data.Int
+import           Data.List.NonEmpty
+                   (NonEmpty(..))
+import           Data.Void
+                   (Void)
+import           Data.Word
+import           Numeric.Natural
+                   (Natural)
+
+import qualified Data.Monoid                     as Mon
+import qualified Data.Ratio                      as Ratio
+import qualified Data.Semigroup                  as Semi
+
+-- containers
+import qualified Data.IntMap                     as IntMap
+import qualified Data.IntSet                     as IntSet
+import qualified Data.Sequence                   as Seq
+import qualified Data.Set                        as Set
+import qualified Data.Tree                       as Tree
+
+-- text
+import qualified Data.Text                       as T
+import qualified Data.Text.Lazy                  as LT
+
+-- time
+import qualified Data.Time                       as Time
+
+-- bytestring
+import qualified Data.ByteString                 as BS
+import qualified Data.ByteString.Lazy            as LBS
+-- import qualified Data.ByteString.Short as SBS
+
+-- scientific
+-- import qualified Data.Scientific as Sci
+
+-- uuid-types
+-- import qualified Data.UUID.Types as UUID
+
+-- vector
+import qualified Data.Vector                     as V
+import qualified Data.Vector.Primitive           as VP
+import qualified Data.Vector.Storable            as VS
+import qualified Data.Vector.Unboxed             as VU
+
+-- tagged
+-- import Data.Tagged (Tagged (..))
+
+-- hashable
+-- import Data.Hashable (Hashed, unhashed)
+
+-- unordered-containers
+-- import qualified Data.HashMap.Strict as HM
+-- import qualified Data.HashSet        as HS
+
+-- aeson
+-- import qualified Data.Aeson as Aeson
+
+-- | Difference between two 'ToExpr' values.
+--
+-- >>> let x = (1, Just 2) :: (Int, Maybe Int)
+-- >>> let y = (1, Nothing)
+-- >>> prettyEditExpr (ediff x y)
+-- _×_ 1 -(Just 2) +Nothing
+--
+-- >>> data Foo = Foo { fooInt :: Either Char Int, fooBool :: [Maybe Bool], fooString :: String } deriving (Eq, Generic)
+-- >>> instance ToExpr Foo
+--
+-- >>> prettyEditExpr $ ediff (Foo (Right 2) [Just True] "fo") (Foo (Right 3) [Just True] "fo")
+-- Foo {fooBool = [Just True], fooInt = Right -2 +3, fooString = "fo"}
+--
+-- >>> prettyEditExpr $ ediff (Foo (Right 42) [Just True, Just False] "old") (Foo (Right 42) [Nothing, Just False, Just True] "new")
+-- Foo
+--   {fooBool = [-Just True, +Nothing, Just False, +Just True],
+--    fooInt = Right 42,
+--    fooString = -"old" +"new"}
+--
+ediff :: ToExpr a => a -> a -> Edit EditExpr
+ediff x y = exprDiff (toExpr x) (toExpr y)
+
+-- | Compare different types.
+--
+-- /Note:/ Use with care as you can end up comparing apples with oranges.
+--
+-- >>> prettyEditExpr $ ediff' ["foo", "bar"] [Just "foo", Nothing]
+-- [-"foo", +Just "foo", -"bar", +Nothing]
+--
+ediff' :: (ToExpr a, ToExpr b) => a -> b -> Edit EditExpr
+ediff' x y = exprDiff (toExpr x) (toExpr y)
+
+-- | 'toExpr' converts a Haskell value into
+-- untyped Haskell-like syntax tree, 'Expr'.
+--
+-- >>> toExpr ((1, Just 2) :: (Int, Maybe Int))
+-- App "_\215_" [App "1" [],App "Just" [App "2" []]]
+--
+class ToExpr a where
+    toExpr :: a -> Expr
+    default toExpr
+        :: (Generic a, All2 ToExpr (GCode a), GFrom a, GDatatypeInfo a)
+        => a -> Expr
+    toExpr x = sopToExpr (gdatatypeInfo (Proxy :: Proxy a)) (gfrom x)
+
+    listToExpr :: [a] -> Expr
+    listToExpr = Lst . map toExpr
+
+instance ToExpr Expr where
+    toExpr = id
+
+-- | An alternative implementation for literal types. We use 'show'
+-- representation of them.
+defaultExprViaShow :: Show a => a -> Expr
+defaultExprViaShow x = App (show x) []
+
+-- | >>> prettyExpr $ sopToExpr (gdatatypeInfo (Proxy :: Proxy String)) (gfrom "foo")
+-- _:_ 'f' "oo"
+sopToExpr :: (All2 ToExpr xss) => DatatypeInfo xss -> SOP I xss -> Expr
+sopToExpr di (SOP xss) = hcollapse $ hcliftA2
+    (Proxy :: Proxy (All ToExpr))
+    (\ci xs -> K (sopNPToExpr isNewtype ci xs))
+    (constructorInfo di)
+    xss
+  where
+    isNewtype = case di of
+        Newtype {} -> True
+        ADT {}     -> False
+
+sopNPToExpr :: All ToExpr xs => Bool -> ConstructorInfo xs -> NP I xs -> Expr
+sopNPToExpr _ (Infix cn _ _) xs = App ("_" ++ cn ++ "_") $ hcollapse $
+    hcmap (Proxy :: Proxy ToExpr) (mapIK toExpr) xs
+sopNPToExpr _ (Constructor cn) xs = App cn $ hcollapse $
+    hcmap (Proxy :: Proxy ToExpr) (mapIK toExpr) xs
+sopNPToExpr True (Record cn _) xs = App cn $ hcollapse $
+    hcmap (Proxy :: Proxy ToExpr) (mapIK toExpr) xs
+sopNPToExpr False (Record cn fi) xs = Rec cn $ Map.fromList $ hcollapse $
+    hcliftA2 (Proxy :: Proxy ToExpr) mk fi xs
+  where
+    mk :: ToExpr x => FieldInfo x -> I x -> K (FieldName, Expr) x
+    mk (FieldInfo fn) (I x) = K (fn, toExpr x)
+
+-------------------------------------------------------------------------------
+-- Instances
+-------------------------------------------------------------------------------
+
+instance ToExpr () where toExpr = defaultExprViaShow
+instance ToExpr Bool where toExpr = defaultExprViaShow
+instance ToExpr Ordering where toExpr = defaultExprViaShow
+
+instance ToExpr Integer where toExpr = defaultExprViaShow
+instance ToExpr Natural where toExpr = defaultExprViaShow
+
+instance ToExpr Float where toExpr = defaultExprViaShow
+instance ToExpr Double where toExpr = defaultExprViaShow
+
+instance ToExpr Int where toExpr = defaultExprViaShow
+instance ToExpr Int8 where toExpr = defaultExprViaShow
+instance ToExpr Int16 where toExpr = defaultExprViaShow
+instance ToExpr Int32 where toExpr = defaultExprViaShow
+instance ToExpr Int64 where toExpr = defaultExprViaShow
+
+instance ToExpr Word where toExpr = defaultExprViaShow
+instance ToExpr Word8 where toExpr = defaultExprViaShow
+instance ToExpr Word16 where toExpr = defaultExprViaShow
+instance ToExpr Word32 where toExpr = defaultExprViaShow
+instance ToExpr Word64 where toExpr = defaultExprViaShow
+
+instance ToExpr (Proxy a) where toExpr = defaultExprViaShow
+
+-- | >>> prettyExpr $ toExpr 'a'
+-- 'a'
+--
+-- >>> prettyExpr $ toExpr "Hello world"
+-- "Hello world"
+--
+-- >>> prettyExpr $ toExpr "Hello\nworld"
+-- concat ["Hello\n", "world"]
+--
+-- >>> traverse_ (print . prettyExpr . toExpr) ["", "\n", "foo", "foo\n", "foo\nbar", "foo\nbar\n"]
+-- ""
+-- "\n"
+-- "foo"
+-- "foo\n"
+-- concat ["foo\n", "bar"]
+-- concat ["foo\n", "bar\n"]
+--
+instance ToExpr Char where
+    toExpr = defaultExprViaShow
+    listToExpr = stringToExpr "concat" . unconcat uncons
+
+stringToExpr
+    :: Show a
+    => String -- ^ name of concat
+    -> [a]
+    -> Expr
+stringToExpr _  []  = App "\"\"" []
+stringToExpr _  [l] = defaultExprViaShow l
+stringToExpr cn ls  = App cn [Lst (map defaultExprViaShow ls)]
+
+-- | Split on '\n'.
+--
+-- prop> \xs -> xs == concat (unconcat uncons xs)
+unconcat :: forall a. (a -> Maybe (Char, a)) -> a -> [String]
+unconcat uncons_ = go where
+    go :: a -> [String]
+    go xs = case span_ xs of
+        ~(ys, zs)
+            | null ys   -> []
+            | otherwise -> ys : go zs
+
+    span_ :: a -> (String, a)
+    span_ xs = case uncons_ xs of
+        Nothing         -> ("", xs)
+        Just ~(x, xs')
+            | x == '\n' -> ("\n", xs')
+            | otherwise -> case span_ xs' of
+            ~(ys, zs) -> (x : ys, zs)
+
+instance ToExpr a => ToExpr (Maybe a) where
+    toExpr Nothing  = App "Nothing" []
+    toExpr (Just x) = App "Just" [toExpr x]
+
+instance (ToExpr a, ToExpr b) => ToExpr (Either a b) where
+    toExpr (Left x)  = App "Left"  [toExpr x]
+    toExpr (Right y) = App "Right" [toExpr y]
+
+instance ToExpr a => ToExpr [a] where
+    toExpr = listToExpr
+
+instance (ToExpr a, ToExpr b) => ToExpr (a, b) where
+    toExpr (a, b) = App "_×_" [toExpr a, toExpr b]
+instance (ToExpr a, ToExpr b, ToExpr c) => ToExpr (a, b, c) where
+    toExpr (a, b, c) = App "_×_×_" [toExpr a, toExpr b, toExpr c]
+instance (ToExpr a, ToExpr b, ToExpr c, ToExpr d) => ToExpr (a, b, c, d) where
+    toExpr (a, b, c, d) = App "_×_×_×_" [toExpr a, toExpr b, toExpr c, toExpr d]
+instance (ToExpr a, ToExpr b, ToExpr c, ToExpr d, ToExpr e) => ToExpr (a, b, c, d, e) where
+    toExpr (a, b, c, d, e) = App "_×_×_×_×_" [toExpr a, toExpr b, toExpr c, toExpr d, toExpr e]
+
+-- | >>> prettyExpr $ toExpr (3 % 12 :: Rational)
+-- _%_ 1 4
+instance (ToExpr a, Integral a) => ToExpr (Ratio.Ratio a) where
+    toExpr r = App "_%_" [ toExpr $ Ratio.numerator r, toExpr $ Ratio.denominator r ]
+instance HasResolution a => ToExpr (Fixed a) where toExpr = defaultExprViaShow
+
+-- | >>> prettyExpr $ toExpr $ Identity 'a'
+-- Identity 'a'
+instance ToExpr a => ToExpr (Identity a) where
+    toExpr (Identity x) = App "Identity" [toExpr x]
+
+instance ToExpr a => ToExpr (Const a b)
+instance ToExpr a => ToExpr (ZipList a)
+
+instance ToExpr a => ToExpr (NonEmpty a) where
+    toExpr (x :| xs) = App "NE.fromList" [toExpr (x : xs)]
+
+instance ToExpr Void where
+    toExpr _ = App "error" [toExpr "Void"]
+
+-------------------------------------------------------------------------------
+-- Monoid/semigroups
+-------------------------------------------------------------------------------
+
+instance ToExpr a => ToExpr (Mon.Dual a) where
+instance ToExpr a => ToExpr (Mon.Sum a) where
+instance ToExpr a => ToExpr (Mon.Product a) where
+instance ToExpr a => ToExpr (Mon.First a) where
+instance ToExpr a => ToExpr (Mon.Last a) where
+
+-- instance ToExpr a => ToExpr (Semi.Option a) where
+instance ToExpr a => ToExpr (Semi.Min a) where
+instance ToExpr a => ToExpr (Semi.Max a) where
+instance ToExpr a => ToExpr (Semi.First a) where
+instance ToExpr a => ToExpr (Semi.Last a) where
+
+-------------------------------------------------------------------------------
+-- containers
+-------------------------------------------------------------------------------
+
+instance ToExpr a => ToExpr (Tree.Tree a) where
+    toExpr (Tree.Node x xs) = App "Node" [toExpr x, toExpr xs]
+
+instance (ToExpr k, ToExpr v) => ToExpr (Map.Map k v) where
+    toExpr x = App "Map.fromList" [ toExpr $ Map.toList x ]
+instance (ToExpr k) => ToExpr (Set.Set k) where
+    toExpr x = App "Set.fromList" [ toExpr $ Set.toList x ]
+instance (ToExpr v) => ToExpr (IntMap.IntMap v) where
+    toExpr x = App "IntMap.fromList" [ toExpr $ IntMap.toList x ]
+instance ToExpr IntSet.IntSet where
+    toExpr x = App "IntSet.fromList" [ toExpr $ IntSet.toList x ]
+instance (ToExpr v) => ToExpr (Seq.Seq v) where
+    toExpr x = App "Seq.fromList" [ toExpr $ toList x ]
+
+-------------------------------------------------------------------------------
+-- text
+-------------------------------------------------------------------------------
+
+-- | >>> traverse_ (print . prettyExpr . toExpr . LT.pack) ["", "\n", "foo", "foo\n", "foo\nbar", "foo\nbar\n"]
+-- ""
+-- "\n"
+-- "foo"
+-- "foo\n"
+-- LT.concat ["foo\n", "bar"]
+-- LT.concat ["foo\n", "bar\n"]
+instance ToExpr LT.Text where
+    toExpr = stringToExpr "LT.concat" . unconcat LT.uncons
+
+-- | >>> traverse_ (print . prettyExpr . toExpr . T.pack) ["", "\n", "foo", "foo\n", "foo\nbar", "foo\nbar\n"]
+-- ""
+-- "\n"
+-- "foo"
+-- "foo\n"
+-- T.concat ["foo\n", "bar"]
+-- T.concat ["foo\n", "bar\n"]
+instance ToExpr T.Text where
+    toExpr = stringToExpr "T.concat" . unconcat T.uncons
+
+-------------------------------------------------------------------------------
+-- time
+-------------------------------------------------------------------------------
+
+-- | >>> prettyExpr $ toExpr $ ModifiedJulianDay 58014
+-- Day "2017-09-18"
+instance ToExpr Time.Day where
+    toExpr d = App "Day" [ toExpr (show d) ]
+
+instance ToExpr Time.UTCTime where
+    toExpr t = App "UTCTime" [ toExpr (show t) ]
+
+-------------------------------------------------------------------------------
+-- bytestring
+-------------------------------------------------------------------------------
+
+-- | >>> traverse_ (print . prettyExpr . toExpr . LBS8.pack) ["", "\n", "foo", "foo\n", "foo\nbar", "foo\nbar\n"]
+-- ""
+-- "\n"
+-- "foo"
+-- "foo\n"
+-- LBS.concat ["foo\n", "bar"]
+-- LBS.concat ["foo\n", "bar\n"]
+instance ToExpr LBS.ByteString where
+    toExpr = stringToExpr "LBS.concat" . bsUnconcat LBS.null LBS.elemIndex LBS.splitAt
+
+-- | >>> traverse_ (print . prettyExpr . toExpr . BS8.pack) ["", "\n", "foo", "foo\n", "foo\nbar", "foo\nbar\n"]
+-- ""
+-- "\n"
+-- "foo"
+-- "foo\n"
+-- BS.concat ["foo\n", "bar"]
+-- BS.concat ["foo\n", "bar\n"]
+instance ToExpr BS.ByteString where
+    toExpr = stringToExpr "BS.concat" . bsUnconcat BS.null BS.elemIndex BS.splitAt
+
+-- | >>> traverse_ (print . prettyExpr . toExpr . SBS.toShort . BS8.pack) ["", "\n", "foo", "foo\n", "foo\nbar", "foo\nbar\n"]
+-- ""
+-- "\n"
+-- "foo"
+-- "foo\n"
+-- mconcat ["foo\n", "bar"]
+-- mconcat ["foo\n", "bar\n"]
+-- instance ToExpr SBS.ShortByteString where
+--     toExpr = stringToExpr "mconcat" . bsUnconcat BS.null BS.elemIndex BS.splitAt . SBS.fromShort
+
+bsUnconcat
+    :: forall bs int. Num int
+    => (bs -> Bool)
+    -> (Word8 -> bs -> Maybe int)
+    -> (int -> bs -> (bs, bs))
+    -> bs
+    -> [bs]
+bsUnconcat null_ elemIndex_ splitAt_ = go where
+    go :: bs -> [bs]
+    go bs
+        | null_ bs  = []
+        | otherwise = case elemIndex_ 10 bs of
+            Nothing -> [bs]
+            Just i  -> case splitAt_ (i + 1) bs of
+                (bs0, bs1) -> bs0 : go bs1
+
+-------------------------------------------------------------------------------
+-- scientific
+-------------------------------------------------------------------------------
+
+-- | >>> prettyExpr $ toExpr (123.456 :: Scientific)
+-- scientific 123456 `-3`
+-- instance ToExpr Sci.Scientific where
+--     toExpr s = App "scientific" [ toExpr $ Sci.coefficient s, toExpr $ Sci.base10Exponent s ]
+
+-------------------------------------------------------------------------------
+-- uuid-types
+-------------------------------------------------------------------------------
+
+-- | >>> prettyExpr $ toExpr UUID.nil
+-- UUID "00000000-0000-0000-0000-000000000000"
+-- instance ToExpr UUID.UUID where
+--     toExpr u = App "UUID" [ toExpr $ UUID.toString u ]
+
+-------------------------------------------------------------------------------
+-- vector
+-------------------------------------------------------------------------------
+
+instance ToExpr a => ToExpr (V.Vector a) where
+    toExpr x = App "V.fromList" [ toExpr $ V.toList x ]
+instance (ToExpr a, VU.Unbox a) => ToExpr (VU.Vector a) where
+    toExpr x = App "VU.fromList" [ toExpr $ VU.toList x ]
+instance (ToExpr a, VS.Storable a) => ToExpr (VS.Vector a) where
+    toExpr x = App "VS.fromList" [ toExpr $ VS.toList x ]
+instance (ToExpr a, VP.Prim a) => ToExpr (VP.Vector a) where
+    toExpr x = App "VP.fromList" [ toExpr $ VP.toList x ]
+
+-------------------------------------------------------------------------------
+-- tagged
+-------------------------------------------------------------------------------
+
+-- instance ToExpr a => ToExpr (Tagged t a) where
+--     toExpr (Tagged x) = App "Tagged" [ toExpr x ]
+
+-------------------------------------------------------------------------------
+-- hashable
+-------------------------------------------------------------------------------
+
+-- instance ToExpr a => ToExpr (Hashed a) where
+--     toExpr x = App "hashed" [ toExpr $ unhashed x ]
+
+-------------------------------------------------------------------------------
+-- unordered-containers
+-------------------------------------------------------------------------------
+
+-- instance (ToExpr k, ToExpr v) => ToExpr (HM.HashMap k v) where
+--     toExpr x = App "HM.fromList" [ toExpr $ HM.toList x ]
+-- instance (ToExpr k) => ToExpr (HS.HashSet k) where
+--     toExpr x = App "HS.fromList" [ toExpr $ HS.toList x ]
+
+-------------------------------------------------------------------------------
+-- aeson
+-------------------------------------------------------------------------------
+
+-- instance ToExpr Aeson.Value
+
+-------------------------------------------------------------------------------
+-- Doctest
+-------------------------------------------------------------------------------
+
+-- $setup
+-- >>> :set -XDeriveGeneric
+-- >>> :set -XDeriveGeneric
+-- >>> import Data.Foldable (traverse_)
+-- >>> import Data.Ratio ((%))
+-- >>> import Data.Time (Day (..))
+-- >>> import Data.Scientific (Scientific)
+-- >>> import Data.TreeDiff.Pretty
+-- >>> import qualified Data.ByteString.Char8 as BS8
+-- >>> import qualified Data.ByteString.Lazy.Char8 as LBS8
diff --git a/tree-diff/Test/StateMachine/TreeDiff/Diffing.hs b/tree-diff/Test/StateMachine/TreeDiff/Diffing.hs
new file mode 100644
--- /dev/null
+++ b/tree-diff/Test/StateMachine/TreeDiff/Diffing.hs
@@ -0,0 +1,75 @@
+{-# LANGUAGE DerivingStrategies         #-}
+{-# LANGUAGE FlexibleContexts           #-}
+{-# LANGUAGE FlexibleInstances          #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE ScopedTypeVariables        #-}
+{-# LANGUAGE StandaloneDeriving         #-}
+{-# LANGUAGE TypeApplications           #-}
+{-# LANGUAGE TypeFamilies               #-}
+{-# LANGUAGE UndecidableInstances       #-}
+
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+-- | Implements @CanDiff@ with our vendored version of @tree-diff@.
+module Test.StateMachine.TreeDiff.Diffing () where
+
+import           Data.SOP
+import           Test.StateMachine.Diffing
+import qualified Test.StateMachine.Lockstep.NAry    as NAry
+import qualified Test.StateMachine.Lockstep.Simple  as Simple
+import           Test.StateMachine.TreeDiff.Class
+import           Test.StateMachine.TreeDiff.Expr
+import           Test.StateMachine.TreeDiff.Pretty
+import           Test.StateMachine.Types.References
+
+instance ToExpr x => CanDiff x where
+  type ADiff  x = Edit EditExpr
+  type AnExpr x = Expr
+
+  toDiff             = toExpr
+  exprDiff         _ = Test.StateMachine.TreeDiff.Expr.exprDiff
+  diffToDocCompact _ = ansiWlBgEditExprCompact
+  diffToDoc        _ = ansiWlBgEditExpr
+  exprToDoc        _ = ansiWlBgExpr
+
+-- References
+
+deriving newtype instance ToExpr Var
+
+instance ToExpr a => ToExpr (Symbolic a) where
+  toExpr (Symbolic x) = toExpr x
+
+instance ToExpr a => ToExpr (Concrete a) where
+  toExpr (Concrete x) = toExpr x
+
+instance ToExpr (r a) => ToExpr (Reference a r)
+
+instance ToExpr (Opaque a) where
+  toExpr _ = App "Opaque" []
+
+-- Simple
+
+instance ToExpr (Simple.MockHandle t)
+      => ToExpr (NAry.MockHandleN (Simple.Simple t) (Simple.RealHandle t)) where
+  toExpr (Simple.SimpleToMock h) = toExpr h
+
+-- NAry
+
+deriving
+  newtype
+  instance (ToExpr a, ToExpr (NAry.MockHandleN t a)) => ToExpr (NAry.Refs t Concrete a)
+
+instance All (And ToExpr (Compose ToExpr (NAry.MockHandleN t))) (NAry.RealHandles t)
+      => ToExpr (NAry.Refss t Concrete) where
+  toExpr = Lst
+         . hcollapse
+         . hcmap (Proxy @(And ToExpr (Compose ToExpr (NAry.MockHandleN t)))) toExprOne
+         . NAry.unRefss
+    where
+      toExprOne :: (ToExpr a, ToExpr (NAry.MockHandleN t a))
+                => NAry.Refs t Concrete a -> K Expr a
+      toExprOne = K . toExpr
+
+instance ( ToExpr (NAry.MockState t)
+         , All (And ToExpr (Compose ToExpr (NAry.MockHandleN t))) (NAry.RealHandles t)
+         ) => ToExpr (NAry.Model t Concrete)
diff --git a/tree-diff/Test/StateMachine/TreeDiff/Expr.hs b/tree-diff/Test/StateMachine/TreeDiff/Expr.hs
new file mode 100644
--- /dev/null
+++ b/tree-diff/Test/StateMachine/TreeDiff/Expr.hs
@@ -0,0 +1,104 @@
+-- | This module uses 'Expr' for richer diffs than based on 'Tree'.
+module Test.StateMachine.TreeDiff.Expr (
+    -- * Types
+    Expr (..),
+    ConstructorName,
+    FieldName,
+    EditExpr (..),
+    Edit (..),
+    exprDiff,
+    ) where
+
+import           Prelude
+                   ()
+import           Prelude.Compat
+
+import           Data.Map
+                   (Map)
+import           Test.StateMachine.TreeDiff.List
+
+import qualified Data.Map                        as Map
+import qualified Test.QuickCheck                 as QC
+
+-- | Constructor name is a string
+type ConstructorName = String
+--
+-- | Record field name is a string too.
+type FieldName       = String
+
+-- | A untyped Haskell-like expression.
+--
+-- Having richer structure than just 'Tree' allows to have richer diffs.
+data Expr
+    = App ConstructorName [Expr]                 -- ^ application
+    | Rec ConstructorName (Map FieldName Expr)   -- ^ record constructor
+    | Lst [Expr]                                 -- ^ list constructor
+  deriving (Eq, Show)
+
+instance QC.Arbitrary Expr where
+    arbitrary = QC.scale (min 25) $ QC.sized arb where
+        arb n | n <= 0 = QC.oneof
+            [ (`App` []) <$> arbName
+            ,  (`Rec` mempty) <$> arbName
+            ]
+        arb n | otherwise = do
+            n' <- QC.choose (0, n `div` 3)
+            QC.oneof
+                [ App <$> arbName <*> QC.liftArbitrary (arb n')
+                , Rec <$> arbName <*> QC.liftArbitrary (arb n')
+                , Lst <$> QC.liftArbitrary (arb n')
+                ]
+
+    shrink (Lst es)   = es
+        ++ [ Lst es'    | es' <- QC.shrink es ]
+    shrink (Rec n fs) = Map.elems fs
+        ++ [ Rec n' fs  | n'  <- QC.shrink n  ]
+        ++ [ Rec n  fs' | fs' <- QC.shrink fs ]
+    shrink (App n es) = es
+        ++ [ App n' es  | n'  <- QC.shrink n  ]
+        ++ [ App n  es' | es' <- QC.shrink es ]
+
+arbName :: QC.Gen String
+arbName = QC.frequency
+    [ (10, QC.liftArbitrary $ QC.elements $ ['a'..'z'] ++ ['0' .. '9'] ++ "+-_:")
+    , (1, show <$> (QC.arbitrary :: QC.Gen String))
+    , (1, QC.arbitrary)
+    , (1, QC.elements ["_×_", "_×_×_", "_×_×_×_"])
+    ]
+
+-- | Diff two 'Expr'.
+--
+-- For examples see 'ediff' in "Data.TreeDiff.Class".
+exprDiff :: Expr -> Expr -> Edit EditExpr
+exprDiff = impl
+  where
+    impl ea eb | ea == eb = Cpy (EditExp ea)
+
+    impl ea@(App a as) eb@(App b bs)
+        | a == b = Cpy $ EditApp a (map recurse (diffBy (==) as bs))
+        | otherwise = Swp (EditExp ea) (EditExp eb)
+    impl ea@(Rec a as) eb@(Rec b bs)
+        | a == b = Cpy $ EditRec a $ Map.unions [inter, onlyA, onlyB]
+        | otherwise = Swp (EditExp ea) (EditExp eb)
+      where
+        inter = Map.intersectionWith exprDiff as bs
+        onlyA = fmap (Del . EditExp) (Map.difference as inter)
+        onlyB = fmap (Ins . EditExp) (Map.difference bs inter)
+    impl (Lst as) (Lst bs) =
+        Cpy $ EditLst (map recurse (diffBy (==) as bs))
+
+    -- If higher level doesn't match, just swap.
+    impl a b = Swp (EditExp a) (EditExp b)
+
+    recurse (Ins x)   = Ins (EditExp x)
+    recurse (Del y)   = Del (EditExp y)
+    recurse (Cpy z)   = Cpy (EditExp z)
+    recurse (Swp x y) = impl x y
+
+-- | Type used in the result of 'ediff'.
+data EditExpr
+    = EditApp ConstructorName [Edit EditExpr]
+    | EditRec ConstructorName (Map FieldName (Edit EditExpr))
+    | EditLst [Edit EditExpr]
+    | EditExp Expr  -- ^ unchanged tree
+  deriving Show
diff --git a/tree-diff/Test/StateMachine/TreeDiff/List.hs b/tree-diff/Test/StateMachine/TreeDiff/List.hs
new file mode 100644
--- /dev/null
+++ b/tree-diff/Test/StateMachine/TreeDiff/List.hs
@@ -0,0 +1,64 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+-- | A list diff.
+module Test.StateMachine.TreeDiff.List (diffBy, Edit (..)) where
+
+import           Data.List.Compat
+                   (sortOn)
+import qualified Data.MemoTrie    as M
+import qualified Data.Vector      as V
+
+-- | List edit operations
+--
+-- The 'Swp' constructor is redundant, but it let us spot
+-- a recursion point when performing tree diffs.
+data Edit a
+    = Ins a    -- ^ insert
+    | Del a    -- ^ delete
+    | Cpy a    -- ^ copy unchanged
+    | Swp a a  -- ^ swap, i.e. delete + insert
+  deriving Show
+
+-- | List difference.
+--
+-- >>> diffBy (==) "hello" "world"
+-- [Swp 'h' 'w',Swp 'e' 'o',Swp 'l' 'r',Cpy 'l',Swp 'o' 'd']
+--
+-- >>> diffBy (==) "kitten" "sitting"
+-- [Swp 'k' 's',Cpy 'i',Cpy 't',Cpy 't',Swp 'e' 'i',Cpy 'n',Ins 'g']
+--
+-- prop> \xs ys -> length (diffBy (==) xs ys) >= max (length xs) (length (ys :: String))
+-- prop> \xs ys -> length (diffBy (==) xs ys) <= length xs + length (ys :: String)
+--
+-- /Note:/ currently this has O(n*m) memory requirements, for the sake
+-- of more obviously correct implementation.
+--
+diffBy :: forall a. (a -> a -> Bool) -> [a] -> [a] -> [Edit a]
+diffBy eq xs' ys' = reverse (snd (lcs (V.length xs) (V.length ys)))
+  where
+    xs = V.fromList xs'
+    ys = V.fromList ys'
+
+    lcs = M.memo2 impl
+
+    impl :: Int -> Int -> (Int, [Edit a])
+    impl 0 0 = (0, [])
+    impl 0 m = case lcs 0 (m-1) of
+        (w, edit) -> (w + 1, Ins (ys V.! (m - 1)) : edit)
+    impl n 0 = case lcs (n -1) 0 of
+        (w, edit) -> (w + 1, Del (xs V.! (n - 1)) : edit)
+
+    impl n m = head $ sortOn fst
+        [ edit
+        , bimap (+1) (Ins y :) (lcs n (m - 1))
+        , bimap (+1) (Del x :) (lcs (n - 1) m)
+        ]
+      where
+        x = xs V.! (n - 1)
+        y = ys V.! (m - 1)
+
+        edit
+            | eq x y    = bimap id   (Cpy x :)   (lcs (n - 1) (m - 1))
+            | otherwise = bimap (+1) (Swp x y :) (lcs (n -1 ) (m - 1))
+
+bimap :: (a -> c) -> (b -> d) -> (a, b) -> (c, d)
+bimap f g (x, y) = (f x, g y)
diff --git a/tree-diff/Test/StateMachine/TreeDiff/Pretty.hs b/tree-diff/Test/StateMachine/TreeDiff/Pretty.hs
new file mode 100644
--- /dev/null
+++ b/tree-diff/Test/StateMachine/TreeDiff/Pretty.hs
@@ -0,0 +1,257 @@
+-- | Utilities to pretty print 'Expr' and 'EditExpr'
+module Test.StateMachine.TreeDiff.Pretty (
+    -- * Explicit dictionary
+    Pretty (..),
+    ppExpr,
+    ppEditExpr,
+    ppEditExprCompact,
+    -- * pretty
+    prettyPretty,
+    prettyExpr,
+    prettyEditExpr,
+    prettyEditExprCompact,
+    -- * ansi-wl-pprint
+    ansiWlPretty,
+    ansiWlExpr,
+    ansiWlEditExpr,
+    ansiWlEditExprCompact,
+    -- ** background
+    ansiWlBgPretty,
+    ansiWlBgExpr,
+    ansiWlBgEditExpr,
+    ansiWlBgEditExprCompact,
+    -- * Utilities
+    escapeName,
+    ) where
+
+import           Data.Char
+                   (isAlphaNum, isPunctuation, isSymbol, ord)
+import           Data.Either
+                   (partitionEithers)
+import           Numeric
+                   (showHex)
+import           Test.StateMachine.TreeDiff.Expr
+import           Text.Read
+                   (readMaybe)
+
+
+import qualified Data.Map                        as Map
+import qualified Text.PrettyPrint                as HJ
+import qualified Text.PrettyPrint.ANSI.Leijen    as WL
+
+-- | Because we don't want to commit to single pretty printing library,
+-- we use explicit dictionary.
+data Pretty doc = Pretty
+    { ppCon    :: ConstructorName -> doc
+    , ppRec    :: [(FieldName, doc)] -> doc
+    , ppLst    :: [doc] -> doc
+    , ppCpy    :: doc -> doc
+    , ppIns    :: doc -> doc
+    , ppDel    :: doc -> doc
+    , ppSep    :: [doc] -> doc
+    , ppParens :: doc -> doc
+    , ppHang   :: doc -> doc -> doc
+    }
+
+-- | Escape field or constructor name
+--
+-- >>> putStrLn $ escapeName "Foo"
+-- Foo
+--
+-- >>> putStrLn $ escapeName "_×_"
+-- _×_
+--
+-- >>> putStrLn $ escapeName "-3"
+-- `-3`
+--
+-- >>> putStrLn $ escapeName "kebab-case"
+-- kebab-case
+--
+-- >>> putStrLn $ escapeName "inner space"
+-- `inner space`
+--
+-- >>> putStrLn $ escapeName $ show "looks like a string"
+-- "looks like a string"
+--
+-- >>> putStrLn $ escapeName $ show "tricky" ++ "   "
+-- `"tricky"   `
+--
+-- >>> putStrLn $ escapeName "[]"
+-- `[]`
+--
+-- >>> putStrLn $ escapeName "_,_"
+-- `_,_`
+--
+escapeName :: String -> String
+escapeName n
+    | null n                      = "``"
+    | isValidString n             = n
+    | all valid' n && headNotMP n = n
+    | otherwise                   = "`" ++ concatMap e n ++ "`"
+  where
+    e '`'               = "\\`"
+    e '\\'              = "\\\\"
+    e ' '               = " "
+    e c | not (valid c) = "\\x" ++ showHex (ord c) ";"
+    e c                 = [c]
+
+    valid c = isAlphaNum c || isSymbol c || isPunctuation c
+    valid' c = valid c && c `notElem` "[](){}`\","
+
+    headNotMP ('-' : _) = False
+    headNotMP ('+' : _) = False
+    headNotMP _         = True
+
+    isValidString s
+        | length s >= 2 && head s == '"' && last s == '"' =
+            case readMaybe s :: Maybe String of
+                Just _  -> True
+                Nothing -> False
+    isValidString _         = False
+
+-- | Pretty print an 'Expr' using explicit pretty-printing dictionary.
+ppExpr :: Pretty doc -> Expr -> doc
+ppExpr p = ppExpr' p False
+
+ppExpr' :: Pretty doc -> Bool -> Expr -> doc
+ppExpr' p = impl where
+    impl _ (App x []) = ppCon p (escapeName x)
+    impl b (App x xs) = ppParens' b $ ppHang p (ppCon p (escapeName x)) $
+        ppSep p $ map (impl True) xs
+    impl _ (Rec x xs) = ppHang p (ppCon p (escapeName x)) $ ppRec p $
+        map ppField' $ Map.toList xs
+    impl _ (Lst xs)   = ppLst p (map (impl False) xs)
+
+    ppField' (n, e) = (escapeName n, impl False e)
+
+    ppParens' True  = ppParens p
+    ppParens' False = id
+
+-- | Pretty print an @'Edit' 'EditExpr'@ using explicit pretty-printing dictionary.
+ppEditExpr :: Pretty doc -> Edit EditExpr -> doc
+ppEditExpr = ppEditExpr' False
+
+-- | Like 'ppEditExpr' but print unchanged parts only shallowly
+ppEditExprCompact :: Pretty doc -> Edit EditExpr -> doc
+ppEditExprCompact = ppEditExpr' True
+
+ppEditExpr' :: Bool -> Pretty doc -> Edit EditExpr -> doc
+ppEditExpr' compact p = ppSep p . ppEdit False
+  where
+    ppEdit b (Cpy (EditExp expr)) = [ ppCpy p $ ppExpr' p b expr ]
+    ppEdit b (Cpy expr) = [ ppEExpr b expr ]
+    ppEdit b (Ins expr) = [ ppIns p (ppEExpr b expr) ]
+    ppEdit b (Del expr) = [ ppDel p (ppEExpr b expr) ]
+    ppEdit b (Swp x y) =
+        [ ppDel p (ppEExpr b x)
+        , ppIns p (ppEExpr b y)
+        ]
+
+    ppEExpr _ (EditApp x []) = ppCon p (escapeName x)
+    ppEExpr b (EditApp x xs) = ppParens' b $ ppHang p (ppCon p (escapeName x)) $
+        ppSep p $ concatMap (ppEdit True) xs
+    ppEExpr _ (EditRec x xs) = ppHang p (ppCon p (escapeName x)) $ ppRec p $
+        justs ++ [ (n, ppCon p "...") | n <- take 1 nothings ]
+      where
+        xs' = map ppField' $ Map.toList xs
+        (nothings, justs) = partitionEithers xs'
+
+    ppEExpr _ (EditLst xs)   = ppLst p (concatMap (ppEdit False) xs)
+    ppEExpr b (EditExp x)    = ppExpr' p b x
+
+    ppField' (n, Cpy (EditExp e)) | compact, not (isScalar e) = Left n
+    ppField' (n, e) = Right (escapeName n, ppSep p $ ppEdit False e)
+
+    ppParens' True  = ppParens p
+    ppParens' False = id
+
+    isScalar (App _ []) = True
+    isScalar _          = False
+
+-------------------------------------------------------------------------------
+-- pretty
+-------------------------------------------------------------------------------
+
+-- | 'Pretty' via @pretty@ library.
+prettyPretty :: Pretty HJ.Doc
+prettyPretty = Pretty
+    { ppCon    = HJ.text
+    , ppRec    = HJ.braces . HJ.sep . HJ.punctuate HJ.comma
+               . map (\(fn, d) -> HJ.text fn HJ.<+> HJ.equals HJ.<+> d)
+    , ppLst    = HJ.brackets . HJ.sep . HJ.punctuate HJ.comma
+    , ppCpy    = id
+    , ppIns    = \d -> HJ.char '+' HJ.<> d
+    , ppDel    = \d -> HJ.char '-' HJ.<> d
+    , ppSep    = HJ.sep
+    , ppParens = HJ.parens
+    , ppHang   = \d1 d2 -> HJ.hang d1 2 d2
+    }
+
+-- | Pretty print 'Expr' using @pretty@.
+--
+-- >>> prettyExpr $ Rec "ex" (Map.fromList [("[]", App "bar" [])])
+-- ex {`[]` = bar}
+prettyExpr :: Expr -> HJ.Doc
+prettyExpr = ppExpr prettyPretty
+
+-- | Pretty print @'Edit' 'EditExpr'@ using @pretty@.
+prettyEditExpr :: Edit EditExpr -> HJ.Doc
+prettyEditExpr = ppEditExpr prettyPretty
+
+-- | Compact 'prettyEditExpr'.
+prettyEditExprCompact :: Edit EditExpr -> HJ.Doc
+prettyEditExprCompact = ppEditExprCompact prettyPretty
+
+-------------------------------------------------------------------------------
+-- ansi-wl-pprint
+-------------------------------------------------------------------------------
+
+-- | 'Pretty' via @ansi-wl-pprint@ library (with colors).
+ansiWlPretty :: Pretty WL.Doc
+ansiWlPretty = Pretty
+    { ppCon    = WL.text
+    , ppRec    = WL.encloseSep WL.lbrace WL.rbrace WL.comma
+               . map (\(fn, d) -> WL.text fn WL.<+> WL.equals WL.</> d)
+    , ppLst    = WL.list
+    , ppCpy    = WL.dullwhite
+    , ppIns    = \d -> WL.green $ WL.plain $ WL.char '+' WL.<> d
+    , ppDel    = \d -> WL.red   $ WL.plain $ WL.char '-' WL.<> d
+    , ppSep    = WL.sep
+    , ppParens = WL.parens
+    , ppHang   = \d1 d2 -> WL.hang 2 (d1 WL.</> d2)
+    }
+
+-- | Pretty print 'Expr' using @ansi-wl-pprint@.
+ansiWlExpr :: Expr -> WL.Doc
+ansiWlExpr = ppExpr ansiWlPretty
+
+-- | Pretty print @'Edit' 'EditExpr'@ using @ansi-wl-pprint@.
+ansiWlEditExpr :: Edit EditExpr -> WL.Doc
+ansiWlEditExpr = ppEditExpr ansiWlPretty
+
+-- | Compact 'ansiWlEditExpr'
+ansiWlEditExprCompact :: Edit EditExpr -> WL.Doc
+ansiWlEditExprCompact = ppEditExprCompact ansiWlPretty
+
+-------------------------------------------------------------------------------
+-- Background
+-------------------------------------------------------------------------------
+
+-- | Like 'ansiWlPretty' but color the background.
+ansiWlBgPretty :: Pretty WL.Doc
+ansiWlBgPretty = ansiWlPretty
+    { ppIns    = \d -> WL.ondullgreen $ WL.white $ WL.plain $ WL.char '+' WL.<> d
+    , ppDel    = \d -> WL.ondullred   $ WL.white $ WL.plain $ WL.char '-' WL.<> d
+    }
+
+-- | Pretty print 'Expr' using @ansi-wl-pprint@.
+ansiWlBgExpr :: Expr -> WL.Doc
+ansiWlBgExpr = ppExpr ansiWlBgPretty
+
+-- | Pretty print @'Edit' 'EditExpr'@ using @ansi-wl-pprint@.
+ansiWlBgEditExpr :: Edit EditExpr -> WL.Doc
+ansiWlBgEditExpr = ppEditExpr ansiWlBgPretty
+
+-- | Compact 'ansiWlBgEditExpr'.
+ansiWlBgEditExprCompact :: Edit EditExpr -> WL.Doc
+ansiWlBgEditExprCompact = ppEditExprCompact ansiWlBgPretty
diff --git a/tree-diff/Test/StateMachine/TreeDiff/Tree.hs b/tree-diff/Test/StateMachine/TreeDiff/Tree.hs
new file mode 100644
--- /dev/null
+++ b/tree-diff/Test/StateMachine/TreeDiff/Tree.hs
@@ -0,0 +1,99 @@
+{-# LANGUAGE CPP #-}
+-- | Tree diffing working on @containers@ 'Tree'.
+module Test.StateMachine.TreeDiff.Tree (treeDiff, EditTree (..), Edit (..)) where
+
+import           Data.Tree
+                   (Tree(..))
+import           Test.StateMachine.TreeDiff.List
+
+#ifdef __DOCTEST__
+import qualified Text.PrettyPrint                as PP
+#endif
+
+-- | A breadth-traversal diff.
+--
+-- It's different from @gdiff@, as it doesn't produce a flat edit script,
+-- but edit script iself is a tree. This makes visualising the diff much
+-- simpler.
+--
+-- ==== Examples
+--
+-- Let's start from simple tree. We pretty print them as s-expressions.
+--
+-- >>> let x = Node 'a' [Node 'b' [], Node 'c' [return 'd', return 'e'], Node 'f' []]
+-- >>> ppTree PP.char x
+-- (a b (c d e) f)
+--
+-- If we modify an argument in a tree, we'll notice it's changed:
+--
+-- >>> let y = Node 'a' [Node 'b' [], Node 'c' [return 'x', return 'e'], Node 'f' []]
+-- >>> ppTree PP.char y
+-- (a b (c x e) f)
+--
+-- >>> ppEditTree PP.char (treeDiff x y)
+-- (a b (c -d +x e) f)
+--
+-- If we modify a constructor, the whole sub-trees is replaced, though there
+-- might be common subtrees.
+--
+-- >>> let z = Node 'a' [Node 'b' [], Node 'd' [], Node 'f' []]
+-- >>> ppTree PP.char z
+-- (a b d f)
+--
+-- >>> ppEditTree PP.char (treeDiff x z)
+-- (a b -(c d e) +d f)
+--
+-- If we add arguments, they are spotted too:
+--
+-- >>> let w = Node 'a' [Node 'b' [], Node 'c' [return 'd', return 'x', return 'e'], Node 'f' []]
+-- >>> ppTree PP.char w
+-- (a b (c d x e) f)
+--
+-- >>> ppEditTree PP.char (treeDiff x w)
+-- (a b (c d +x e) f)
+--
+treeDiff :: Eq a => Tree a -> Tree a -> Edit (EditTree a)
+treeDiff ta@(Node a as) tb@(Node b bs)
+    | a == b = Cpy $ EditNode a (map rec (diffBy (==) as bs))
+    | otherwise = Swp (treeToEdit ta) (treeToEdit tb)
+  where
+    rec (Ins x)   = Ins (treeToEdit x)
+    rec (Del y)   = Del (treeToEdit y)
+    rec (Cpy z)   = Cpy (treeToEdit z)
+    rec (Swp x y) = treeDiff x y
+
+-- | Type used in the result of 'treeDiff'.
+--
+-- It's essentially a 'Tree', but the forest list is changed from
+-- @[tree a]@ to @['Edit' (tree a)]@. This highlights that
+-- 'treeDiff' performs a list diff on each tree level.
+data EditTree a
+    = EditNode a [Edit (EditTree a)]
+  deriving Show
+
+treeToEdit :: Tree a -> EditTree a
+treeToEdit = go where go (Node x xs) = EditNode x (map (Cpy . go) xs)
+
+#ifdef __DOCTEST__
+ppTree :: (a -> PP.Doc) -> Tree a -> PP.Doc
+ppTree pp = ppT
+  where
+    ppT (Node x []) = pp x
+    ppT (Node x xs) = PP.parens $ PP.hang (pp x) 2 $
+        PP.sep $ map ppT xs
+
+ppEditTree :: (a -> PP.Doc) -> Edit (EditTree a) -> PP.Doc
+ppEditTree pp = PP.sep . ppEdit
+  where
+    ppEdit (Cpy tree) = [ ppTree tree ]
+    ppEdit (Ins tree) = [ PP.char '+' PP.<> ppTree tree ]
+    ppEdit (Del tree) = [ PP.char '-' PP.<> ppTree tree ]
+    ppEdit (Swp a b) =
+        [ PP.char '-' PP.<> ppTree a
+        , PP.char '+' PP.<> ppTree b
+        ]
+
+    ppTree (EditNode x []) = pp x
+    ppTree (EditNode x xs) = PP.parens $ PP.hang (pp x) 2 $
+       PP.sep $ concatMap ppEdit xs
+#endif