diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml
index b2ebe33081b..d52ece23899 100644
--- a/.github/workflows/haskell.yml
+++ b/.github/workflows/haskell.yml
@@ -215,7 +215,6 @@ jobs:
         - cardano-ledger-shelley-test
         - cardano-ledger-test
         - cardano-protocol-tpraos
-        - constrained-generators
         - non-integral
         - set-algebra
         - small-steps
diff --git a/cabal.project b/cabal.project
index 9aaf37acbb8..0f8e44b5d85 100644
--- a/cabal.project
+++ b/cabal.project
@@ -18,6 +18,11 @@ source-repository-package
   -- MAKE SURE THIS POINTS TO A COMMIT IN `*-artifacts` BEFORE MERGE!
   tag: 28d3fd4876bbfa347f5eb89a6b70ee15dc9b327f
 
+source-repository-package
+  type: git
+  location: https://github.com/input-output-hk/constrained-generators.git
+  tag: 35b625eaeaa0953710c0a07add0673fdde5fa052
+
 -- NOTE: If you would like to update the above,
 -- see CONTRIBUTING.md#to-update-the-referenced-agda-ledger-spec
 index-state:
@@ -60,7 +65,6 @@ packages:
   libs/cardano-ledger-test
   libs/plutus-preprocessor
   libs/ledger-state
-  libs/constrained-generators
   libs/cardano-ledger-repl-environment
 
 program-options
diff --git a/hie.yaml b/hie.yaml
index 6df526d36de..cf85ffa361e 100644
--- a/hie.yaml
+++ b/hie.yaml
@@ -303,24 +303,6 @@ cradle:
     - path: "libs/cardano-protocol-tpraos/test"
       component: "cardano-protocol-tpraos:test:tests"
 
-    - path: "libs/constrained-generators/src"
-      component: "lib:constrained-generators"
-
-    - path: "libs/constrained-generators/examples"
-      component: "constrained-generators:lib:examples"
-
-    - path: "libs/constrained-generators/testlib"
-      component: "constrained-generators:lib:testlib"
-
-    - path: "libs/constrained-generators/test"
-      component: "constrained-generators:test:constrained"
-
-    - path: "libs/constrained-generators/bench/Main.hs"
-      component: "constrained-generators:bench:bench"
-
-    - path: "libs/constrained-generators/bench/Constrained/Bench.hs"
-      component: "constrained-generators:bench:bench"
-
     - path: "libs/ledger-state/src"
       component: "lib:ledger-state"
 
diff --git a/libs/constrained-generators/CHANGELOG.md b/libs/constrained-generators/CHANGELOG.md
deleted file mode 100644
index 99d567e7916..00000000000
--- a/libs/constrained-generators/CHANGELOG.md
+++ /dev/null
@@ -1,3 +0,0 @@
-# Version history for `constrained-generators`
-
-## This package is not being released yet.
diff --git a/libs/constrained-generators/bench/Constrained/Bench.hs b/libs/constrained-generators/bench/Constrained/Bench.hs
deleted file mode 100644
index 749b14d9d27..00000000000
--- a/libs/constrained-generators/bench/Constrained/Bench.hs
+++ /dev/null
@@ -1,55 +0,0 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE UndecidableInstances #-}
-
-module Constrained.Bench where
-
-import Constrained.API
-import Control.DeepSeq
-import Criterion
-import Data.Map (Map)
-import Data.Set (Set)
-import Data.Tree
-
-benchmarks :: Benchmark
-benchmarks =
-  bgroup
-    "constrained"
-    [ benchSpec 10 30 "TrueSpec@Map" (trueSpec :: Specification (Map Int Int))
-    , benchSpec 10 30 "TrueSpec@[]" (trueSpec :: Specification [Int])
-    , benchSpec 10 30 "TrueSpec@Set" (trueSpec :: Specification (Set Int))
-    , benchSpec
-        10
-        30
-        "TrueSpec@Tree"
-        (giveHint (Nothing, 30) <> trueSpec :: Specification (Tree Int))
-    , benchSpec 10 30 "roseTreeMaybe" roseTreeMaybe
-    , benchSpec 10 30 "listSumPair" listSumPair
-    ]
-
-roseTreeMaybe :: Specification (Tree (Maybe (Int, Int)))
-roseTreeMaybe = constrained $ \t ->
-  [ forAll' t $ \mp ts ->
-      forAll ts $ \t' ->
-        onJust mp $ \p ->
-          onJust (rootLabel_ t') $ \p' ->
-            fst_ p' ==. snd_ p
-  , forAll' t $ \mp _ -> isJust mp
-  , genHint (Nothing, 10) t
-  ]
-
-listSumPair :: Specification [(Int, Int)]
-listSumPair = constrained $ \xs ->
-  [ assert $ foldMap_ fst_ xs ==. 100
-  , forAll' xs $ \x y -> [20 <. x, x <. 30, y <. 100]
-  ]
-
-benchSpec :: (HasSpec a, NFData a) => Int -> Int -> String -> Specification a -> Benchmark
-benchSpec seed size nm spec =
-  bench (unlines [nm, show (genFromSpecWithSeed seed size spec)]) $
-    nf (genFromSpecWithSeed seed size) spec
diff --git a/libs/constrained-generators/bench/Main.hs b/libs/constrained-generators/bench/Main.hs
deleted file mode 100644
index 169711002aa..00000000000
--- a/libs/constrained-generators/bench/Main.hs
+++ /dev/null
@@ -1,7 +0,0 @@
-module Main where
-
-import Constrained.Bench
-import Criterion.Main (defaultMain)
-
-main :: IO ()
-main = defaultMain [benchmarks]
diff --git a/libs/constrained-generators/constrained-generators.cabal b/libs/constrained-generators/constrained-generators.cabal
deleted file mode 100644
index 798b79ef250..00000000000
--- a/libs/constrained-generators/constrained-generators.cabal
+++ /dev/null
@@ -1,168 +0,0 @@
-cabal-version: 3.0
-name: constrained-generators
-version: 0.2.0.0
-license: Apache-2.0
-maintainer: operations@iohk.io
-author: IOHK
-synopsis:
-  Framework for generating constrained random data using
-  a subset of first order logic
-
-build-type: Simple
-extra-source-files: CHANGELOG.md
-
-source-repository head
-  type: git
-  location: https://github.com/input-output-hk/cardano-ledger
-  subdir: libs/constrained-generators
-
-library
-  exposed-modules:
-    Constrained.API
-    Constrained.API.Extend
-    Constrained.AbstractSyntax
-    Constrained.Base
-    Constrained.Conformance
-    Constrained.Core
-    Constrained.DependencyInjection
-    Constrained.Env
-    Constrained.FunctionSymbol
-    Constrained.GenT
-    Constrained.Generation
-    Constrained.Generic
-    Constrained.Graph
-    Constrained.List
-    Constrained.NumOrd
-    Constrained.PrettyUtils
-    Constrained.Properties
-    Constrained.Spec.List
-    Constrained.Spec.Map
-    Constrained.Spec.Set
-    Constrained.Spec.SumProd
-    Constrained.Spec.Tree
-    Constrained.SumList
-    Constrained.Syntax
-    Constrained.Test
-    Constrained.TheKnot
-    Constrained.TypeErrors
-
-  hs-source-dirs: src
-  default-language: Haskell2010
-  ghc-options:
-    -Wall
-    -Wcompat
-    -Wincomplete-record-updates
-    -Wincomplete-uni-patterns
-    -Wpartial-fields
-    -Wredundant-constraints
-    -Wunused-packages
-
-  build-depends:
-    QuickCheck >=2.14,
-    base >=4.18 && <5,
-    base-orphans,
-    containers,
-    mtl,
-    prettyprinter,
-    random,
-    template-haskell,
-
-library examples
-  exposed-modules:
-    Constrained.Examples
-    Constrained.Examples.Basic
-    Constrained.Examples.BinTree
-    Constrained.Examples.CheatSheet
-    Constrained.Examples.Either
-    Constrained.Examples.Fold
-    Constrained.Examples.List
-    Constrained.Examples.ManualExamples
-    Constrained.Examples.Map
-    Constrained.Examples.Set
-    Constrained.Examples.Tree
-
-  hs-source-dirs: examples
-  default-language: Haskell2010
-  ghc-options:
-    -Wall
-    -Wcompat
-    -Wincomplete-record-updates
-    -Wincomplete-uni-patterns
-    -Wpartial-fields
-    -Wredundant-constraints
-    -Wunused-packages
-
-  build-depends:
-    QuickCheck >=2.14,
-    base >=4.18 && <5,
-    constrained-generators,
-    containers,
-    prettyprinter,
-    random,
-
-library testlib
-  exposed-modules:
-    Test.Minimal.Base
-    Test.Minimal.Model
-    Test.Minimal.Syntax
-    Test.Minimal.Tuple
-
-  hs-source-dirs: testlib
-  default-language: Haskell2010
-  ghc-options:
-    -Wall
-    -Wcompat
-    -Wincomplete-record-updates
-    -Wincomplete-uni-patterns
-    -Wpartial-fields
-    -Wredundant-constraints
-    -Wunused-packages
-
-  build-depends:
-    QuickCheck >=2.14,
-    base >=4.18 && <5,
-    constrained-generators,
-    containers,
-    mtl,
-    prettyprinter,
-
-test-suite constrained
-  type: exitcode-stdio-1.0
-  main-is: Tests.hs
-  hs-source-dirs: test
-  other-modules: Constrained.Tests
-  default-language: Haskell2010
-  ghc-options:
-    -Wall
-    -Wcompat
-    -Wincomplete-record-updates
-    -Wincomplete-uni-patterns
-    -Wpartial-fields
-    -Wredundant-constraints
-    -Wunused-packages
-    -rtsopts
-
-  build-depends:
-    QuickCheck,
-    base,
-    constrained-generators,
-    constrained-generators:examples,
-    containers,
-    hspec,
-
-benchmark bench
-  type: exitcode-stdio-1.0
-  main-is: Main.hs
-  hs-source-dirs: bench
-  other-modules: Constrained.Bench
-  default-language: Haskell2010
-  ghc-options:
-    -Wall
-    -rtsopts
-
-  build-depends:
-    base,
-    constrained-generators,
-    containers,
-    criterion,
-    deepseq,
diff --git a/libs/constrained-generators/examples/Constrained/Examples.hs b/libs/constrained-generators/examples/Constrained/Examples.hs
deleted file mode 100644
index 3fd77375cd2..00000000000
--- a/libs/constrained-generators/examples/Constrained/Examples.hs
+++ /dev/null
@@ -1,8 +0,0 @@
-module Constrained.Examples (module X) where
-
-import Constrained.Examples.Basic as X
-import Constrained.Examples.Either as X
-import Constrained.Examples.List as X
-import Constrained.Examples.Map as X
-import Constrained.Examples.Set as X
-import Constrained.Examples.Tree as X
diff --git a/libs/constrained-generators/examples/Constrained/Examples/Basic.hs b/libs/constrained-generators/examples/Constrained/Examples/Basic.hs
deleted file mode 100644
index f9ce5db7993..00000000000
--- a/libs/constrained-generators/examples/Constrained/Examples/Basic.hs
+++ /dev/null
@@ -1,321 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE ImportQualifiedPost #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE ViewPatterns #-}
-
-module Constrained.Examples.Basic where
-
-import Constrained.API
-import GHC.Generics
-import Test.QuickCheck qualified as QC
-
-leqPair :: Specification (Int, Int)
-leqPair = constrained $ \ [var| p |] ->
-  match p $ \ [var| x |] [var| y |] ->
-    x <=. y
-
-simplePairSpec :: Specification (Int, Int)
-simplePairSpec = constrained $ \(name "p" -> p) ->
-  match p $ \(name "x" -> x) y ->
-    [ assert $ x /=. 0
-    , assert $ name "y" y /=. 0
-    , -- You can use `monitor` to add QuickCheck property modifiers for
-      -- monitoring distribution, like classify, label, and cover, to your
-      -- specification
-      monitor $ \eval ->
-        QC.classify (eval y > 0) "positive y"
-          . QC.classify (eval x > 0) "positive x"
-    ]
-
-sizeAddOrSub1 :: Specification Integer
-sizeAddOrSub1 = constrained $ \s ->
-  4 ==. s + 2
-
-sizeAddOrSub2 :: Specification Integer
-sizeAddOrSub2 = constrained $ \s ->
-  4 ==. 2 + s
-
-sizeAddOrSub3 :: Specification Integer
-sizeAddOrSub3 = constrained $ \s ->
-  4 ==. s - 2
-
--- | We expect a negative Integer, so ltSpec tests for that.
-sizeAddOrSub4 :: Specification Integer
-sizeAddOrSub4 = ltSpec 0 <> (constrained $ \s -> 4 ==. 2 - s)
-
-sizeAddOrSub5 :: Specification Integer
-sizeAddOrSub5 = constrained $ \s ->
-  2 ==. 12 - s
-
-listSubSize :: Specification [Int]
-listSubSize = constrained $ \s ->
-  2 ==. 12 - (sizeOf_ s)
-
-orPair :: Specification (Int, Int)
-orPair = constrained' $ \x y ->
-  x <=. 5 ||. y <=. 5
-
-trickyCompositional :: Specification (Int, Int)
-trickyCompositional = constrained $ \p ->
-  satisfies p simplePairSpec <> assert (fst_ p ==. 1000)
-
-data Foo = Foo Int | Bar Int Int
-  deriving (Show, Eq, Ord, Generic)
-
-instance HasSimpleRep Foo
-
-instance HasSpec Foo
-
-fooSpec :: Specification Foo
-fooSpec = constrained $ \foo ->
-  (caseOn foo)
-    ( branch $ \i ->
-        [ assert $ 0 <=. i
-        , monitor $ \_ -> QC.cover 40 True "Foo"
-        ]
-    )
-    ( branch $ \i j ->
-        [ assert $ i <=. j
-        , monitor $ \_ -> QC.cover 40 True "Bar"
-        ]
-    )
-
-intSpec :: Specification (Int, Int)
-intSpec = constrained' $ \a b ->
-  reify a (`mod` 10) $ \a' -> b ==. a'
-
-mapElemKeySpec :: Specification Int
-mapElemKeySpec = constrained $ \n ->
-  letBind (pair_ n $ lit (False, 4)) $ \(p :: Term (Int, (Bool, Int))) ->
-    letBind (snd_ (snd_ p)) $ \x ->
-      [x <. 10, 0 <. x, not_ $ elem_ n $ lit []]
-
-intRangeSpec :: Int -> Specification Int
-intRangeSpec a = constrained $ \n -> n <. lit a
-
-testRewriteSpec :: Specification ((Int, Int), (Int, Int))
-testRewriteSpec = constrained' $ \x y ->
-  x ==. fromGeneric_ (toGeneric_ y)
-
-pairSingletonSpec :: Specification (Int, Int)
-pairSingletonSpec = constrained $ \q ->
-  forAll (singleton_ q) $ \p ->
-    letBind (fst_ p) $ \x ->
-      letBind (snd_ p) $ \y ->
-        x <=. y
-
-parallelLet :: Specification (Int, Int)
-parallelLet = constrained $ \p ->
-  [ letBind (fst_ p) $ \x -> 0 <. x
-  , letBind (snd_ p) $ \x -> x <. 0
-  ]
-
-letExists :: Specification (Int, Int)
-letExists = constrained $ \p ->
-  [ letBind (fst_ p) $ \x -> 0 <. x
-  , exists (\eval -> pure $ snd (eval p)) $
-      \x ->
-        [ x <. 0
-        , snd_ p ==. x
-        ]
-  ]
-
-letExistsLet :: Specification (Int, Int)
-letExistsLet = constrained $ \p ->
-  [ letBind (fst_ p) $ \x -> 0 <. x
-  , exists (\eval -> pure $ snd (eval p)) $
-      \x ->
-        [ assert $ x <. 0
-        , letBind (snd_ p) $ \y ->
-            [ x ==. y
-            , y <. -1
-            ]
-        ]
-  ]
-
-dependencyWeirdness :: Specification (Int, Int, Int)
-dependencyWeirdness = constrained' $ \x y z ->
-  reify (x + y) id $ \zv -> z ==. zv
-
-parallelLetPair :: Specification (Int, Int)
-parallelLetPair = constrained $ \p ->
-  [ match p $ \x y ->
-      [ assert $ x <=. y
-      , y `dependsOn` x
-      ]
-  , match p $ \x y -> y <=. x
-  ]
-
-existsUnfree :: Specification Int
-existsUnfree = constrained $ \_ -> exists (\_ -> pure 1) $ \y -> y `elem_` lit [1, 2 :: Int]
-
-reifyYucky :: Specification (Int, Int, Int)
-reifyYucky = constrained' $ \x y z ->
-  [ reify x id $ \w ->
-      [ y ==. w
-      , z ==. w
-      ]
-  , z `dependsOn` y
-  ]
-
-basicSpec :: Specification Int
-basicSpec = constrained $ \x ->
-  exists (\eval -> pure $ eval x) $ \y ->
-    satisfies x $ constrained $ \x' ->
-      x' <=. 1 + y
-
-canFollowLike :: Specification ((Int, Int), (Int, Int))
-canFollowLike = constrained' $ \p q ->
-  match p $ \ma mi ->
-    match q $ \ma' mi' ->
-      [ ifElse
-          (ma' ==. ma)
-          (mi' ==. mi + 1)
-          (mi' ==. 0)
-      , assert $ ma' <=. ma + 1
-      , assert $ ma <=. ma'
-      , ma' `dependsOn` ma
-      ]
-
-ifElseBackwards :: Specification (Int, Int)
-ifElseBackwards = constrained' $ \p q ->
-  [ ifElse
-      (p ==. 1)
-      (q <=. 0)
-      (0 <. q)
-  , p `dependsOn` q
-  ]
-
-assertReal :: Specification Int
-assertReal = constrained $ \x ->
-  [ assert $ x <=. 10
-  , assertReified x (<= 10)
-  ]
-
-assertRealMultiple :: Specification (Int, Int)
-assertRealMultiple = constrained' $ \x y ->
-  [ assert $ x <=. 10
-  , assert $ 11 <=. y
-  , assertReified (pair_ x y) $ uncurry (/=)
-  ]
-
-reifiesMultiple :: Specification (Int, Int, Int)
-reifiesMultiple = constrained' $ \x y z ->
-  [ reifies (x + y) z id
-  , x `dependsOn` y
-  ]
-
-data Three = One | Two | Three deriving (Ord, Eq, Show, Generic)
-
-instance HasSimpleRep Three
-
-instance HasSpec Three
-
-trueSpecUniform :: Specification Three
-trueSpecUniform = constrained $ \o -> monitor $ \eval -> QC.cover 30 True (show $ eval o)
-
-three :: Specification Three
-three = constrained $ \o ->
-  [ caseOn
-      o
-      (branchW 1 $ \_ -> True)
-      (branchW 1 $ \_ -> True)
-      (branchW 1 $ \_ -> True)
-  , monitor $ \eval -> QC.cover 30 True (show $ eval o)
-  ]
-
-three' :: Specification Three
-three' = three <> three
-
-threeSpecific :: Specification Three
-threeSpecific = constrained $ \o ->
-  [ caseOn
-      o
-      (branchW 1 $ \_ -> True)
-      (branchW 1 $ \_ -> True)
-      (branchW 2 $ \_ -> True)
-  , monitor $ \eval ->
-      QC.coverTable "TheValue" [("One", 22), ("Two", 22), ("Three", 47)]
-        . QC.tabulate "TheValue" [show $ eval o]
-  ]
-
-threeSpecific' :: Specification Three
-threeSpecific' = threeSpecific <> threeSpecific
-
-posNegDistr :: Specification Int
-posNegDistr =
-  constrained $ \x ->
-    [ monitor $ \eval -> QC.cover 60 (0 < eval x) "x positive"
-    , x `satisfies` chooseSpec (1, constrained (<. 0)) (2, constrained (0 <.))
-    ]
-
-ifElseMany :: Specification (Bool, Int, Int)
-ifElseMany = constrained' $ \b x y ->
-  ifElse
-    b
-    [ x <. 0
-    , y <. 10
-    ]
-    [ 0 <. x
-    , 10 <. y
-    ]
-
-propBack :: Specification (Int, Int)
-propBack = constrained' $ \x y ->
-  [ x ==. y + 10
-  , x <. 20
-  , 8 <. y
-  ]
-
-propBack' :: Specification (Int, Int)
-propBack' = constrained' $ \x y ->
-  [ y ==. x - 10
-  , 20 >. x
-  , 8 >. y
-  , y >. x - 20
-  ]
-
-propBack'' :: Specification (Int, Int)
-propBack'' = constrained' $ \x y ->
-  [ assert $ y + 10 ==. x
-  , x `dependsOn` y
-  , assert $ x <. 20
-  , assert $ 8 <. y
-  ]
-
-chooseBackwards :: Specification (Int, [Int])
-chooseBackwards = constrained $ \xy ->
-  [ assert $ xy `elem_` lit [(1, [1001 .. 1005]), (2, [1006 .. 1010])]
-  , match xy $ \_ ys ->
-      forAll ys $ \y -> 0 <. y
-  ]
-
-chooseBackwards' :: Specification ([(Int, [Int])], (Int, [Int]))
-chooseBackwards' = constrained' $ \ [var| xys |] [var| xy |] ->
-  [ forAll' xys $ \_ [var| ys |] ->
-      forAll ys $ \ [var| y |] -> 1000 <. y
-  , assert $ 0 <. length_ xys
-  , assert $ xy `elem_` xys
-  , match xy $ \_ [var| ys |] ->
-      forAll ys $ \ [var| y |] -> 0 <. y
-  ]
-
-whenTrueExists :: Specification Int
-whenTrueExists = constrained $ \x ->
-  whenTrue ([var| x |] ==. 0) $
-    exists (\_ -> pure False) $ \b ->
-      [ not_ [var| b |]
-      , not_ (not_ b)
-      ]
-
-wtfSpec :: Specification ([Int], Maybe ((), [Int]))
-wtfSpec = constrained' $ \ [var| options |] [var| mpair |] ->
-  caseOn
-    mpair
-    (branch $ \_ -> False)
-    ( branch $ \pair -> match pair $ \unit ints ->
-        [ forAll ints $ \int -> reify options id $ \xs -> int `elem_` xs
-        , assert $ unit ==. lit ()
-        ]
-    )
diff --git a/libs/constrained-generators/examples/Constrained/Examples/BinTree.hs b/libs/constrained-generators/examples/Constrained/Examples/BinTree.hs
deleted file mode 100644
index dd1bf05c5d1..00000000000
--- a/libs/constrained-generators/examples/Constrained/Examples/BinTree.hs
+++ /dev/null
@@ -1,87 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeFamilies #-}
-
-module Constrained.Examples.BinTree where
-
-import Constrained.API
-import GHC.Generics
-
-------------------------------------------------------------------------
--- The types
-------------------------------------------------------------------------
-
-data BinTree a
-  = BinTip
-  | BinNode (BinTree a) a (BinTree a)
-  deriving (Ord, Eq, Show, Generic)
-
-------------------------------------------------------------------------
--- HasSpec for BinTree
-------------------------------------------------------------------------
-
-data BinTreeSpec a = BinTreeSpec (Maybe Integer) (Specification (BinTree a, a, BinTree a))
-  deriving (Show)
-
-instance Forallable (BinTree a) (BinTree a, a, BinTree a) where
-  fromForAllSpec = typeSpec . BinTreeSpec Nothing
-  forAllToList BinTip = []
-  forAllToList (BinNode left a right) = (left, a, right) : forAllToList left ++ forAllToList right
-
-instance HasSpec a => HasSpec (BinTree a) where
-  type TypeSpec (BinTree a) = BinTreeSpec a
-
-  emptySpec = BinTreeSpec Nothing mempty
-
-  combineSpec (BinTreeSpec sz s) (BinTreeSpec sz' s') =
-    typeSpec $ BinTreeSpec (unionWithMaybe min sz sz') (s <> s')
-
-  conformsTo BinTip _ = True
-  conformsTo (BinNode left a right) s@(BinTreeSpec _ es) =
-    and
-      [ (left, a, right) `conformsToSpec` es
-      , left `conformsTo` s
-      , right `conformsTo` s
-      ]
-
-  genFromTypeSpec (BinTreeSpec msz s)
-    | Just sz <- msz, sz <= 0 = pure BinTip
-    | otherwise = do
-        let sz = maybe 20 id msz
-            sz' = sz `div` 2
-        oneofT
-          [ do
-              (left, a, right) <- genFromSpecT @(BinTree a, a, BinTree a) $
-                constrained $ \ctx ->
-                  [ match ctx $ \left _ right ->
-                      [ forAll left (`satisfies` s)
-                      , genHint sz' left
-                      , forAll right (`satisfies` s)
-                      , genHint sz' right
-                      ]
-                  , ctx `satisfies` s
-                  ]
-              pure $ BinNode left a right
-          , pure BinTip
-          ]
-
-  shrinkWithTypeSpec _ BinTip = []
-  shrinkWithTypeSpec s (BinNode left a right) =
-    BinTip
-      : left
-      : right
-      : (BinNode left a <$> shrinkWithTypeSpec s right)
-      ++ ((\l -> BinNode l a right) <$> shrinkWithTypeSpec s left)
-
-  cardinalTypeSpec _ = mempty
-
-  toPreds t (BinTreeSpec msz s) =
-    (forAll t $ \n -> n `satisfies` s)
-      <> maybe mempty (flip genHint t) msz
-
-instance HasSpec a => HasGenHint (BinTree a) where
-  type Hint (BinTree a) = Integer
-  giveHint h = typeSpec $ BinTreeSpec (Just h) mempty
diff --git a/libs/constrained-generators/examples/Constrained/Examples/CheatSheet.hs b/libs/constrained-generators/examples/Constrained/Examples/CheatSheet.hs
deleted file mode 100644
index 335bc3b27b1..00000000000
--- a/libs/constrained-generators/examples/Constrained/Examples/CheatSheet.hs
+++ /dev/null
@@ -1,693 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE ImportQualifiedPost #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE ViewPatterns #-}
-
-module Constrained.Examples.CheatSheet where
-
-import Constrained.API
-import Data.Set (Set)
-import Data.Set qualified as Set
-import GHC.Generics
-import Test.QuickCheck (Property, label)
-
--- The `constrained-generators` library allows us to write
--- constraints that give us random generators, shrinkers, and checkers
--- for data using a small embedded DSL, which defines a limited first order logic.
---
--- Every first order logic has 4 parts, as does our DSL.
--- 1) Terms :  e.g. x, 5, (member_ x set) (x ==. y)
---    Implemented as (Term a). We have variables like 'x', and constants like '5'.
---    'member_' and '==.' are function symbols, and build Terms from other terms.
---    By convention, a name followed by '_' or an infix operator followed by '.' are function symbols.
--- 2) Predicates (over terms). Predicates commonly used are
---        TruePred,
---        FalsePred (pure "explain"),
---        assert $ termWithTypeBool,
---    Some more unusual predicates are described below.
---    Implemented as type (Pred fn)
--- 3) Combinators (combining predicates). In general, And, Or, Not, Implies, True, False
---    But in the DSL, we are limited to
---      'And' using Block :: [Pred] -> Pred
---      'Not' using the function symbol not_ :: Term Bool -> Term Bool
---            for example:  assert $ not_ (x ==. y)
---      limited form of 'Or' using
---         chooseSpec :: (Int, Specification a)- > (Int, Specification a) -> Specification a
--- 4) Quantifiers (applying constraints to many things) :
---    forAll: Term t -> (Term a -> p) -> Pred fn
---    exists: ((forall b. Term b -> b) -> GE a) -> (Term a -> p) -> Pred fn
---    These are explained in detail below
-
--- In case you are interested, here is a list of supported function symbols (note the use of the '_' and '.' convention)
--- disjoint_,  dom_,  elem_,  length_,  member_,  not_,  rng_,  singleton_,  sizeOf_,  subset_,  sum_,  (/=.),
--- (<.),  (<=.),  (==.),  (>.),  (>=.), fromList_, null_, union_
--- You may also use the methods of Num (+) (-) (*), since there is a (Num (Term fn)) instance.
-
--- The first order logic DSL is used to build Specifications
--- A specifcation with type (Specification x) has two uses
--- 1) To generate a random values of type 'x', subject to the constraints in the specifications definition.
---    This is implemented by   genFromSpec :: Specification x -> Gen x (Gen is the QuickCheck Gen)
--- 2) To test if a value of type 'x' meets all of the constraints given in the specifications definition.
---     This is implemented by  conformsToSpec :: HasSpec a => a -> Specification a -> Bool
-
--- Lets get started. We can talk about numbers:
-
-specInt :: Specification Int
-specInt = constrained $ \i ->
-  [ assert $ i <. 10
-  , assert $ 0 <. i
-  ]
-
--- What's going on here? In short:
---    `constrained :: (HasSpec a, IsPred p fn) => (Term a -> p) -> Specification a`
---    Introduces the variable `i` over which we can write constraints of type `p` over something
---    of type `a` to produce a `Specifcation a` using a list of
---    `assert :: Term Bool -> Pred  with `Term -level versions (function symbols) of familiar functions like
---    `(<.) :: OrdLike a => Term a -> Term a -> Term Bool`, `null_ :: Term [a] -> Term Bool`,
---    `rng_ :: (HasSpec k, HasSpec v, Ord k) => Term (Map k v) -> Term (Set k)` etc.
--- We get a generator from `genFromSpec :: Specification BaseFn a -> Gen a`:
--- λ> sample $ genFromSpec specInt
--- 1
--- 5
--- 6
--- 6
--- 8
--- 5
--- 3
--- 1
--- 1
--- 4
--- 8
-
--- Likewise, `shrinkWithSpec :: Specification BaseFn a -> a -> [a]` gives us
--- a shrinker:
--- λ> shrinkWithSpec specInt 10
--- [5,8,9]
--- λ> shrinkWithSpec specInt 5
--- [3,4]
--- λ> shrinkWithSpec specInt 3
--- [2]
--- λ> shrinkWithSpec specInt 1
--- []
-
--- And, `conformsToSpec :: a -> Specification BaseFn a -> Bool` gives us a checker:
--- λ> 10 `conformsToSpec` specInt
--- False
--- λ> 5 `conformsToSpec` specInt
--- True
-
--- Note that the type of `constrained` says the binding function of type `Term a -> p` doesn't
--- have to produce a `Pred  (which is the return type of `assert`), but can produce something of type `p`
--- that satisfies `IsPred p`. This basically just means something that can be readily turned into a
--- `Pred`, like e.g. `Pred`, `Bool`, `Term Bool`, `[p]` for `IsPred p`. Consequently, we could
--- have written `specInt` as:
-
-specInt' :: Specification Int
-specInt' = constrained $ \i ->
-  [ i <. 10
-  , 0 <. i
-  ]
-
--- However, beware that when we start mixing `Term Bool` and `Pred` in these lists we can end
--- up getting some inscrutable error messages. So, if a call to `constrained` or another function that
--- has `IsPred` as a constraint, starts giving you strange error messages, double check that you have
--- used `assert` instead of raw `Term Bool` everywhere relevant.
-
--- We also have support for product types with functions like `fst_`, `snd_`, and `pair_`:
-
-specProd :: Specification (Int, Int)
-specProd = constrained $ \p ->
-  [ fst_ p <. 10
-  , snd_ p <. 100
-  ]
-
--- However, product types can also be a bit finicky:
-
-specProd0 :: Specification (Int, Int)
-specProd0 = constrained $ \p -> assert $ fst_ p <. snd_ p
-
--- λ> sample $ genFromSpec specProd0
-
--- *** Exception: Simplifying:
-
---   constrained $ \ v0 -> assert $ Less (Fst (ToGeneric v0)) (Snd (ToGeneric v0))
--- optimisePred => assert $ Less (Fst (ToGeneric v0)) (Snd (ToGeneric v0))
--- assert $ Less (Fst (ToGeneric v0)) (Snd (ToGeneric v0))
--- Can't build a single-hole context for variable v0 in term Less (Fst (ToGeneric v0)) (Snd (ToGeneric v0))
-
--- This gives us the _fundamental restriction_:
---   A variable can not appear twice in the same constraint
-
--- The fundamental restriction is very important to make the system compositional
--- and modular. We will get back to talking about it in detail when we discuss how to
--- extend the system. However, for now suffice to say that it's a lot easier to solve
--- constraints that look like `2 * x <. 10` than it is to solve constraints
--- like `x <. 10 - x` (i.e. ones that mention the same variable more than once).
-
--- To overcome the fundamental restriction we can use `match`:
--- match ::
---   forall p a.
---   ( HasSpec a
---   , IsProductType a
---   , IsPred p fn
---   ) =>
---   Term a ->
---   FunTy (MapList (Term fn) (ProductAsList a)) p ->
---   Pred fn
-
-specProd1 :: Specification (Int, Int)
-specProd1 = constrained $ \p ->
-  match p $ \x y ->
-    x <. y
-
--- λ> sample $ genFromSpec specProd1
--- (-1,0)
--- (-4,-2)
--- (1,2)
--- (-2,1)
--- (7,8)
--- (-9,-4)
--- (-3,3)
--- (-1,12)
--- (-7,-6)
--- (-11,17)
--- (-53,-14)
-
--- Bringing variables into scope.
--- 'constrained' and 'match' are the ways we bring variable into scope, And they are often nested.
--- Consider writing a specification for pair of nested pairs: Specification ((Int,Int),(Int,Int))
--- How do we name the four different Int's ?
-
-nested :: Specification ((Int, Int), (Int, Int))
-nested =
-  constrained $ \pp ->
-    match pp $ \p1 p2 ->
-      match p1 $ \x1 y1 ->
-        match p2 $ \x2 y2 ->
-          [x1 <=. y1, y1 <=. x2, x2 <=. y2]
-
--- ghci> sample $ genFromSpec nested
--- ((0,0),(0,0))
--- ((-9,-5),(-1,0))
--- ((-12,-10),(-5,-2))
--- ((-8,-4),(-3,-2))
--- ((-33,-18),(-15,-6))
--- ((-21,-12),(-1,3))
--- ((-36,-12),(1,9))
--- ((-64,-37),(-30,-4))
--- ((-53,-37),(-33,-10))
--- ((-49,-15),(-6,8))
--- ((-72,-34),(-26,-19))
-
--- A good rule of thumb when starting a new specification is to think about how you would
--- use 'constrained' and 'match' to bring variables, naming each of the parts that you want
--- to constrain, into scope.
-
--- Let's look under the hood of `match`, it introduces two auxilliary variables `v0` and `v1`
--- that circumvents the fundamental restriction by allowing us to generate values for `v1` and
--- `v0` before we generate a value for `v3`.
-
--- λ> simplifySpec specProd1
--- constrained $ \ v3 ->
---   let v1 = Fst (ToGeneric v3) in
---   let v0 = Snd (ToGeneric v3) in
---   assert $ Less v1 v0
-
--- This pattern of `constrained $ \ p -> match p $ \ x y -> ...` is very common
--- and has a shorthand in the form of `constrained'`:
-
-specProd2 :: Specification (Int, Int)
-specProd2 = constrained' $ \x y -> x <. y
-
--- How does generation actually work when we have multiple variables? For example,
--- it is not obvious (to the computer) what the best way of generating values satisfying
--- this constraint is:
-
-solverOrder :: Specification (Int, Int)
-solverOrder = constrained' $ \x y ->
-  [ x <. y
-  , y <. 10
-  ]
-
--- For example, if you tried generating a value for `x` first chances are you'd generate
--- something larger than 10, which would make it impossible to generate a valid `y`. However,
--- when we run it we get reasonable values out:
-
--- sample $ genFromSpec solverOrder
--- (-1,0)
--- (0,2)
--- (-4,4)
--- (-7,-3)
--- (-7,3)
--- (-11,-3)
--- (4,8)
--- (-15,-14)
--- (-25,-10)
--- (-23,-6)
--- (-51,-20)
-
--- But how does the system know to generate `y` first? Unfortunately, there is nothing smart about
--- it. The system simply solves things "right to left" - variables that appear to the right in assertions
--- are solved before variables to the left. If one wants to understand the consequences of this and how it
--- affects the generator the `printPlan` function comes in handy:
-
--- λ> printPlan solverOrder
--- Simplified spec:
---   constrained $ \ v_3 ->
---     let v_1 = Fst (ToGeneric v_3) in
---     let v_0 = Snd (ToGeneric v_3) in
---     {assert $ Less v_0 10
---      assert $ Less v_1 v_0}
--- SolverPlan
---   Dependencies:
---     v_0 <- []
---     v_1 <- [v_0]
---     v_3 <- [v_0, v_1]
---   Linearization:
---     v_0 <- TypeSpec [..9] []
---     v_1 <- assert $ Less v_1 v_0
---     v_3 <-
---       assert $ Equal (Fst (ToGeneric v_3)) v_1
---       assert $ Equal (Snd (ToGeneric v_3)) v_0
-
--- There are three parts to the output:
---  - The "Simplified spec" is the input specification after it has gone through a number of optimization
---    and simplification passes to make it amenable to solving.
---  - The "Dependencies" tells us what variables depend on what other variables to be solved. In this case `v0` (y)
---    has no dependencies, `v1` (x) is solved after `v0` and `v3` (the actual pair we are generating) is solved
---    last.
---  - Finaly, the "Linearization" tells us _what constraints define what varible_. This is an important aspect of the
---    system: variables are only constrained by assertions that talk about the variable itself and variables that
---    are solved before it. In this case `v0` (y) is defined by `y <. 10`, `v1` (x) by `x <. y` and `v3` by the equalities
---    in the `Let` constructs.
---
--- As the generator executes this plan it will pick the variables in the order in which they appear in the linearization
--- and generate the corresponding values. For example, an execution trace could go like the following pseudo-trace (the details of how
--- this works are slightly more involved but the basic order of operations is accurate):
---  v0 <- pick from (-∞, 10)
---  v0 = 4
---  v1 <- pick from [4/v0](-∞, v0)
---        -> pick from (-∞, 4)
---  v1 = 2
---  v3 <- pick from [4/v0, 2/v1]{fst == v1, snd == v0}
---        -> pick from {fst == 2, snd == 4}
---  v3 = (2, 4)
-
--- As an aside, the frustrating thing about making sense of the output of `printPlan` is the `v0`, `v1`, etc. naming.
--- To introduce proper names we can use the `var` quasi-quoter:
-
-solverOrder' :: Specification (Int, Int)
-solverOrder' = constrained' $ \ [var|x|] [var|y|] ->
-  [ x <. y
-  , y <. 10
-  ]
-
--- Now we get more reasonable looking oputput from `printPlan`:
--- λ> printPlan solverOrder'
--- Simplified spec:
---   constrained $ \ v_3 ->
---     let x_1 = Fst (ToGeneric v_3) in
---     let y_0 = Snd (ToGeneric v_3) in
---     {assert $ Less y_0 10
---      assert $ Less x_1 y_0}
--- SolverPlan
---   Dependencies:
---     y_0 <- []
---     x_1 <- [y_0]
---     v_3 <- [y_0, x_1]
---   Linearization:
---     y_0 <- TypeSpec [..9] []
---     x_1 <- assert $ Less x_1 y_0
---     v_3 <-
---       assert $ Equal (Fst (ToGeneric v_3)) x_1
---       assert $ Equal (Snd (ToGeneric v_3)) y_0
-
--- A consequence of the default dependency order approach is that it's possible
--- to write constraints that put you in a tricky situation:
-
-tightFit0 :: Specification (Int, Int)
-tightFit0 = constrained' $ \x y ->
-  [ 0 <. x
-  , x <. y
-  ]
-
--- λ> sample $ genFromSpec tightFit0
-
--- *** Exception: genFromPreds:
-
---   let v_1 = Fst (ToGeneric v_3) in
---   let v_0 = Snd (ToGeneric v_3) in
---   {assert $ Less v_1 v_0
---    assert $ Less 0 v_1}
--- SolverPlan
---   Dependencies:
---     v_0 <- []
---     v_1 <- [v_0]
---     v_3 <- [v_0, v_1]
---   Linearization:
---     v_0 <-
---     v_1 <-
---       TypeSpec [1..] []
---       ---
---       assert $ Less v_1 v_0
---     v_3 <-
---       assert $ Equal (Fst (ToGeneric v_3)) v_1
---       assert $ Equal (Snd (ToGeneric v_3)) v_0
--- Stepping the plan:
---   SolverPlan
---     Dependencies:
---       v_1 <- []
---       v_3 <- [v_1]
---     Linearization:
---       v_1 <- ErrorSpec [1..-1]
---       v_3 <-
---         TypeSpec (Cartesian TrueSpec (MemberSpec [0])) []
---         ---
---         assert $ Equal (Fst (ToGeneric v_3)) v_1
---   Env {unEnv = fromList [(v_0,EnvValue 0)]}
--- genFromSpecT ErrorSpec{} with explanation:
--- [1..-1]
-
--- The generator fails with output similar to what we saw above and a message telling us we tried to generate
--- a value from the (empty) interval [1..-1]. Inspecting the output above carefully we see that the graph and the
--- linearization tell us that `v0` (y) is completely unconstrained. The consequence of this is that when we get to the
--- point of trying to generate `v1` (x) we've already picked a value (-1) for `v0` that makes it impossible to satisfy
--- the constraints on `v1` and its constraints have specialized away to an error spec.
-
--- The solution to this issue is to introduce `dependsOn`, which lets us override the dependency order in constraints:
-
-tightFit1 :: Specification (Int, Int)
-tightFit1 = constrained' $ \x y ->
-  [ assert $ 0 <. x
-  , assert $ x <. y
-  , y `dependsOn` x
-  ]
-
--- λ> printPlan tightFit1
--- Simplified spec:
---   constrained $ \ v_3 ->
---     let v_1 = Fst (ToGeneric v_3) in
---     let v_0 = Snd (ToGeneric v_3) in
---     {v_0 <- v_1
---      assert $ Less v_1 v_0
---      assert $ Less 0 v_1}
--- SolverPlan
---   Dependencies:
---     v_0 <- [v_1]
---     v_1 <- []
---     v_3 <- [v_0, v_1]
---   Linearization:
---     v_1 <- TypeSpec [1..] []
---     v_0 <- assert $ Less v_1 v_0
---     v_3 <-
---       assert $ Equal (Fst (ToGeneric v_3)) v_1
---       assert $ Equal (Snd (ToGeneric v_3)) v_0
-
--- This gives us more balanced constraints that solve `v1` before they solve `v0`!
--- Consequently, this constraint generates reasonable values:
-
--- λ> sample $ genFromSpec tightFit1
--- (1,2)
--- (2,3)
--- (9,15)
--- (4,10)
--- (12,27)
--- (15,21)
--- (10,30)
--- (23,51)
--- (7,34)
--- (21,46)
--- (28,49)
-
--- We also support booleans with `ifElse :: Term Bool -> Pred -> Pred -> Pred`
--- where the branches of the `ifElse` depend on the scrutinee.
-
-booleanExample :: Specification (Int, Int)
-booleanExample = constrained' $ \x y ->
-  ifElse
-    (0 <. x)
-    (y ==. 10)
-    (y ==. 20)
-
--- sample $ genFromSpec booleanExample
--- (0,20)
--- (2,10)
--- (4,10)
--- (1,10)
--- (-2,20)
--- (3,10)
--- (7,10)
--- (-8,20)
--- (-5,20)
--- (-2,20)
--- (-19,20)
-
--- We can combine `ifElse` and `dependsOn` to write a nice example saying
--- that a PVP version pair `q` can follow a pair `p`.
-
--- Because we will need to re-use this multiple times we start by defining a valid
--- PVP constraint as any constraint that has non-negative major and minor version number.
-validPVPVersion :: Specification (Int, Int)
-validPVPVersion = constrained' $ \ma mi -> [0 <=. ma, 0 <=. mi]
-
--- Now we are ready to define the constraints for valid PVP succession. Note here that
--- we use the `satisfies :: Term a -> Specification BaseFn a -> Pred` combinator
--- to re-use the `validPVPVersion` constraint.
-
-canFollowExample :: Specification ((Int, Int), (Int, Int))
-canFollowExample = constrained' $ \p q ->
-  [ match p $ \ma mi ->
-      match q $ \ma' mi' ->
-        [ ifElse
-            (ma' ==. ma)
-            (mi' ==. mi + 1)
-            (mi' ==. 0)
-        , -- Note how these two constraints imply a cycle:
-          --  ma' <- ma <- ma'
-          assert $ ma' <=. ma + 1
-        , assert $ ma <=. ma'
-        , -- We break that cycle by specifying a concrete order
-          -- Another option would be to define `>=.` but that doesn't
-          -- exist right now and we will get to extending the language
-          -- later on!
-          ma' `dependsOn` ma
-        ]
-  , p `satisfies` validPVPVersion
-  , q `satisfies` validPVPVersion
-  ]
-
--- λ> sample $ genFromSpec canFollowExample
--- ((0,0),(0,1))
--- ((1,0),(1,1))
--- ((4,2),(4,3))
--- ((12,1),(12,2))
--- ((11,16),(11,17))
--- ((20,7),(21,0))
--- ((18,12),(18,13))
--- ((6,18),(7,0))
--- ((29,24),(30,0))
--- ((23,21),(23,22))
--- ((26,14),(26,15))
-
--- We have native support for sum types using `caseOn` and `branch`:
-
-sumExample :: Specification (Either Int Bool)
-sumExample = constrained $ \e ->
-  (caseOn e)
-    (branch $ \i -> i <. 0)
-    (branch $ \b -> not_ b)
-
--- Furthermore, cases are solved _inside-out_ by default:
-
-sumExampleTwo :: Specification (Int, Either Int Bool)
-sumExampleTwo = constrained' $ \i e ->
-  [ caseOn
-      e
-      (branch $ \j -> i <. j)
-      (branch $ \b -> not_ b)
-  , assert $ 20 <. i
-  ]
-
--- We can work with sets with operations like `subset_`, `union_` (or `<>`), `disjoint_`, and `singleton_`:
-
-setExample :: Specification (Set Int, Set Int, Set Int)
-setExample = constrained' $ \xs ys zs ->
-  [ xs `subset_` (ys <> zs)
-  , sizeOf_ ys <=. 10
-  ]
-
--- We can also quantify over things like sets with `forAll`:
-
-forAllFollow0 :: Specification ((Int, Int), Set (Int, Int))
-forAllFollow0 = constrained' $ \p qs ->
-  [ forAll qs $ \q -> pair_ p q `satisfies` canFollowExample
-  ]
-
--- λ> sample $ genFromSpec forAllFollow0
--- ((0,0),fromList [])
--- ((1,-1),fromList [])
--- ((2,3),fromList [(2,4),(3,0)])
--- ((4,2),fromList [(4,3),(5,0)])
--- ((-2,6),fromList [])
--- ((10,-9),fromList [])
--- ((-1,-8),fromList [])
--- ((-8,-1),fromList [])
--- ((1,4),fromList [(1,5),(2,0)])
--- ((-17,-5),fromList [])
--- ((-2,12),fromList [])
-
--- How come the sets are so small? Note that we sometimes still generate
--- negative values for the components of `p`. But we said in the `canFollowExample`
--- that `p` needs to be a valid PVP version. However, the constraints only say that
--- it needs to be a valid PVP version _if `qs` is non-empty!_. This is easily fixed
--- by specifying that `p` is _always_ a valid PVP version!
-
-forAllFollow :: Specification ((Int, Int), Set (Int, Int))
-forAllFollow = constrained' $ \p qs ->
-  [ forAll qs $ \q -> pair_ p q `satisfies` canFollowExample
-  , p `satisfies` validPVPVersion
-  ]
-
--- λ> sample $ genFromSpec forAllFollow
--- ((0,0),fromList [])
--- ((0,1),fromList [])
--- ((1,5),fromList [(1,6),(2,0)])
--- ((8,10),fromList [(8,11)])
--- ((12,15),fromList [(12,16)])
--- ((6,16),fromList [])
--- ((4,11),fromList [(4,12)])
--- ((10,21),fromList [(10,22),(11,0)])
--- ((28,2),fromList [(28,3),(29,0)])
--- ((20,3),fromList [(20,4),(21,0)])
--- ((16,29),fromList [(16,30),(17,0)])
-
--- We also have existential quantification in the language. The first argument to
--- `exists` tells you how to reconstruct the value from known values.
-
-existentials :: Specification (Set Int, Set Int)
-existentials = constrained' $ \xs ys ->
-  exists (\eval -> pure $ Set.intersection (eval xs) (eval ys)) $ \zs ->
-    [ assert $ not_ $ null_ zs
-    , assert $ zs `subset_` xs
-    , assert $ zs `subset_` ys
-    , xs `dependsOn` zs
-    , ys `dependsOn` zs
-    ]
-
--- You can work with your own types relatively easily. If they are `Generic`
--- you even get all the machinery of sum and product types for free!
-
-data FooBarBaz = Foo Int Int | Bar Bool | Baz deriving (Eq, Show, Generic)
-
--- All you need to do is introduce instances for `HasSimpleRep` and `HasSpec`:
-
-instance HasSimpleRep FooBarBaz
-
-instance HasSpec FooBarBaz
-
-fooBarBaz :: Specification FooBarBaz
-fooBarBaz = constrained $ \fbb ->
-  caseOn
-    fbb
-    (branch $ \i j -> i <. j)
-    (branch $ \b -> not_ b)
-    (branch $ \_ -> False)
-
--- λ> sample $ genFromSpec fooBarBaz
--- Foo (-1) 0
--- Bar False
--- Foo (-9) (-3)
--- Bar False
--- Foo 1 3
--- Foo (-20) (-8)
--- Foo (-35) (-11)
--- Bar False
--- Foo (-8) 5
--- Bar False
--- Foo (-4) 7
-
--- Some functions don't exist on the term level. In this case we can use
--- `reifies :: (HasSpec a, HasSpec b) => Term b -> Term a -> (a -> b) -> Pred`
--- to introduce a one-way evaluation of a Haskell function:
-
-reifyExample :: Specification (Int, Int)
-reifyExample = constrained' $ \ [var|a|] [var|b|] ->
-  reifies b a $ \x -> mod x 10
-
--- Here we introduce two variables `a` and `b` without any immediate dependency and we say that
--- `b` reifies `a` via the haskell function `\x -> mod x 10`. The best way to understand what this
--- cryptic code means is to imagine there was a `mod_` function, in that case this code would be equivalent
--- to:
-
-reifyExample' :: Specification (Int, Int)
-reifyExample' = constrained' $ \a b ->
-  [ assert $ b ==. mod_ a 10
-  , b `dependsOn` a
-  ]
-  where
-    mod_ :: Term Int -> Term Int -> Term Int
-    mod_ = error "This doesn't exist"
-
--- When we look at the plan we get from `reifyExample` we get what we'd expect:
--- λ> printPlan reifyExample
--- Simplified spec:
---   constrained $ \ v_3 ->
---     let v_1 = Fst (ToGeneric v_3) in
---     let v_0 = Snd (ToGeneric v_3) in reifies v_0 v_1
--- SolverPlan
---   Dependencies:
---     v_0 <- [v_1]
---     v_1 <- []
---     v_3 <- [v_0, v_1]
---   Linearization:
---     v_1 <-
---     v_0 <- reifies v_0 v_1
---     v_3 <-
---       assert $ Equal (Fst (ToGeneric v_3)) v_1
---       assert $ Equal (Snd (ToGeneric v_3)) v_0
-
--- Sometimes it is convenient to introduce an auxilliary variable to represent the result of applying the
--- haskell-level function to the term, for this purpose we have
--- `reify :: (HasSpec a, HasSpec b, IsPred p fn) => Term a -> (a -> b) -> (Term b -> p) -> Pred`.
-
--- We have tools to control the distribution of test cases and monitor those distributions. Using `branchW` we can
--- attach weights to branches in a `caseOn` and using `monitor :: ((forall. Term a -> a) -> Property -> Property) -> Pred`
--- we can use the normal QuickCheck functions for monitoring distributions of generators to see the effects of this.
-
-monitorExample :: Specification (Either Int Int)
-monitorExample = constrained $ \e ->
-  caseOn
-    e
-    (branchW 1 $ \_ -> monitor $ \_ -> label "Left")
-    (branchW 2 $ \_ -> monitor $ \_ -> label "Right")
-
--- The `forAllSpec :: (Testable p, HasSpec a) => Specification a -> (a -> p) -> Property` we
--- automatically get the monitoring from the spec in our property:
-
-prop_monitoring :: Property
-prop_monitoring = forAllSpec monitorExample $ \_ -> True
-
--- λ> quickCheck $ prop_monitoring
--- +++ OK, passed 100 tests:
--- 64% Right
--- 36% Left
-
--- Other tools for controlling distributions of specifications are available too, for example
--- `chooseSpec :: HasSpec a => (Int, Specification a) -> (Int, Specification a) -> Specification a`,
--- the definition of which constitutes a useful object of study to better understand how to use the compositional
--- nature of the system to build powerful features.
-
-chooseSpecExample :: Specification Int
-chooseSpecExample =
-  chooseSpec
-    (1, constrained $ \i -> i <. 0)
-    (2, constrained $ \i -> 0 <. i)
-
-prop_chooseSpec :: Property
-prop_chooseSpec = forAllSpec chooseSpecExample $ \i ->
-  label (show $ signum i) True
-
--- λ> quickCheck prop_chooseSpec
--- +++ OK, passed 100 tests:
--- 67% 1
--- 33% -1
diff --git a/libs/constrained-generators/examples/Constrained/Examples/Either.hs b/libs/constrained-generators/examples/Constrained/Examples/Either.hs
deleted file mode 100644
index b5826fd0b5a..00000000000
--- a/libs/constrained-generators/examples/Constrained/Examples/Either.hs
+++ /dev/null
@@ -1,22 +0,0 @@
-{-# LANGUAGE ImportQualifiedPost #-}
-
-module Constrained.Examples.Either where
-
-import Constrained.API
-import Data.Set qualified as Set
-
-eitherSpec :: Specification (Either Int Int)
-eitherSpec = constrained $ \e ->
-  (caseOn e)
-    (branch $ \i -> i <=. 0)
-    (branch $ \i -> 0 <=. i)
-
-foldTrueCases :: Specification (Either Int Int)
-foldTrueCases = constrained $ \x ->
-  [ assert $ not_ $ member_ x (lit (Set.fromList [Left 10]))
-  , letBind (pair_ x (lit (0 :: Int))) $ \p ->
-      caseOn
-        (fst_ p)
-        (branch $ \_ -> True)
-        (branch $ \_ -> True)
-  ]
diff --git a/libs/constrained-generators/examples/Constrained/Examples/Fold.hs b/libs/constrained-generators/examples/Constrained/Examples/Fold.hs
deleted file mode 100644
index 0607a2c3ff9..00000000000
--- a/libs/constrained-generators/examples/Constrained/Examples/Fold.hs
+++ /dev/null
@@ -1,182 +0,0 @@
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE ViewPatterns #-}
-
-module Constrained.Examples.Fold where
-
-import Constrained.API
-import Constrained.Examples.List (Numbery)
-import Constrained.GenT (catMessages, genFromGenT, inspect)
-import Constrained.SumList
-import Data.String (fromString)
-import Prettyprinter (fillSep, punctuate, space)
-import System.Random (Random)
-import Test.QuickCheck hiding (forAll, total)
-
--- ========================================================
--- Specifications we use in the examples and in the tests
-
-oddSpec :: Specification Int
-oddSpec = explainSpec ["odd via (y+y+1)"] $
-  constrained $ \ [var|oddx|] ->
-    exists
-      (\eval -> pure (div (eval oddx - 1) 2))
-      (\ [var|y|] -> [assert $ oddx ==. y + y + 1])
-
-evenSpec ::
-  forall n.
-  (NumLike n, Integral n) =>
-  Specification n
-evenSpec = explainSpec ["even via (x+x)"] $
-  constrained $ \ [var|evenx|] ->
-    exists
-      (\eval -> pure (div (eval evenx) 2))
-      (\ [var|somey|] -> [assert $ evenx ==. somey + somey])
-
-sum3WithLength :: Integer -> Specification ([Int], Int, Int, Int)
-sum3WithLength n =
-  constrained $ \ [var|quad|] ->
-    match quad $ \ [var|l|] [var|n1|] [var|n2|] [var|n3|] ->
-      [ assert $ sizeOf_ l ==. lit n
-      , forAll l $ \ [var|item|] -> item >=. lit 0
-      , assert $ sum_ l ==. n1 + n2 + n3
-      , assert $ n1 + n2 + n3 >=. lit (fromInteger n)
-      ]
-
-sum3 :: Specification [Int]
-sum3 = constrained $ \ [var|xs|] -> [sum_ xs ==. lit 6 + lit 9 + lit 5, sizeOf_ xs ==. 5]
-
-listSumPair :: Numbery a => Specification [(a, Int)]
-listSumPair = constrained $ \xs ->
-  [ assert $ foldMap_ fst_ xs ==. 100
-  , forAll' xs $ \x y -> [20 <. x, x <. 30, y <. 100]
-  ]
-
-listSumForall :: Numbery a => Specification [a]
-listSumForall = constrained $ \xs ->
-  [ forAll xs $ \x -> 1 <. x
-  , assert $ sum_ xs ==. 20
-  ]
-
--- | Complicated, because if 'a' is too large, the spec is unsatisfiable.
-listSumComplex :: Numbery a => a -> Specification [a]
-listSumComplex a = constrained $ \xs ->
-  [ forAll xs $ \x -> 1 <. x
-  , assert $ sum_ xs ==. 20
-  , assert $ sizeOf_ xs >=. lit 4
-  , assert $ sizeOf_ xs <=. lit 6
-  , assert $ elem_ (lit a) xs
-  ]
-
--- ==============================================================
--- Tools for building properties that have good counterexamples
-
-data Outcome = Succeed | Fail
-
-propYes :: String -> Solution t -> Property
-propYes _ (Yes _) = property True
-propYes msg (No xs) = property (counterexample (unlines (msg : xs)) False)
-
-propNo :: Show t => String -> Solution t -> Property
-propNo msg (Yes (x :| _)) = property (counterexample (unlines [msg, "Expected to fail, but succeeds with", show x]) False)
-propNo _ (No _) = property True
-
-parensList :: [String] -> String
-parensList xs = show (fillSep $ punctuate space $ map fromString xs)
-
--- ===============================================================
--- Functions for building properties about the functions defined
--- in module Constrained.SumList(logish,pickAll)
-
-logishProp :: Gen Property
-logishProp = do
-  n <- choose (-17, 17 :: Int) -- Any bigger or smaller is out of the range of Int
-  i <- choose (logRange n)
-  pure (logish i === n)
-
-picktest :: (Ord a, Num a) => a -> a -> (a -> Bool) -> a -> Int -> [a] -> Bool
-picktest smallest largest p total count ans =
-  smallest <= largest
-    && total == sum ans
-    && count == length ans
-    && all p ans
-
--- | generate a different category of test, each time.
-pickProp :: Gen Property
-pickProp = do
-  smallest <- elements [-4, 1 :: Int]
-  count <- choose (2, 4)
-  total <- (+ 20) <$> choose (smallest, 5477)
-  let largest = total + 10
-  (nam, p) <-
-    elements
-      ( concat
-          [ if even total then [("even", even)] else []
-          , if odd total && odd count then [("odd", odd)] else []
-          , [("(>0)", (> 0)), ("true", const True)]
-          ]
-      )
-  (_cost, ans) <- pickAll smallest largest (nam, p) total count (Cost 0)
-  case ans of
-    Yes result -> pure $ property $ all (picktest smallest largest p total count) result
-    No msgs -> pure $ counterexample ("predicate " ++ nam ++ "\n" ++ unlines msgs) False
-
--- | Build properties about calls to 'genListWithSize'
-testFoldSpec ::
-  forall a.
-  Foldy a =>
-  Specification Integer ->
-  Specification a ->
-  Specification a ->
-  Outcome ->
-  Gen Property
-testFoldSpec size elemSpec total outcome = do
-  ans <- genFromGenT $ inspect $ genSizedList size elemSpec total
-  let callString = parensList ["GenListWithSize", show size, fst (predSpecPair elemSpec), show total]
-      fails xs = unlines [callString, "Should fail, but it succeeds with", show xs]
-      succeeds xs =
-        unlines [callString, "Should succeed, but it fails with", catMessages xs]
-  case (ans, outcome) of
-    (Result _, Succeed) -> pure $ property True
-    (Result xs, Fail) -> pure $ counterexample (fails xs) False
-    (FatalError _, Fail) -> pure $ property True
-    (FatalError xs, Succeed) -> pure $ counterexample (succeeds xs) False
-    (GenError _, Fail) -> pure $ property True
-    (GenError xs, Succeed) -> pure $ counterexample (succeeds xs) False
-
--- | Generate a property from a call to 'pickAll'. We can test for success or failure using 'outcome'
-sumProp ::
-  (Integral t, Random t, HasSpec t) =>
-  t ->
-  t ->
-  Specification t ->
-  t ->
-  Int ->
-  Outcome ->
-  Gen Property
-sumProp smallest largest spec total count outcome = sumProp2 smallest largest (predSpecPair spec) total count outcome
-
--- | Like SumProp, but instead of using a (Specification fn n) for the element predicate
---   It uses an explicit pair of a (String, n -> Bool). This means we can test things
---   using any Haskell function.
-sumProp2 ::
-  (Show t, Integral t, Random t) =>
-  t ->
-  t ->
-  (String, t -> Bool) ->
-  t ->
-  Int ->
-  Outcome ->
-  Gen Property
-sumProp2 smallest largest spec total count outcome = do
-  (_, ans) <- pickAll smallest largest spec total count (Cost 0)
-  let callString = parensList ["pickAll", show smallest, (fst spec), show total, show count]
-      message Succeed = "\nShould succeed, but it fails with"
-      message Fail = "\nShould fail, but it succeeds with " ++ show ans
-  pure
-    ( case outcome of
-        Succeed -> propYes (callString ++ message outcome) ans
-        Fail -> propNo callString ans
-    )
diff --git a/libs/constrained-generators/examples/Constrained/Examples/List.hs b/libs/constrained-generators/examples/Constrained/Examples/List.hs
deleted file mode 100644
index ef36b2a0f5a..00000000000
--- a/libs/constrained-generators/examples/Constrained/Examples/List.hs
+++ /dev/null
@@ -1,181 +0,0 @@
-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE MonoLocalBinds #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE ViewPatterns #-}
-
-module Constrained.Examples.List where
-
-import Constrained.API
-import Constrained.Examples.Basic
-import Data.Word
-
-type Numbery a =
-  ( Foldy a
-  , OrdLike a
-  , NumLike a
-  , Ord a
-  , Enum a
-  )
-
-listSum :: Numbery a => Specification [a]
-listSum = constrained $ \as ->
-  10 <=. sum_ as
-
-listSumForall :: Numbery a => Specification [a]
-listSumForall = constrained $ \xs ->
-  [ forAll xs $ \x -> 1 <. x
-  , assert $ sum_ xs ==. 20
-  ]
-
-listSumRange :: Numbery a => Specification [a]
-listSumRange = constrained $ \xs ->
-  let n = sum_ xs
-   in [ forAll xs $ \x -> 1 <. x
-      , assert $ n <. 20
-      , assert $ 10 <. n
-      ]
-
-listSumRangeUpper :: Numbery a => Specification [a]
-listSumRangeUpper = constrained $ \xs ->
-  let n = sum_ xs
-   in -- All it takes is one big negative number,
-      -- then we can't get enough small ones to exceed 10
-      -- in the number of tries allowed.
-      -- So we make x relatively large ( <. 12), If its is
-      -- relatively small ( <. 5), we can get unlucky.
-      [ forAll xs $ \x -> [x <. 12]
-      , assert $ n <. 20
-      , assert $ 10 <. n
-      ]
-
-listSumRangeRange :: Numbery a => Specification [a]
-listSumRangeRange = constrained $ \xs ->
-  let n = sum_ xs
-   in [ forAll xs $ \x -> [1 <. x, x <. 5]
-      , assert $ n <. 20
-      , assert $ 10 <. n
-      ]
-
-listSumElemRange :: Numbery a => Specification [a]
-listSumElemRange = constrained $ \xs ->
-  let n = sum_ xs
-   in [ forAll xs $ \x -> [1 <. x, x <. 5]
-      , assert $ n `elem_` lit [10, 12 .. 20]
-      ]
-
-listSumPair :: Numbery a => Specification [(a, Int)]
-listSumPair = constrained $ \xs ->
-  [ assert $ foldMap_ fst_ xs ==. 100
-  , forAll' xs $ \x y -> [20 <. x, x <. 30, y <. 100]
-  ]
-
-listEmpty :: Specification [Int]
-listEmpty = constrained $ \xs ->
-  [ forAll xs $ \_ -> False
-  , assert $ length_ xs <=. 10
-  ]
-
-pairListError :: Specification [(Int, Int)]
-pairListError = constrained $ \ps ->
-  [ assert $ length_ ps <=. 10
-  , forAll' ps $ \a b ->
-      [ a `elem_` lit [1 .. 8]
-      , a ==. 9
-      , b ==. a
-      ]
-  ]
-
-listMustSizeIssue :: Specification [Int]
-listMustSizeIssue = constrained $ \xs ->
-  [ 1 `elem_` xs
-  , length_ xs ==. 1
-  ]
-
--- FIX ME, generates but the unsafeExists means it is unsound
-sumListBad :: Specification [Word64]
-sumListBad = constrained $ \xs ->
-  [ forAll xs $ \x -> unsafeExists $ \y -> y ==. x
-  , assert $ sum_ xs ==. lit 10
-  ]
-
-listExistsUnfree :: Specification [Int]
-listExistsUnfree = constrained $ \xs ->
-  [ forAll xs $ \x -> x `satisfies` existsUnfree
-  , assert $ sizeOf_ xs ==. 3
-  ]
-
-listSumShort :: Specification [Int]
-listSumShort = constrained $ \ [var| xs |] ->
-  [ assert $ sizeOf_ xs <=. 4
-  , assert $ sum_ xs <=. 100000
-  , forAll xs $ \ [var| x |] ->
-      [ exists (const $ pure True) $ \b ->
-          whenTrue b $ x <=. 10000000
-      ]
-  ]
-
-appendSize :: Specification ([Int], [Int])
-appendSize = constrained' $ \ [var| xs |] [var| ys |] ->
-  [ assert $ sizeOf_ xs <=. 10
-  , assert $ sizeOf_ (ys ++. xs) <=. 15
-  ]
-
-appendSingleton :: Specification Int
-appendSingleton = constrained $ \ [var| x |] ->
-  10 `elem_` singletonList_ x ++. lit [1, 2, 3]
-
-singletonSubset :: Specification Int
-singletonSubset = constrained $ \ [var| x |] ->
-  fromList_ (singletonList_ x) `subset_` fromList_ (lit [1, 2, 3])
-
-appendSuffix :: Specification ([Int], [Int])
-appendSuffix = constrained' $
-  \ [var|x|] [var|y|] -> assert $ x ==. y ++. lit [4, 5, 6]
-
-appendForAll :: Specification ([Int], [Int])
-appendForAll = constrained' $ \ [var| xs |] [var| ys |] ->
-  [ forAll xs $ \x -> x `elem_` lit [2, 4 .. 10]
-  , assert $ xs ==. ys ++. lit [2, 4, 6]
-  ]
-
--- Some notable error cases that shouldn't succeed
-
-singletonErrorTooMany :: Specification Int
-singletonErrorTooMany = constrained $ \ [var| x |] ->
-  fromList_ (lit [1, 2, 3]) `subset_` fromList_ (singletonList_ x)
-
-singletonErrorTooLong :: Specification Int
-singletonErrorTooLong = constrained $ \ [var| x |] ->
-  2 <=. length_ (singletonList_ x)
-
-appendTooLong :: Specification [Int]
-appendTooLong = constrained $ \ [var| xs |] ->
-  sizeOf_ (lit [1, 2, 3, 4] ++. xs) <=. 3
-
--- | Fails because the cant set is over constrained
-overconstrainedAppend :: Specification ([Int], [Int])
-overconstrainedAppend = constrained' $
-  \ [var|x|] [var|y|] ->
-    [ dependsOn y x
-    , assert $ x ==. lit [1, 2, 3] ++. y
-    , assert $ y ==. lit [4, 5, 6]
-    , assert $ x /=. lit [1, 2, 3, 4, 5, 6]
-    ]
-
-overconstrainedPrefixes :: Specification ([Int], [Int], [Int])
-overconstrainedPrefixes = constrained' $ \ [var| xs |] [var| ys |] [var| zs |] ->
-  [ xs ==. lit [1, 2, 3] ++. ys
-  , xs ==. lit [3, 4, 5] ++. zs
-  ]
-
-overconstrainedSuffixes :: Specification ([Int], [Int], [Int])
-overconstrainedSuffixes = constrained' $ \ [var| xs |] [var| ys |] [var| zs |] ->
-  [ xs ==. ys ++. lit [1, 2, 3]
-  , xs ==. zs ++. lit [3, 4, 5]
-  ]
-
-appendForAllBad :: Specification ([Int], [Int])
-appendForAllBad = constrained' $ \ [var| xs |] [var| ys |] ->
-  [ forAll xs $ \x -> x `elem_` lit [1 .. 10]
-  , assert $ xs ==. ys ++. lit [2, 4, 11]
-  ]
diff --git a/libs/constrained-generators/examples/Constrained/Examples/ManualExamples.hs b/libs/constrained-generators/examples/Constrained/Examples/ManualExamples.hs
deleted file mode 100644
index b88acd0aa6e..00000000000
--- a/libs/constrained-generators/examples/Constrained/Examples/ManualExamples.hs
+++ /dev/null
@@ -1,493 +0,0 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE ViewPatterns #-}
-
-module Constrained.Examples.ManualExamples where
-
-import Constrained.API
-import Data.Set (Set)
-import GHC.Generics
-import GHC.Natural
-import Test.QuickCheck hiding (forAll)
-import qualified Test.QuickCheck as QuickCheck
-
-{- Generating from Specifications, and checking against Specifications -}
-
-prop1 :: Gen Property
-prop1 = do
-  (w, x, y, z) <- arbitrary :: Gen (Int, Int, Int, Int)
-  pure $ (w < x && x < y && y < z) ==> property (w < z)
-
-spec1 :: Specification (Int, Int, Int, Int)
-spec1 = constrained' $ \w x y z -> [w <. x, x <. y, y <. z]
-
-prop2 :: Gen Property
-prop2 = do
-  (w, x, y, z) <- genFromSpec spec1
-  pure $ (w < x && x < y && y < z) ==> property (w < z)
-
-prop3 :: Gen Property
-prop3 = do
-  (w, x, y, z) <- frequency [(9, genFromSpec spec1), (1, arbitrary)]
-  pure $
-    if (w < x && x < y && y < z)
-      then property (w < z)
-      else expectFailure $ property (w < z)
-
-leqPair :: Specification (Int, Int)
-leqPair = constrained $ \p ->
-  match p $ \x y ->
-    assert (x <=. (y +. lit 2))
-
-sumPair :: Specification (Int, Int)
-sumPair = constrained $ \p ->
-  match p $ \x y ->
-    [ assert $ x <=. y
-    , assert $ y >=. 20
-    , assert $ x + y ==. 25
-    ]
-
-ex1 :: Specification Int
-ex1 = constrained $ \_x -> True
-
-ex2 :: Specification Int
-ex2 = constrained $ \x -> x ==. lit 3
-
-ex3 :: Specification Int
-ex3 = constrained $ \x -> [x <=. lit 2, x >=. lit 0]
-
-ex4 :: Specification Int
-ex4 = constrained $ \x -> assert $ x ==. lit 9
-
-{- From Term to Pred
-1.   `assert`
--}
-
--- assert :: IsPred p => p -> Pred
-ex5 :: Specification [Int]
-ex5 = constrained $ \xs -> assert $ elem_ 7 xs
-
-{-  For all elements in a container type (List, Set, Map)
-1.  `forAll`
--}
-
--- forAll :: (Forallable t a, HasSpec t, HasSpec a, IsPred p) =>
---           Term t -> (Term a -> p) -> Pred
--- class Forallable t e | t -> e where
--- instance Ord k => Forallable (Map k v) (k, v)
--- instance Ord a => Forallable (Set a) a
--- instance Forallable [a] a
-
-ex6 :: Specification [Int]
-ex6 = constrained $ \xs ->
-  forAll xs $ \x -> [x <=. 10, x >. 1]
-
-{-  Reification
-1.  `reifies`
-2.  `reify`
-3.  `assertRefified`
--}
-
--- reifies :: (HasSpec a, HasSpec b) => Term b -> Term a -> (a -> b) -> Pred
-ex7 :: Specification (Int, [Int])
-ex7 = constrained $ \pair ->
-  match pair $ \n xs ->
-    reifies n xs sum
-
--- reify :: (HasSpec a, HasSpec b, IsPred p) => Term a -> (a -> b) -> (Term b -> p) -> Pred
-ex8 :: Specification ([Int], [Int])
-ex8 = constrained $ \pair ->
-  match pair $ \xs1 xs2 ->
-    [ assert $ sizeOf_ xs1 <=. 5
-    , forAll xs1 $ \x -> x <=. 10
-    , reify xs1 reverse $ \t -> xs2 ==. t
-    ]
-
--- assertReified :: (HasSpec Bool, HasSpec a) => Term a -> (a -> Bool) -> Pred
-ex9 :: Specification Int
-ex9 = constrained $ \x ->
-  [ assert $ x <=. 10
-  , assertReified x (<= 10)
-  ]
-
-{- Disjunction, choosing between multiple things with the same type
-1.  `CaseOn`, `branch`, `branchW`
-2.  `chooseSpec`
--}
-
-{-
-caseOn
-  :: (HasSpec a, HasSpec (SimpleRep a), HasSimpleRep a,
-      TypeSpec a ~ TypeSpec (SimpleRep a),
-      SimpleRep a
-      ~ Constrained.Generic.SumOver
-          (Constrained.Spec.SumProd.Cases (SimpleRep a)),
-      TypeList (Constrained.Spec.SumProd.Cases (SimpleRep a))) =>
-     Term a
-     -> FunTy
-          (MapList
-             (Weighted Binder) (Constrained.Spec.SumProd.Cases (SimpleRep a)))
-          Pred
--}
-
-data Three = One Int | Two Bool | Three Int deriving (Ord, Eq, Show, Generic)
-
-instance HasSimpleRep Three
-
-instance HasSpec Three
-
-ex10 :: Specification Three
-ex10 = constrained $ \three ->
-  caseOn
-    three
-    (branch $ \i -> i ==. 1) -- One
-    (branch $ \b -> assert (not_ b)) -- Two
-    (branch $ \j -> j ==. 3) -- Three
-
-ex11 :: Specification Three
-ex11 = constrained $ \three ->
-  caseOn
-    three
-    (branchW 1 $ \i -> i <. 0) -- One, weight 1
-    (branchW 2 $ \b -> assert b) -- Two, weight 2
-    (branchW 3 $ \j -> j >. 0) -- Three, weight 3
-
--- chooseSpec:: HasSpec a => (Int, Specification a) -> (Int, Specification a) -> Specification a
-
-ex12 :: Specification (Int, [Int])
-ex12 =
-  chooseSpec
-    ( 5
-    , constrained $ \pair ->
-        match pair $ \tot xs -> [tot >. lit 10, sum_ xs ==. tot, sizeOf_ xs ==. lit 3]
-    )
-    ( 3
-    , constrained $ \pair ->
-        match pair $ \tot xs -> [tot <. lit 10, sum_ xs ==. tot, sizeOf_ xs ==. lit 6]
-    )
-
-{- Primed library functions which are compositions with match
-
-1.  `forAll'`
-2.  `constrained'`
-3.  `reify'`
--}
-
-ex13a :: Specification [(Int, Int)]
-ex13a = constrained $ \xs ->
-  forAll xs $ \x -> match x $ \a b -> a ==. negate b
-
-ex13b :: Specification [(Int, Int)]
-ex13b = constrained $ \xs ->
-  forAll' xs $ \a b -> a ==. negate b
-
-ex14a :: Specification (Int, Int, Int)
-ex14a = constrained $ \triple ->
-  match triple $ \a b c -> [b ==. a + lit 1, c ==. b + lit 1]
-
-ex14b :: Specification (Int, Int, Int)
-ex14b = constrained' $ \a b c -> [b ==. a + lit 1, c ==. b + lit 1]
-
-ex15a :: Specification (Int, Int, Int)
-ex15a = constrained $ \triple ->
-  match triple $ \x1 x2 x3 ->
-    reify x1 (\a -> (a + 1, a + 2)) $ \t ->
-      match t $ \b c -> [x2 ==. b, x3 ==. c]
-
-ex15b :: Specification (Int, Int, Int)
-ex15b = constrained $ \triple ->
-  match triple $ \x1 x2 x3 ->
-    reify' x1 (\a -> (a + 1, a + 2)) $ \b c -> [x2 ==. b, x3 ==. c]
-
-ex15c :: Specification (Int, Int, Int)
-ex15c = constrained' $ \x1 x2 x3 ->
-  reify' x1 (\a -> (a + 1, a + 2)) $ \b c -> [x2 ==. b, x3 ==. c]
-
-{-  Construtors and Selectors
-1.  `onCon`
-2.  `sel`
-4.  `isJust`
--}
-
-ex16 :: Specification Three
-ex16 = constrained $ \three ->
-  caseOn
-    three
-    (branchW 1 $ \i -> i ==. lit 1) -- One, weight 1
-    (branchW 2 $ \b -> assert (not_ b)) -- Two, weight 2
-    (branchW 3 $ \j -> j ==. 3) -- Three, weight 3
-
-ex17 :: Specification Three
-ex17 = constrained $ \three ->
-  [ onCon @"One" three (\x -> x ==. lit 1)
-  , onCon @"Two" three (\x -> not_ x)
-  , onCon @"Three" three (\x -> x ==. lit 3)
-  ]
-
-ex18 :: Specification Three
-ex18 = constrained $ \three -> onCon @"Three" three (\x -> x ==. lit 3)
-
-ex19 :: Specification (Maybe Bool)
-ex19 = constrained $ \mb -> onCon @"Just" mb (\x -> x ==. lit False)
-
-data Dimensions where
-  Dimensions ::
-    { length :: Int
-    , width :: Int
-    , depth :: Int
-    } ->
-    Dimensions
-  deriving (Ord, Eq, Show, Generic)
-
-instance HasSimpleRep Dimensions
-
-instance HasSpec Dimensions
-
-ex20a :: Specification Dimensions
-ex20a = constrained $ \d ->
-  match d $ \l w dp -> [l >. lit 10, w ==. lit 5, dp <. lit 20]
-
-ex20b :: Specification Dimensions
-ex20b = constrained $ \d ->
-  [ sel @0 d >. lit 10
-  , sel @1 d ==. lit 5
-  , sel @2 d <. lit 20
-  ]
-
-width_ :: Term Dimensions -> Term Int
-width_ d = sel @1 d
-
-ex21 :: Specification Dimensions
-ex21 = constrained $ \d -> width_ d ==. lit 1
-
-{- Naming introduced lambda bound Term variables
-1.  [var|name|]
--}
-
-ex22a :: Specification (Int, Int)
-ex22a = constrained $ \pair ->
-  match pair $ \left right -> [left ==. right, left ==. right + lit 1]
-
-ex22b :: Specification (Int, Int)
-ex22b = constrained $ \ [var|pair|] ->
-  match pair $ \ [var|left|] [var|right|] -> [left ==. right, left ==. right + lit 1]
-
-{-  Existential quantifiers
-1.  `exists`
-2.  `unsafeExists`
--}
-
-ex24 :: Specification Int
-ex24 = constrained $ \ [var|oddx|] ->
-  unsafeExists
-    (\ [var|y|] -> [assert $ oddx ==. y + y + 1])
-
-ex25 :: Specification Int
-ex25 = explainSpec ["odd via (y+y+1)"] $
-  constrained $ \ [var|oddx|] ->
-    exists
-      (\eval -> pure (div (eval oddx - 1) 2))
-      (\ [var|y|] -> [assert $ oddx ==. y + y + 1])
-
-{-  Conditionals
-1.  `whenTrue`
-2.  `ifElse`
--}
-
-data Rectangle = Rectangle {wid :: Int, len :: Int, square :: Bool}
-  deriving (Show, Eq, Generic)
-
-instance HasSimpleRep Rectangle
-
-instance HasSpec Rectangle
-
-ex26 :: Specification Rectangle
-ex26 = constrained' $ \w l sq ->
-  [ assert $ w >=. lit 0
-  , assert $ l >=. lit 0
-  , whenTrue sq (assert $ w ==. l)
-  ]
-
-ex27 :: Specification Rectangle
-ex27 = constrained' $ \w l sq ->
-  ifElse
-    sq
-    (assert $ w ==. l)
-    [ assert $ w >=. lit 0
-    , assert $ l >=. lit 0
-    ]
-
-{-  `Explanantions`
-1.  `assertExplain`
-2.  `explanation`
-3.  `ExplainSpec`
--}
-
-ex28a :: Specification (Set Int)
-ex28a = constrained $ \s ->
-  [ assert $ member_ (lit 5) s
-  , forAll s $ \x -> [x >. lit 6, x <. lit 20]
-  ]
-
-ex28b :: Specification (Set Int)
-ex28b = explainSpec ["5 must be in the set"] $
-  constrained $ \s ->
-    [ assert $ member_ (lit 5) s
-    , forAll s $ \x -> [x >. lit 6, x <. lit 20]
-    ]
-
-{-  Operations to define and use Specifications
-1.  `satisfies`
-2.  `equalSpec`
-3.  `notEqualSpec`
-4.  `notMemberSpec`
-5.  `leqSpec`
-6.  `ltSpec`
-7.  `geqSpec`
-8.  `gtSpec`
-5.  `cardinality`
--}
-
-ex29 :: Specification Int
-ex29 = constrained $ \x ->
-  [ assert $ x >=. lit 0
-  , assert $ x <=. lit 5
-  , satisfies x (notMemberSpec [2, 3])
-  ]
-
-{-  Utility functions
-1.  `simplifyTerm`
-2.  `simplifySpec`
-3.  `genFromSpecT`
-4.  `genFromSpec`
-5.  `genFromSpecWithSeed`
-6.  `debugSpec`
--}
-
-{-  Escape Hatch to QuickCheck Gen monad
-1.  `monitor`
--}
-
-ex30 :: Specification (Int, Int)
-ex30 = constrained $ \ [var|p|] ->
-  match p $ \ [var|x|] [var|y|] ->
-    [ assert $ x /=. 0
-    , -- You can use `monitor` to add QuickCheck property modifiers for
-      -- monitoring distribution, like classify, label, and cover, to your
-      -- specification
-      monitor $ \eval ->
-        QuickCheck.classify (eval y > 0) "positive y"
-          . QuickCheck.classify (eval x > 0) "positive x"
-    ]
-
-prop31 :: QuickCheck.Property
-prop31 = forAllSpec ex30 $ \_ -> True
-
-ex32 :: IO ()
-ex32 = QuickCheck.quickCheck $ prop31
-
-ex11m :: Specification Three
-ex11m = constrained $ \three ->
-  [ caseOn
-      three
-      (branchW 1 $ \i -> i <. 0) -- One, weight 1
-      (branchW 2 $ \b -> assert b) -- Two, weight 2
-      (branchW 3 $ \j -> j >. 0) -- Three, weight 3
-  , monitor $ \eval ->
-      case (eval three) of
-        One _ -> QuickCheck.classify True "One should be about 1/6"
-        Two _ -> QuickCheck.classify True "Two should be about 2/6"
-        Three _ -> QuickCheck.classify True "Three should be about 3/6"
-  ]
-
-propex11 :: QuickCheck.Property
-propex11 = forAllSpec ex11m $ \_ -> True
-
-ex33 :: IO ()
-ex33 = QuickCheck.quickCheck $ propex11
-
-{-  Strategy for constraining a large type with many nested sub-components -}
-
-data Nested = Nested Three Rectangle [Int]
-  deriving (Show, Eq, Generic)
-
-instance HasSimpleRep Nested
-
-instance HasSpec Nested
-
-{-
-Problem using TruePred, not monomorphic enough
-skeleton1 :: Specification Nested
-skeleton1 = constrained $ \ [var|nest|] ->
-  match nest $ \ [var|three|] [var|rect|] [var|line|] ->
-    [ (caseOn (three :: Term Three))
-        (branch $ \ _i -> TruePred) -- One,
-        (branch $ \ _k -> TruePred) -- Two,
-        (branch $ \ _j -> TruePred) -- Three,
-    , match rect $ \ [var|_wid|] [var|_len|] [var|_square|] -> TruePred
-    , forAll line $ \ [var|_point|] -> TruePred
-    ]
--}
-
--- By type applying match, branch, and forAll to @Pred , makes it monomorphic
---  Note    type Pred = PredD Deps , so it fixes the type argument of PredD
-skeleton2 :: Specification Nested
-skeleton2 = constrained $ \ [var|nest|] ->
-  match nest $ \ [var|three|] [var|rect|] [var|line|] ->
-    [ (caseOn (three :: Term Three))
-        (branch @Pred $ \_i -> truePred) -- One,
-        (branch @Pred $ \_k -> truePred) -- Two,
-        (branch @Pred $ \_j -> truePred) -- Three,
-    , match @Pred rect $ \ [var|_wid|] [var|_len|] [var|_square|] -> truePred
-    , forAll @Pred line $ \ [var|_point|] -> truePred
-    ]
-
--- We can do a similar thing by introducing `truePred` with the monomorphic type.
-truePred :: Pred
-truePred = mempty
-
-skeleton :: Specification Nested
-skeleton = constrained $ \ [var|nest|] ->
-  match nest $ \ [var|three|] [var|rect|] [var|line|] ->
-    [ (caseOn (three :: Term Three))
-        (branch $ \_i -> truePred) -- One,
-        (branch $ \_k -> truePred) -- Two,
-        (branch $ \_j -> truePred) -- Three,
-    , match rect $ \ [var|_wid|] [var|_len|] [var|_square|] -> [truePred]
-    , forAll line $ \ [var|_point|] -> truePred
-    ]
-
--- ======================================================================
-
-newtype Coin = Coin {unCoin :: Integer} deriving (Eq, Show)
-
-instance HasSimpleRep Coin where
-  type SimpleRep Coin = Natural
-  toSimpleRep (Coin i) = case integerToNatural i of
-    Nothing -> error $ "The impossible happened in toSimpleRep for (Coin " ++ show i ++ ")"
-    Just w -> w
-  fromSimpleRep = naturalToCoin
-
-instance HasSpec Coin
-
-integerToNatural :: Integer -> Maybe Natural
-integerToNatural c
-  | c < 0 = Nothing
-  | otherwise = Just $ fromIntegral c
-
-naturalToCoin :: Natural -> Coin
-naturalToCoin = Coin . fromIntegral
-
-ex34 :: Specification Coin
-ex34 = constrained $ \coin ->
-  match coin $ \nat -> [nat >=. lit 100, nat <=. lit 200]
diff --git a/libs/constrained-generators/examples/Constrained/Examples/Map.hs b/libs/constrained-generators/examples/Constrained/Examples/Map.hs
deleted file mode 100644
index 07ea1776359..00000000000
--- a/libs/constrained-generators/examples/Constrained/Examples/Map.hs
+++ /dev/null
@@ -1,127 +0,0 @@
-{-# LANGUAGE ImportQualifiedPost #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE ViewPatterns #-}
-
-module Constrained.Examples.Map where
-
-import Constrained.API
-import Constrained.Examples.Basic
-import Data.Map (Map)
-import Data.Map qualified as Map
-import Data.Set (Set)
-import Data.Set qualified as Set
-import Data.Word
-
-mapElemSpec :: Specification (Map Int (Bool, Int))
-mapElemSpec = constrained $ \m ->
-  [ assert $ m /=. lit mempty
-  , forAll' (rng_ m) $ \_ b ->
-      [0 <. b, b <. 10]
-  ]
-
-mapPairSpec :: Specification (Map Int Int, Set Int)
-mapPairSpec = constrained' $ \m s ->
-  subset_ (dom_ m) s
-
-mapEmptyDomainSpec :: Specification (Map Int Int)
-mapEmptyDomainSpec = constrained $ \m ->
-  subset_ (dom_ m) mempty -- mempty in the Monoid instance (Term fn (Set a))
-
-mapSubSize :: Specification (Map Int Int)
-mapSubSize = constrained $ \s ->
-  2 ==. 12 - (sizeOf_ s)
-
-knownDomainMap :: Specification (Map Int Int)
-knownDomainMap = constrained $ \m ->
-  [ dom_ m ==. lit (Set.fromList [1, 2])
-  , not_ $ 0 `elem_` rng_ m
-  ]
-
-mapSizeConstrained :: Specification (Map Three Int)
-mapSizeConstrained = constrained $ \m -> sizeOf_ m <=. 3
-
-sumRange :: Specification (Map Word64 Word64)
-sumRange = constrained $ \m -> sum_ (rng_ m) ==. lit 10
-
-fixedRange :: Specification (Map Int Int)
-fixedRange = constrained $ \m ->
-  [ forAll (rng_ m) (\x -> x ==. 5)
-  , assert $ (sizeOf_ m) ==. 1
-  ]
-
-rangeHint :: Specification (Map Int Int)
-rangeHint = constrained $ \m ->
-  genHint 10 (rng_ m)
-
-rangeSumSize :: Specification (Map Int Int)
-rangeSumSize = constrained $ \m ->
-  [ assert $ sizeOf_ m <=. 0
-  , assert $ sum_ (rng_ m) <=. 0
-  , assert $ (-1) <=. sum_ (rng_ m)
-  , forAll' m $ \k v ->
-      [ k ==. (-1)
-      , v ==. 1
-      ]
-  ]
-
-elemSpec :: Specification (Int, Int, Map Int Int)
-elemSpec = constrained' $ \ [var|key|] [var|val|] [var|mapp|] ->
-  [ assert $ key `member_` dom_ mapp
-  , forAll' mapp $ \ [var|k'|] [var|v'|] ->
-      whenTrue (k' ==. key) (v' ==. val)
-  , mapp `dependsOn` key
-  ]
-
-lookupSpecific :: Specification (Int, Int, Map Int Int)
-lookupSpecific = constrained' $ \ [var|k|] [var|v|] [var|m|] ->
-  [ m `dependsOn` k
-  , assert $ lookup_ k m ==. just_ v
-  ]
-
-mapRestrictedValues :: Specification (Map (Either Int ()) Int)
-mapRestrictedValues = constrained $ \m ->
-  [ assert $ sizeOf_ m ==. 6
-  , forAll' m $ \k v ->
-      [ caseOn
-          k
-          (branch $ \_ -> 20 <=. v)
-          (branch $ \_ -> True)
-      , v `dependsOn` k
-      ]
-  ]
-
--- NOTE: this fails if you pick the values of the map first - you're unlikely to generate
--- three values such that two of them are <= -100 and >= 100 respectively even though
--- you take satisfiability of the whole elem constraint into account. This can't be fixed
--- with a `dependsOn v k` because the issue is that we've generated a bunch of values
--- before we ever go to generate the keys.
-mapRestrictedValuesThree :: Specification (Map Three Int)
-mapRestrictedValuesThree = constrained $ \m ->
-  [ assert $ sizeOf_ m ==. 3
-  , forAll' m $ \k v ->
-      [ caseOn
-          k
-          (branch $ \_ -> v <=. (-100))
-          (branch $ \_ -> 100 <=. v)
-          (branch $ \_ -> True)
-      , -- This is important to demonstrate the point that keys sometimes need to be solved before
-        -- values
-        v `dependsOn` k
-      ]
-  ]
-
-mapRestrictedValuesBool :: Specification (Map Bool Int)
-mapRestrictedValuesBool = constrained $ \m ->
-  [ assert $ sizeOf_ m ==. 2
-  , forAll' m $ \k v -> [v `dependsOn` k, whenTrue k (100 <=. v)]
-  ]
-
-mapSetSmall :: Specification (Map (Set Int) Int)
-mapSetSmall = constrained $ \x ->
-  forAll (dom_ x) $ \d ->
-    assert $ subset_ d $ lit (Set.fromList [3 .. 4])
-
--- | this tests the function saturatePred
-mapIsJust :: Specification (Int, Int)
-mapIsJust = constrained' $ \ [var| x |] [var| y |] ->
-  just_ x ==. lookup_ y (lit $ Map.fromList [(z, z) | z <- [100 .. 102]])
diff --git a/libs/constrained-generators/examples/Constrained/Examples/MapMember.hs b/libs/constrained-generators/examples/Constrained/Examples/MapMember.hs
deleted file mode 100644
index c0008d59eeb..00000000000
--- a/libs/constrained-generators/examples/Constrained/Examples/MapMember.hs
+++ /dev/null
@@ -1,126 +0,0 @@
-module Constrained.Examples.MapMember where
-
-import Constrained.API
-import Constrained.TheKnot
-import qualified Data.List.NonEmpty as NE
-import Data.Map.Strict (Map)
-import qualified Data.Map.Strict as Map
-import Test.QuickCheck hiding (forAll)
-
--- ===============================================
--- Three Strategies that work
-
-mapMemberA ::
-  (Ord k, IsNormalType k, IsNormalType v, HasSpec k, HasSpec v) =>
-  Map k v ->
-  Term k ->
-  Term v ->
-  Pred
-mapMemberA m key val =
-  And
-    [ assert $ member_ key (dom_ (lit m))
-    , dependsOn val key
-    , (caseOn (lookup_ key (lit m)))
-        -- Nothing
-        (branch $ \_ -> FalsePred (pure "key not in map, mapMember1"))
-        -- Just
-        (branch $ \x -> assert $ val ==. x)
-    ]
-
-mapMemberB ::
-  (Ord k, IsNormalType v, HasSpec k, HasSpec v, IsNormalType v, IsNormalType k) =>
-  Map k v ->
-  Term k ->
-  Term v ->
-  Pred
-mapMemberB m key val =
-  And
-    [ assert $ member_ key (dom_ (lit m))
-    , assert $ just_ val ==. lookup_ key (lit m)
-    ]
-
-mapMemberC ::
-  (Ord k, HasSpec k, HasSpec v, IsNormalType v, IsNormalType v, IsNormalType k) =>
-  Map k v ->
-  Term k ->
-  Term v ->
-  Pred
-mapMemberC m key val =
-  And
-    [ assert $ member_ key (dom_ (lit m))
-    , forAll (lit m) $ \p -> match p $ \k v -> whenTrue (key ==. k) (assert $ val ==. v)
-    ]
-
--- ===============================================
--- Two Strategies that don't work
-
-mapMemberBad1 ::
-  (Ord k, HasSpec k, HasSpec v, IsNormalType v, IsNormalType k) =>
-  Term [(k, v)] ->
-  Term k ->
-  Term v ->
-  Pred
-mapMemberBad1 m key val =
-  And
-    [ dependsOn key m
-    , dependsOn val m
-    , dependsOn val key
-    , assert $ elem_ (pair_ key val) m
-    ]
-
-mapMemberBad2 ::
-  (Ord k, HasSpec k, HasSpec v, IsNormalType v, IsNormalType k) =>
-  Map k v ->
-  Term k ->
-  Term v ->
-  Pred
-mapMemberBad2 m key val =
-  satisfies
-    (pair_ key val)
-    ( constrained $ \p ->
-        [ dependsOn key p -- This causes a cycle
-        , dependsOn val p
-        , assert $ elem_ p (lit (Map.toList m))
-        ]
-    )
-
--- ====================================================
--- Now some specs that produce results
-
-mm :: Map Int Int
-mm = Map.fromList [(x, x + x) | x <- [2 .. 5]]
-
-spec1 :: Specification (Int, Int)
-spec1 = constrained $ \ [var|p|] ->
-  match p $ \ [var|k|] [var|v|] -> mapMemberA mm k v
-
-spec2 :: Specification (Int, Int)
-spec2 = constrained $ \ [var|p|] ->
-  match p $ \ [var|k|] [var|v|] -> mapMemberB mm k v
-
-spec3 :: Specification (Int, Int)
-spec3 = constrained $ \ [var|p|] ->
-  match p $ \ [var|k|] [var|v|] -> mapMemberC mm k v
-
--- ================================================
--- These do not work and return errors.
-
-spec4 :: Specification (Int, Int)
-spec4 = constrained $ \ [var|p|] ->
-  match p $ \ [var|k|] [var|v|] -> mapMemberBad1 (Lit (Map.toList mm)) k v
-
--- FIX ME Cycle in Graph
-spec5 :: Specification (Int, Int)
-spec5 = constrained $ \ [var|p|] ->
-  match p $ \ [var|k|] [var|v|] -> mapMemberBad2 mm k v
-
-spec6 :: Specification (Int, Int)
-spec6 = constrained' $ \x y ->
-  elem_ (pair_ x y) (Lit [(3, 4), (7, 8), (3, 1), (6, 8), (22, 9), (1, 0), (34, 567), (7, 99)])
-
-pp :: Pred
-pp = Assert (elem_ (pair_ @Int (Lit 3) (Lit (1 :: Int))) (Lit [(3, 4), (7, 8), (3, 1)]))
-
-bar :: Term a -> Maybe String
-bar (FromGeneric (Pair x y)) = Just $ show (x, y)
-bar _ = Nothing
diff --git a/libs/constrained-generators/examples/Constrained/Examples/Set.hs b/libs/constrained-generators/examples/Constrained/Examples/Set.hs
deleted file mode 100644
index 6d4690a3343..00000000000
--- a/libs/constrained-generators/examples/Constrained/Examples/Set.hs
+++ /dev/null
@@ -1,184 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeFamilies #-}
-
-module Constrained.Examples.Set where
-
-import Constrained.API
-import Constrained.Examples.Basic
-import Data.Set (Set)
-import qualified Data.Set as Set
-import Data.Typeable
-import GHC.Generics
-
--- =============================================================
-
-setPairSpec :: Specification (Set Int, Set Int)
-setPairSpec = constrained' $ \s s' ->
-  forAll s $ \x ->
-    forAll s' $ \y ->
-      x <=. y
-
-fixedSetSpec :: Specification (Set Int)
-fixedSetSpec = constrained $ \s ->
-  forAll s $ \x ->
-    [x <=. lit (i :: Int) | i <- [1 .. 3]]
-
-setOfPairLetSpec :: Specification (Set (Int, Int))
-setOfPairLetSpec = constrained $ \ps ->
-  forAll' ps $ \x y ->
-    x <=. y
-
-setSingletonSpec :: Specification (Set (Int, Int))
-setSingletonSpec = constrained $ \ps ->
-  forAll ps $ \p ->
-    forAll (singleton_ (fst_ p)) $ \x ->
-      x <=. 10
-
-eitherSimpleSetSpec :: Specification (Set (Either Int Int))
-eitherSimpleSetSpec = constrained $ \ss ->
-  forAll ss $ \s ->
-    (caseOn s)
-      (branch $ \a -> a <=. 0)
-      (branch $ \b -> 0 <=. b)
-
-forAllAnySpec :: Specification (Set Int)
-forAllAnySpec = constrained $ \as ->
-  forAll as $ \_ -> True
-
-maybeJustSetSpec :: Specification (Set (Maybe Int))
-maybeJustSetSpec = constrained $ \ms ->
-  forAll ms $ \m ->
-    (caseOn m)
-      (branch $ \_ -> False)
-      (branch $ \y -> 0 <=. y)
-
-notSubsetSpec :: Specification (Set Int, Set Int)
-notSubsetSpec = constrained' $ \s s' -> not_ $ subset_ s s'
-
-emptyEitherMemberSpec :: Specification (Set (Either Int Int))
-emptyEitherMemberSpec = constrained $ \s ->
-  forAll s $ \x ->
-    (caseOn x)
-      (branch $ \l -> member_ l mempty)
-      (branch $ \r -> member_ r mempty)
-
-emptyEitherSpec :: Specification (Set (Either Int Int))
-emptyEitherSpec = constrained $ \s ->
-  forAll s $ \x ->
-    (caseOn x)
-      (branch $ \_ -> False)
-      (branch $ \_ -> False)
-
-notSubset :: Specification (Set Int)
-notSubset = constrained $ \s ->
-  not_ $ s `subset_` lit (Set.fromList [1, 2, 3])
-
-unionSized :: Specification (Set Int)
-unionSized = constrained $ \s ->
-  10 ==. sizeOf_ (s <> lit (Set.fromList [1 .. 8]))
-
-maybeSpec :: Specification (Set (Maybe Int))
-maybeSpec = constrained $ \ms ->
-  forAll ms $ \m ->
-    (caseOn m)
-      (branch $ \_ -> False)
-      (branch $ \y -> 0 <=. y)
-
-eitherSetSpec ::
-  Specification (Set (Either Int Int), Set (Either Int Int), Set (Either Int Int))
-eitherSetSpec = constrained' $ \es as bs ->
-  [ assert $ es ==. (as <> bs)
-  , forAll as $ \a ->
-      (caseOn a)
-        (branch $ \a' -> a' <=. 0)
-        (branch $ \b' -> 1 <=. b')
-  , forAll bs $ \b ->
-      (caseOn b)
-        (branch $ \_ -> False)
-        (branch $ \b' -> 1 <=. b')
-  ]
-
-weirdSetPairSpec :: Specification ([Int], Set (Either Int Int))
-weirdSetPairSpec = constrained' $ \as as' ->
-  [ as' `dependsOn` as
-  , forAll as $ \a ->
-      member_ (left_ a) as'
-  , forAll as' $ \a' ->
-      (caseOn a')
-        (branch $ \x -> elem_ x as)
-        (branch $ \_ -> False)
-  ]
-
-setPair :: Specification (Set (Int, Int))
-setPair = constrained $ \s ->
-  [ forAll s $ \p ->
-      p `satisfies` leqPair
-  , assert $ lit (0, 1) `member_` s
-  ]
-
-setSpec :: Specification (Set Int)
-setSpec = constrained $ \ss ->
-  forAll ss $ \s ->
-    s <=. 10
-
-compositionalSpec :: Specification (Set Int)
-compositionalSpec = constrained $ \x ->
-  [ satisfies x setSpec
-  , assert $ 0 `member_` x
-  ]
-
-emptySetSpec :: Specification (Set Int)
-emptySetSpec = constrained $ \s ->
-  forAll s $ \x -> member_ x mempty
-
-setSubSize :: Specification (Set Int)
-setSubSize = constrained $ \s ->
-  2 ==. 12 - (sizeOf_ s)
-
-newtype NotASet a = NotASet (Set a)
-  deriving (Generic, Show, Eq)
-
-instance (Typeable a, Ord a) => HasSimpleRep (NotASet a) where
-  type SimpleRep (NotASet a) = [a]
-  fromSimpleRep = NotASet . Set.fromList
-  toSimpleRep (NotASet s) = Set.toList s
-
-instance (Ord a, HasSpec a) => HasSpec (NotASet a)
-
-instance (Typeable a, Ord a) => Forallable (NotASet a) a
-
-emptyListSpec :: Specification ([Int], NotASet (Either Int Int, Int))
-emptyListSpec = constrained' $ \is ls ->
-  [ forAll is $ \i -> i <=. 0
-  , forAll' ls $ \l _ ->
-      caseOn l (branch $ \_ -> False) (branch $ \_ -> False)
-  ]
-
-foldSingleCase :: Specification Int
-foldSingleCase = constrained $ \x ->
-  [ assert $ not_ $ member_ x (lit (Set.fromList [10]))
-  , letBind (pair_ x $ lit [(10, 20) :: (Int, Int)]) $ \p ->
-      match p $ \_ p1 -> forAll p1 $ \p2 ->
-        assert (0 <=. snd_ p2)
-  ]
-
-complexUnion :: Specification (Set Int, Set Int)
-complexUnion = constrained' $ \ys zs ->
-  [ sizeOf_ ys <=. 10
-  , 0 <. sizeOf_ (ys <> zs)
-  ]
-
-unionBounded :: Specification (Set Int)
-unionBounded = constrained $ \xs ->
-  [ sizeOf_ (xs <> lit (Set.fromList [1, 2, 3])) <=. 3
-  ]
-
--- Only possible value is {4}
-powersetPickOne :: Specification (Set Int)
-powersetPickOne =
-  constrained $ \xs ->
-    [ xs `subset_` lit (Set.fromList [3, 4])
-    , not_ $ xs `elem_` lit [mempty, Set.fromList [3], Set.fromList [3, 4]]
-    ]
diff --git a/libs/constrained-generators/examples/Constrained/Examples/Tree.hs b/libs/constrained-generators/examples/Constrained/Examples/Tree.hs
deleted file mode 100644
index c3bf857abaa..00000000000
--- a/libs/constrained-generators/examples/Constrained/Examples/Tree.hs
+++ /dev/null
@@ -1,113 +0,0 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE TypeApplications #-}
-
-module Constrained.Examples.Tree where
-
-import Constrained.API
-import Constrained.Examples.BinTree
-import Data.Tree
-
-allZeroTree :: Specification (BinTree Int)
-allZeroTree = constrained $ \t ->
-  [ forAll' t $ \_ a _ -> a ==. 0
-  , genHint 10 t
-  ]
-
-isBST :: Specification (BinTree Int)
-isBST = constrained $ \t ->
-  [ forAll' t $ \left a right ->
-      -- TODO: if there was a `binTreeRoot` function on trees
-      -- this wouldn't need to be quadratic as we would
-      -- only check agains the head of the left and right
-      -- subtrees, not _every element_
-      [ forAll' left $ \_ l _ -> l <. a
-      , forAll' right $ \_ h _ -> a <. h
-      ]
-  , genHint 10 t
-  ]
-
-noChildrenSameTree :: Specification (BinTree Int)
-noChildrenSameTree = constrained $ \t ->
-  [ forAll' t $ \left a right ->
-      [ forAll' left $ \_ l _ -> l /=. a
-      , forAll' right $ \_ r _ -> r /=. a
-      ]
-  , genHint 8 t
-  ]
-
-isAllZeroTree :: Specification (Tree Int)
-isAllZeroTree = constrained $ \t ->
-  [ forAll' t $ \a cs ->
-      [ a ==. 0
-      , length_ cs <=. 4
-      ]
-  , genHint (Just 2, 30) t
-  ]
-
-noSameChildrenTree :: Specification (Tree Int)
-noSameChildrenTree = constrained $ \t ->
-  [ forAll' t $ \a cs ->
-      [ assert $ a `elem_` lit [1 .. 8]
-      , forAll cs $ \t' ->
-          forAll' t' $ \b _ ->
-            b /=. a
-      ]
-  , genHint (Just 2, 30) t
-  ]
-
-successiveChildren :: Specification (Tree Int)
-successiveChildren = constrained $ \t ->
-  [ forAll' t $ \a cs ->
-      [ forAll cs $ \t' ->
-          rootLabel_ t' ==. a + 1
-      ]
-  , genHint (Just 2, 10) t
-  ]
-
-successiveChildren8 :: Specification (Tree Int)
-successiveChildren8 = constrained $ \t ->
-  [ t `satisfies` successiveChildren
-  , forAll' t $ \a _ -> a `elem_` lit [1 .. 5]
-  ]
-
-roseTreeList :: Specification [Tree Int]
-roseTreeList = constrained $ \ts ->
-  [ assert $ length_ ts <=. 10
-  , forAll ts $ \t ->
-      [ forAll t $ \_ -> False
-      ]
-  ]
-
-roseTreePairs :: Specification (Tree ([Int], [Int]))
-roseTreePairs = constrained $ \t ->
-  [ assert $ rootLabel_ t ==. lit ([1 .. 10], [1 .. 10])
-  , forAll' t $ \p ts ->
-      forAll ts $ \t' ->
-        fst_ (rootLabel_ t') ==. snd_ p
-  , genHint (Nothing, 10) t
-  ]
-
-roseTreeMaybe :: Specification (Tree (Maybe (Int, Int)))
-roseTreeMaybe = constrained $ \t ->
-  [ forAll' t $ \mp ts ->
-      forAll ts $ \t' ->
-        onJust mp $ \p ->
-          onJust (rootLabel_ t') $ \p' ->
-            fst_ p' ==. snd_ p
-  , forAll' t $ \mp _ -> isJust mp
-  , genHint (Nothing, 10) t
-  ]
-
-badTreeInteraction :: Specification (Tree (Either Int Int))
-badTreeInteraction = constrained $ \t ->
-  [ forAll' t $ \n ts' ->
-      [ isCon @"Right" n
-      , forAll ts' $ \_ -> True
-      ]
-  , forAll' t $ \n ts' ->
-      forAll ts' $ \t' ->
-        [ genHint (Just 4, 10) t'
-        , assert $ rootLabel_ t' ==. n
-        ]
-  , genHint (Just 4, 10) t
-  ]
diff --git a/libs/constrained-generators/src/Constrained/API.hs b/libs/constrained-generators/src/Constrained/API.hs
deleted file mode 100644
index 9d843150dc6..00000000000
--- a/libs/constrained-generators/src/Constrained/API.hs
+++ /dev/null
@@ -1,231 +0,0 @@
-{-# LANGUAGE PatternSynonyms #-}
-
--- | This is the main user-facing API of the library for when you just want to
--- write constraints and simple `HasSpec` instances.
-module Constrained.API (
-  -- * Types
-  Specification,
-  Pred,
-  Term,
-
-  -- * Type classes and constraints
-  HasSpec (..),
-  HasSimpleRep (..),
-  Foldy (..),
-  OrdLike (..),
-  Forallable (..),
-  HasGenHint (..),
-  Sized (..),
-  NumLike (..),
-  GenericallyInstantiated,
-  IsPred,
-  Logic,
-  Semantics,
-  Syntax,
-  Numeric,
-  IsNormalType,
-
-  -- * Core syntax
-  constrained,
-  constrained',
-  match,
-  letBind,
-  assert,
-  assertExplain,
-  assertReified,
-  forAll,
-  forAll',
-  exists,
-  unsafeExists,
-  whenTrue,
-  ifElse,
-  dependsOn,
-  reify,
-  reify',
-  reifies,
-  explanation,
-  monitor,
-  genHint,
-  caseOn,
-  branch,
-  branchW,
-  onCon,
-  isCon,
-  onJust,
-  isJust,
-  lit,
-  con,
-  sel,
-  var,
-  name,
-
-  -- * Function symbols
-
-  -- ** Numbers
-  (<.),
-  (<=.),
-  (>=.),
-  (>.),
-  (==.),
-  (/=.),
-  (+.),
-  (-.),
-  negate_,
-
-  -- ** Booleans
-  not_,
-  (||.),
-
-  -- ** Pairs
-  pair_,
-  fst_,
-  snd_,
-
-  -- ** Either
-  left_,
-  right_,
-
-  -- ** Maybe
-  just_,
-  nothing_,
-
-  -- ** List
-  foldMap_,
-  sum_,
-  elem_,
-  singletonList_,
-  append_,
-  (++.),
-  sizeOf_,
-  null_,
-  length_,
-
-  -- ** Set
-  singleton_,
-  member_,
-  union_,
-  subset_,
-  disjoint_,
-  fromList_,
-
-  -- ** Map
-  dom_,
-  rng_,
-  lookup_,
-  mapMember_,
-  rootLabel_,
-
-  -- ** Generics
-  fromGeneric_,
-  toGeneric_,
-
-  -- * Composing specifications
-  satisfies,
-  chooseSpec,
-  trueSpec,
-  equalSpec,
-  notEqualSpec,
-  notMemberSpec,
-  hasSize,
-  explainSpec,
-  rangeSize,
-  between,
-  typeSpec,
-  defaultMapSpec,
-
-  -- * Generation, Shrinking, and Testing
-
-  -- ** Types
-  GE (..),
-  GenT,
-
-  -- ** Generating
-  genFromSpec,
-  genFromSpecT,
-  genFromSpecWithSeed,
-  genFromSizeSpec,
-  looseGen,
-  strictGen,
-
-  -- ** Shrinking
-  shrinkWithSpec,
-
-  -- ** Debugging
-  debugSpec,
-  printPlan,
-
-  -- ** Testing
-  conformsToSpec,
-  conformsToSpecE,
-  conformsToSpecProp,
-
-  -- ** Building properties
-  monitorSpec,
-  forAllSpec,
-  forAllSpecShow,
-  forAllSpecDiscard,
-
-  -- ** Building generators
-  pureGen,
-  listOfT,
-  oneofT,
-  frequencyT,
-  vectorOfT,
-
-  -- * Utilities
-  unionWithMaybe,
-
-  -- * Re-exports
-  NonEmpty ((:|)),
-) where
-
-import Constrained.AbstractSyntax
-import Constrained.Base
-import Constrained.Conformance
-import Constrained.Core
-import Constrained.FunctionSymbol
-import Constrained.GenT
-import Constrained.Generation
-import Constrained.Generic
-import Constrained.NumOrd
-import Constrained.Properties
-import Constrained.Spec.List
-import Constrained.Spec.Map
-import Constrained.Spec.Set
-import Constrained.Spec.SumProd
-import Constrained.Spec.Tree
-import Constrained.Syntax
-import Constrained.TheKnot
-
-infix 4 /=.
-
--- | Inequality as a constraint
-(/=.) :: HasSpec a => Term a -> Term a -> Term Bool
-a /=. b = not_ (a ==. b)
-
--- | Specialized `sizeOf_`
-length_ :: HasSpec a => Term [a] -> Term Integer
-length_ = sizeOf_
-
-infixr 2 ||.
-
--- | Another name for `or_`
-(||.) ::
-  Term Bool ->
-  Term Bool ->
-  Term Bool
-(||.) = or_
-
-infixr 5 ++.
-
--- | Another name for `append_`
-(++.) :: HasSpec a => Term [a] -> Term [a] -> Term [a]
-(++.) = append_
-
--- | Like `null` on `Term`
-null_ :: (HasSpec a, Sized a) => Term a -> Term Bool
-null_ xs = sizeOf_ xs ==. 0
-
--- | `mempty` for `Specification` without the extra constraints
-trueSpec :: Specification a
-trueSpec = TrueSpec
diff --git a/libs/constrained-generators/src/Constrained/API/Extend.hs b/libs/constrained-generators/src/Constrained/API/Extend.hs
deleted file mode 100644
index a9534977d2a..00000000000
--- a/libs/constrained-generators/src/Constrained/API/Extend.hs
+++ /dev/null
@@ -1,61 +0,0 @@
-{-# LANGUAGE PatternSynonyms #-}
-
--- | This module provides an API for extending the library with new function
--- symbols.
-module Constrained.API.Extend (
-  -- * Abstract syntax
-  SpecificationD (..),
-  pattern TypeSpec,
-  PredD (..),
-  TermD (..),
-  BinderD (..),
-
-  -- * Implementing new functions
-  appTerm,
-  Semantics (..),
-  Syntax (..),
-
-  -- ** The `Logic` instance
-  Logic (..),
-  HOLE (..),
-  pattern Unary,
-  pattern (:<:),
-  pattern (:>:),
-
-  -- ** Built-in 'TypeSpec's
-  PairSpec (..),
-  MapSpec (..),
-  SetSpec (..),
-  NumSpec (..),
-  TreeSpec (..),
-
-  -- * Generics
-  (:::),
-  SOP,
-  algebra,
-  inject,
-
-  -- * Building new `NumSpec`-based instances
-  emptyNumSpec,
-  cardinalNumSpec,
-  combineNumSpec,
-  genFromNumSpec,
-  shrinkWithNumSpec,
-  conformsToNumSpec,
-  toPredsNumSpec,
-  MaybeBounded (..),
-
-  -- * Re-export of `Constrained.API`
-  module Constrained.API,
-) where
-
-import Constrained.API
-import Constrained.AbstractSyntax
-import Constrained.Base
-import Constrained.FunctionSymbol
-import Constrained.Generic
-import Constrained.NumOrd
-import Constrained.Spec.Map
-import Constrained.Spec.Set
-import Constrained.Spec.Tree
-import Constrained.TheKnot
diff --git a/libs/constrained-generators/src/Constrained/AbstractSyntax.hs b/libs/constrained-generators/src/Constrained/AbstractSyntax.hs
deleted file mode 100644
index efc33c975e2..00000000000
--- a/libs/constrained-generators/src/Constrained/AbstractSyntax.hs
+++ /dev/null
@@ -1,395 +0,0 @@
-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DeriveTraversable #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE ImportQualifiedPost #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE UndecidableInstances #-}
-
--- | This module contains the abstract syntax of terms, predicates, and specifications
-module Constrained.AbstractSyntax (
-  TermD (..),
-  runTermE,
-  runTerm,
-  fastInequality,
-  PredD (..),
-  SpecificationD (..),
-  BinderD (..),
-  Weighted (..),
-  mapWeighted,
-  traverseWeighted,
-  AppRequiresD,
-  Syntax (..),
-) where
-
-import Constrained.Core
-import Constrained.DependencyInjection
-import Constrained.Env (Env)
-import Constrained.Env qualified as Env
-import Constrained.FunctionSymbol
-import Constrained.GenT
-import Constrained.Generic
-import Constrained.List
-import Constrained.PrettyUtils
-import Control.Monad.Identity
-import Data.Kind
-import Data.List.NonEmpty qualified as NE
-import Data.String
-import Data.Typeable
-import Prettyprinter hiding (cat)
-import Test.QuickCheck
-
-------------------------------------------------------------------------
--- The first-order term language
-------------------------------------------------------------------------
-
--- $depsExplanation
--- See `Constrained.DependencyInjection` to better understand @deps@ - it's a
--- pointer to postpone having to define `Constrained.Base.HasSpec` and friends here.
-
--- | First-order terms, application, literals, variables. $depsExplanation
-data TermD deps a where
-  App ::
-    AppRequiresD deps t dom rng =>
-    t dom rng ->
-    List (TermD deps) dom ->
-    TermD deps rng
-  Lit :: (Typeable a, Eq a, Show a) => a -> TermD deps a
-  V :: (HasSpecD deps a, Typeable a) => Var a -> TermD deps a
-
--- | Everything required to deal with applications of a function to arguments
--- of type @dom@
-type AppRequiresD deps (t :: [Type] -> Type -> Type) dom rng =
-  ( LogicD deps t
-  , Syntax t
-  , Semantics t
-  , TypeList dom
-  , Eq (t dom rng)
-  , Show (t dom rng)
-  , Typeable t
-  , All Typeable dom
-  , Typeable dom
-  , Typeable rng
-  , All (HasSpecD deps) dom
-  , All Show dom
-  , HasSpecD deps rng
-  , Show rng
-  )
-
-instance Eq (TermD deps a) where
-  V x == V x' = x == x'
-  Lit a == Lit b = a == b
-  App (w1 :: x1) (ts :: List (TermD deps) dom1) == App (w2 :: x2) (ts' :: List (TermD deps) dom2) =
-    case (eqT @dom1 @dom2, eqT @x1 @x2) of
-      (Just Refl, Just Refl) ->
-        w1 == w2
-          && ts == ts'
-      _ -> False
-  _ == _ = False
-
--- Semantics --------------------------------------------------------------
-
--- | Run a term in an environment, with an error if it fails
-runTermE :: forall a deps. Env -> TermD deps a -> Either (NE.NonEmpty String) a
-runTermE env = \case
-  Lit a -> Right a
-  V v -> case Env.lookup env v of
-    Just a -> Right a
-    Nothing -> Left (pure ("Couldn't find " ++ show v ++ " in " ++ show env))
-  App f ts -> do
-    vs <- mapMList (fmap Identity . runTermE env) ts
-    pure $ uncurryList_ runIdentity (semantics f) vs
-
--- | Generalized `runTermE` to `MonadGenError`
-runTerm :: MonadGenError m => Env -> TermD deps a -> m a
-runTerm env x = case runTermE env x of
-  Left msgs -> fatalErrorNE msgs
-  Right val -> pure val
-
--- Utilities --------------------------------------------------------------
-
--- | Sound but not complete inequality on terms
-fastInequality :: TermD deps a -> TermD deps b -> Bool
-fastInequality (V (Var i _)) (V (Var j _)) = i /= j
-fastInequality Lit {} Lit {} = False
-fastInequality (App _ as) (App _ bs) = go as bs
-  where
-    go :: List (TermD deps) as -> List (TermD deps) bs -> Bool
-    go Nil Nil = False
-    go (a :> as') (b :> bs') = fastInequality a b || go as' bs'
-    go _ _ = True
-fastInequality _ _ = True
-
--- Pretty-printing --------------------------------------------------------
-
--- | Syntactic operations are ones that have to do with the structure and appearence of the type. $depsExplanation
-class Syntax (t :: [Type] -> Type -> Type) where
-  isInfix :: t dom rng -> Bool
-  isInfix _ = False
-  prettySymbol ::
-    forall deps dom rng ann.
-    t dom rng ->
-    List (TermD deps) dom ->
-    Int ->
-    Maybe (Doc ann)
-  prettySymbol _ _ _ = Nothing
-
-instance Show a => Pretty (WithPrec (TermD deps a)) where
-  pretty (WithPrec p t) = case t of
-    Lit n -> fromString $ showsPrec p n ""
-    V x -> viaShow x
-    App x Nil -> viaShow x
-    App f as
-      | Just doc <- prettySymbol f as p -> doc -- Use Function Symbol specific pretty printers
-    App f as
-      | isInfix f
-      , a :> b :> Nil <- as ->
-          parensIf (p > 9) $ prettyPrec 10 a <+> viaShow f <+> prettyPrec 10 b
-      | otherwise -> parensIf (p > 10) $ viaShow f <+> align (fillSep (ppListC @Show (prettyPrec 11) as))
-
-instance Show a => Pretty (TermD deps a) where
-  pretty = prettyPrec 0
-
-instance Show a => Show (TermD deps a) where
-  showsPrec p t = shows $ pretty (WithPrec p t)
-
-------------------------------------------------------------------------
--- The language for predicates
-------------------------------------------------------------------------
-
--- | This is _essentially_ a first-order logic with some extra spicyness thrown
--- in to handle things like sum types and the specific problems you get into
--- when generating from constraints (mostly to do with choosing the order in
--- which to generate things). $depsExplanation
-data PredD deps where
-  ElemPred ::
-    (HasSpecD deps a, Show a) =>
-    Bool ->
-    TermD deps a ->
-    NonEmpty a ->
-    PredD deps
-  Monitor :: ((forall a. TermD deps a -> a) -> Property -> Property) -> PredD deps
-  And :: [PredD deps] -> PredD deps
-  Exists ::
-    -- | Constructive recovery function for checking
-    -- existential quantification
-    ((forall b. TermD deps b -> b) -> GE a) ->
-    BinderD deps a ->
-    PredD deps
-  -- This is here because we sometimes need to delay substitution until we're done building
-  -- terms and predicates. This is because our surface syntax relies on names being "a bit"
-  -- lazily bound to avoid infinite loops when trying to create new names.
-  Subst ::
-    ( HasSpecD deps a
-    , Show a
-    ) =>
-    Var a ->
-    TermD deps a ->
-    PredD deps ->
-    PredD deps
-  Let ::
-    TermD deps a ->
-    BinderD deps a ->
-    PredD deps
-  Assert :: TermD deps Bool -> PredD deps
-  Reifies ::
-    ( HasSpecD deps a
-    , HasSpecD deps b
-    , Show a
-    , Show b
-    ) =>
-    -- | This depends on the @a@ term
-    TermD deps b ->
-    TermD deps a ->
-    -- | Recover a useable @b@ value from the @a@ term in normal Haskell land
-    (a -> b) ->
-    PredD deps
-  DependsOn ::
-    ( HasSpecD deps a
-    , HasSpecD deps b
-    , Show a
-    , Show b
-    ) =>
-    TermD deps a ->
-    TermD deps b ->
-    PredD deps
-  ForAll ::
-    ( ForallableD deps t e
-    , HasSpecD deps t
-    , HasSpecD deps e
-    , Show t
-    , Show e
-    ) =>
-    TermD deps t ->
-    BinderD deps e ->
-    PredD deps
-  Case ::
-    ( HasSpecD deps (SumOver as)
-    , Show (SumOver as)
-    ) =>
-    TermD deps (SumOver as) ->
-    -- | Each branch of the type is bound with
-    -- only one variable because `as` are types.
-    -- Constructors with multiple arguments are
-    -- encoded with `ProdOver` (c.f. `Constrained.Univ`).
-    List (Weighted (BinderD deps)) as ->
-    PredD deps
-  -- monadic-style `when` - if the first argument is False the second
-  -- doesn't apply.
-  When ::
-    TermD deps Bool ->
-    PredD deps ->
-    PredD deps
-  GenHintD ::
-    ( HasGenHintD deps a
-    , Show a
-    , Show (HintD deps a)
-    ) =>
-    HintD deps a ->
-    TermD deps a ->
-    PredD deps
-  TruePred :: PredD deps
-  FalsePred :: NE.NonEmpty String -> PredD deps
-  Explain :: NE.NonEmpty String -> PredD deps -> PredD deps
-
--- | Binders, a t`Var` is bound in a `PredD`, never anywhere else
-data BinderD deps a where
-  (:->) ::
-    (HasSpecD deps a, Show a) =>
-    Var a ->
-    PredD deps ->
-    BinderD deps a
-
-deriving instance Show (BinderD deps a)
-
--- | A thing, wrapped in a functor, with a weight
-data Weighted f a = Weighted {weight :: Maybe Int, thing :: f a}
-  deriving (Functor, Traversable, Foldable)
-
--- | Apply a natural transformation to the weighted value
-mapWeighted :: (f a -> g b) -> Weighted f a -> Weighted g b
-mapWeighted f (Weighted w t) = Weighted w (f t)
-
--- | Like `mapWeighted` but `Applicative`
-traverseWeighted :: Applicative m => (f a -> m (g a)) -> Weighted f a -> m (Weighted g a)
-traverseWeighted f (Weighted w t) = Weighted w <$> f t
-
-instance Semigroup (PredD deps) where
-  FalsePred xs <> FalsePred ys = FalsePred (xs <> ys)
-  FalsePred es <> _ = FalsePred es
-  _ <> FalsePred es = FalsePred es
-  TruePred <> p = p
-  p <> TruePred = p
-  p <> p' = And (unpackPred p ++ unpackPred p')
-    where
-      unpackPred (And ps) = ps
-      unpackPred x = [x]
-
-instance Monoid (PredD deps) where
-  mempty = TruePred
-
--- Pretty-printing --------------------------------------------------------
-
-instance Pretty (PredD deps) where
-  pretty = \case
-    ElemPred True term vs ->
-      align $
-        sep
-          [ "memberPred"
-          , pretty term
-          , "(" <> viaShow (length vs) <> " items)"
-          , brackets (fillSep (punctuate "," (map viaShow (NE.toList vs))))
-          ]
-    ElemPred False term vs -> align $ sep ["notMemberPred", pretty term, fillSep (punctuate "," (map viaShow (NE.toList vs)))]
-    Exists _ (x :-> p) -> align $ sep ["exists" <+> viaShow x <+> "in", pretty p]
-    Let t (x :-> p) -> align $ sep ["let" <+> viaShow x <+> "=" /> pretty t <+> "in", pretty p]
-    And ps -> braces $ vsep' $ map pretty ps
-    Assert t -> "assert $" <+> pretty t
-    Reifies t' t _ -> "reifies" <+> pretty (WithPrec 11 t') <+> pretty (WithPrec 11 t)
-    DependsOn a b -> pretty a <+> "<-" /> pretty b
-    ForAll t (x :-> p) -> "forall" <+> viaShow x <+> "in" <+> pretty t <+> "$" /> pretty p
-    Case t bs -> "case" <+> pretty t <+> "of" /> vsep' (ppList pretty bs)
-    When b p -> "whenTrue" <+> pretty (WithPrec 11 b) <+> "$" /> pretty p
-    Subst x t p -> "[" <> pretty t <> "/" <> viaShow x <> "]" <> pretty p
-    GenHintD h t -> "genHint" <+> fromString (showsPrec 11 h "") <+> "$" <+> pretty t
-    TruePred -> "True"
-    FalsePred {} -> "False"
-    Monitor {} -> "monitor"
-    Explain es p -> "Explain" <+> viaShow (NE.toList es) <+> "$" /> pretty p
-
-instance Show (PredD deps) where
-  show = show . pretty
-
-instance Pretty (f a) => Pretty (Weighted f a) where
-  pretty (Weighted Nothing t) = pretty t
-  pretty (Weighted (Just w) t) = viaShow w <> "~" <> pretty t
-
-instance Pretty (BinderD deps a) where
-  pretty (x :-> p) = viaShow x <+> "->" <+> pretty p
-
-------------------------------------------------------------------------
--- The language of specifications
-------------------------------------------------------------------------
-
--- | A @`SpecificationD` deps a@ denotes a set of @a@s. $depsExplanation
-data SpecificationD deps a where
-  -- | Explain a Specification
-  ExplainSpec :: [String] -> SpecificationD deps a -> SpecificationD deps a
-  -- | Elements of a known set
-  MemberSpec ::
-    -- | It must be an element of this list. Try hard not to put duplicates in the List.
-    NE.NonEmpty a ->
-    SpecificationD deps a
-  -- | The empty set
-  ErrorSpec ::
-    NE.NonEmpty String ->
-    SpecificationD deps a
-  -- | The set described by some predicates
-  -- over the bound variable.
-  SuspendedSpec ::
-    HasSpecD deps a =>
-    -- | This variable ranges over values denoted by
-    -- the spec
-    Var a ->
-    -- | And the variable is subject to these constraints
-    PredD deps ->
-    SpecificationD deps a
-  -- | A type-specific spec
-  TypeSpecD ::
-    HasSpecD deps a =>
-    TypeSpecD deps a ->
-    -- | It can't be any of the elements of this set
-    [a] ->
-    SpecificationD deps a
-  -- | Anything
-  TrueSpec :: SpecificationD deps a
-
-instance (Show a, Typeable a, Show (TypeSpecD deps a)) => Pretty (WithPrec (SpecificationD deps a)) where
-  pretty (WithPrec d s) = case s of
-    ExplainSpec es z -> "ExplainSpec" <+> viaShow es <+> "$" /> pretty z
-    ErrorSpec es -> "ErrorSpec" /> vsep' (map fromString (NE.toList es))
-    TrueSpec -> fromString $ "TrueSpec @(" ++ showType @a ++ ")"
-    MemberSpec xs -> "MemberSpec" <+> short (NE.toList xs)
-    SuspendedSpec x p -> parensIf (d > 10) $ "constrained $ \\" <+> viaShow x <+> "->" /> pretty p
-    -- TODO: require pretty for `TypeSpec` to make this much nicer
-    TypeSpecD ts cant ->
-      parensIf (d > 10) $
-        "TypeSpec"
-          /> vsep
-            [ fromString (showsPrec 11 ts "")
-            , viaShow cant
-            ]
-
-instance (Show a, Typeable a, Show (TypeSpecD deps a)) => Pretty (SpecificationD deps a) where
-  pretty = pretty . WithPrec 0
-
-instance (Show a, Typeable a, Show (TypeSpecD deps a)) => Show (SpecificationD deps a) where
-  showsPrec d = shows . pretty . WithPrec d
diff --git a/libs/constrained-generators/src/Constrained/Base.hs b/libs/constrained-generators/src/Constrained/Base.hs
deleted file mode 100644
index 62fa7db96f3..00000000000
--- a/libs/constrained-generators/src/Constrained/Base.hs
+++ /dev/null
@@ -1,981 +0,0 @@
-{-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DefaultSignatures #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE PatternSynonyms #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE UndecidableSuperClasses #-}
-{-# LANGUAGE ViewPatterns #-}
-
--- | This module contains the most basic parts the implementation. Essentially
---   everything to define Specification, HasSpec, HasSimpleRep, Term, Pred, and the Syntax,
---   Semantics, and Logic class. It also has a few HasSpec, HasSimpleRep, and Logic
---   instances for basic types needed to define the default types and methods of HasSpec.
---   It also supplies Eq, Pretty, and Show instances on the syntax (Term, Pred, Binder etc.)
---   because many functions require these instances. It exports functions that define the
---   user interface to the domain embedded language (constrained, forall, exists etc.).
---   And, by design, nothing more.
-module Constrained.Base (
-  -- * Implementing logic propagation
-  Logic (..),
-  pattern (:<:),
-  pattern (:>:),
-  pattern Unary,
-  toCtx,
-  flipCtx,
-  fromListCtx,
-
-  -- * Useful function symbols and patterns for building custom rewrite rules
-  fromGeneric_,
-  toGeneric_,
-  pattern ToGeneric,
-  pattern FromGeneric,
-
-  -- * Syntax for building specifications
-  constrained,
-  notMemberSpec,
-  notEqualSpec,
-  typeSpec,
-  addToErrorSpec,
-  memberSpec,
-  fromSimpleRepSpec,
-  toSimpleRepSpec,
-  explainSpec,
-
-  -- * Instantiated types and helper patterns
-  Term,
-  Specification,
-  Pred,
-  Binder,
-  pattern TypeSpec,
-  pattern GenHint,
-
-  -- * Constraints and classes
-  HasSpec (..),
-  HasGenHint (..),
-  Forallable,
-  AppRequires,
-  GenericallyInstantiated,
-  GenericRequires,
-
-  -- * Building `Pred`, `Specification`, `Term` etc.
-  bind,
-  name,
-
-  -- * TODO: documentme
-  propagateSpec,
-  appFun,
-  errorLikeMessage,
-  isErrorLike,
-  BinaryShow (..),
-  toPred,
-  forAllToList,
-  IsPred,
-  equalSpec,
-  appTerm,
-  HOLE (..),
-  fromForAllSpec,
-  Fun (..),
-  BaseW (..),
-) where
-
-import Constrained.AbstractSyntax
-import Constrained.Core
-import Constrained.DependencyInjection
-import Constrained.FunctionSymbol
-import Constrained.GenT
-import Constrained.Generic
-import Constrained.List hiding (toList)
-import Constrained.PrettyUtils
-import Constrained.TypeErrors
-import Control.Monad.Writer (
-  Writer,
-  tell,
- )
-import Data.Foldable (
-  toList,
- )
-import Data.Kind (Constraint, Type)
-import qualified Data.List.NonEmpty as NE
-import Data.Orphans ()
-import Data.Semigroup (Max (..), getMax)
-import Data.Typeable
-import GHC.Stack
-import Prettyprinter hiding (cat)
-import Test.QuickCheck (arbitrary, shrink)
-
-newtype TypeSpecF a = TypeSpecF (TypeSpec a)
-
-instance Show (TypeSpec a) => Show (TypeSpecF a) where
-  show (TypeSpecF ts) = show ts
-
-newtype HintF a = HintF (Hint a)
-
-instance Show (Hint a) => Show (HintF a) where
-  show (HintF h) = show h
-
-data Deps
-
-instance Dependencies Deps where
-  type HasSpecD Deps = HasSpec
-  type TypeSpecD Deps = TypeSpecF
-  type LogicD Deps = Logic
-  type ForallableD Deps = Forallable
-  type HasGenHintD Deps = HasGenHint
-  type HintD Deps = HintF
-
--- | Binders instantiated with the correct `HasSpec` etc. classes
-type Binder = BinderD Deps
-
--- | All the constraints needed for application in the first order term languge
-type AppRequires t as b = AppRequiresD Deps t as b
-
--- | Predicates over `Term`s
-type Pred = PredD Deps
-
--- | First-order language of variables, literals, and application
-type Term = TermD Deps
-
--- | Specifications for generators instantiated with the `HasSpec` et al actual
--- classes
-type Specification = SpecificationD Deps
-
--- | Pattern match out a `TypeSpec` and the can't-"set" - avoids some tedious
--- pitfalls related to the `Deps` and `Dependencies` trick
-pattern TypeSpec :: () => HasSpec a => TypeSpec a -> [a] -> Specification a
-pattern TypeSpec ts cant = TypeSpecD (TypeSpecF ts) cant
-
-{-# COMPLETE ExplainSpec, MemberSpec, ErrorSpec, SuspendedSpec, TypeSpec, TrueSpec #-}
-
--- | Build a specifiation from just a `TypeSpec`, useful internal function when
--- writing `Logic` instances
-typeSpec :: HasSpec a => TypeSpec a -> Specification a
-typeSpec ts = TypeSpec ts mempty
-
--- | Pattern match out a `Hint` and the `Term` it applies to - avoids some
--- tedious pitfalls related to the `Deps` and `Dependencies` trick
-pattern GenHint :: () => HasGenHint a => Hint a -> Term a -> Pred
-pattern GenHint h t = GenHintD (HintF h) t
-
-{-# COMPLETE
-  ElemPred
-  , Monitor
-  , And
-  , Exists
-  , Subst
-  , Let
-  , Assert
-  , Reifies
-  , DependsOn
-  , ForAll
-  , Case
-  , When
-  , GenHint
-  , TruePred
-  , FalsePred
-  , Explain
-  #-}
-
--- ====================================================================
-
--- A First-order typed logic has 4 components
---     1. Terms        (Variables (x), Constants (5), and Applications (F x 5)
---        Applications, apply a function symbol to a list of arguments: (FunctionSymbol term1 .. termN)
---     2. Predicates   (Ordered, Odd, ...)
---     3. Connectives  (And, Or, Not, =>, ...)
---     4. Quantifiers  (Forall, Exists)
---
--- The Syntax, Semantics, and Logic classes implement new function symbols in
--- the first order logic. Note that a function symbol is first order
--- data, that uniquely identifies a higher order function. The three classes
--- supply varying levels of functionality, relating to the Syntax, Semantics, and
--- Logical operations of the function symbol.
-
--- | Logical operations are one that support reasoning about how a function symbol
---   relates to logical properties, that we call Specification's
-class (Typeable t, Semantics t, Syntax t) => Logic t where
-  {-# MINIMAL propagate | (propagateTypeSpec, propagateMemberSpec) #-}
-
-  propagateTypeSpec ::
-    (AppRequires t as b, HasSpec a) =>
-    t as b ->
-    ListCtx Value as (HOLE a) ->
-    TypeSpec b ->
-    [b] ->
-    Specification a
-  propagateTypeSpec f ctx ts cant = propagate f ctx (TypeSpec ts cant)
-
-  propagateMemberSpec ::
-    (AppRequires t as b, HasSpec a) =>
-    t as b ->
-    ListCtx Value as (HOLE a) ->
-    NonEmpty b ->
-    Specification a
-  propagateMemberSpec f ctx xs = propagate f ctx (MemberSpec xs)
-
-  propagate ::
-    (AppRequires t as b, HasSpec a) =>
-    t as b ->
-    ListCtx Value as (HOLE a) ->
-    Specification b ->
-    Specification a
-  propagate f ctx (ExplainSpec es s) = explainSpec es (propagate f ctx s)
-  propagate _ _ TrueSpec = TrueSpec
-  propagate _ _ (ErrorSpec es) = ErrorSpec es
-  propagate f ctx (SuspendedSpec v ps) = constrained $ \v' -> Let (App f (fromListCtx ctx v')) (v :-> ps) :: Pred
-  propagate f ctx (TypeSpec ts cant) = propagateTypeSpec f ctx ts cant
-  propagate f ctx (MemberSpec xs) = propagateMemberSpec f ctx xs
-
-  rewriteRules ::
-    (TypeList dom, Typeable dom, HasSpec rng, All HasSpec dom) =>
-    t dom rng ->
-    List Term dom ->
-    Evidence (AppRequires t dom rng) ->
-    Maybe (Term rng)
-  rewriteRules _ _ _ = Nothing
-
-  mapTypeSpec ::
-    forall a b.
-    (HasSpec a, HasSpec b) =>
-    t '[a] b ->
-    TypeSpec a ->
-    Specification b
-  mapTypeSpec _ts _spec = TrueSpec
-
-  saturate :: t dom Bool -> List Term dom -> [Pred]
-  saturate _symbol _ = []
-
--- | This is where the logical properties of a function symbol are applied to transform one spec into another
--- Note if there is a bunch of functions nested together, like (sizeOf_ (elems_ (snd_ x)))
--- we propagate each of those nested function symbols over the current spec, one at a time.
--- The result of this propagation is then made the current spec in the recusive calls to 'propagateSpec'
-propagateSpec ::
-  forall v a.
-  HasSpec v =>
-  Specification a ->
-  Ctx v a ->
-  Specification v
-propagateSpec spec = \case
-  CtxHOLE -> spec
-  CtxApp f (ListCtx pre c suf)
-    | Evidence <- ctxHasSpec c -> propagateSpec (propagate f (ListCtx pre HOLE suf) spec) c
-
-ctxHasSpec :: Ctx v a -> Evidence (HasSpec a)
-ctxHasSpec CtxHOLE = Evidence
-ctxHasSpec CtxApp {} = Evidence
-
--- | Contexts for Terms, basically a term with a _single_ HOLE
--- instead of a variable. This is used to traverse the defining
--- constraints for a variable and turn them into a spec. Each
--- subterm `f vs Ctx vs'` for lists of values `vs` and `vs'`
--- gets given to the `propagateSpecFun` for `f` as  `(f vs HOLE vs')`.
-data Ctx v a where
-  -- | A single hole of type `v`. Note ctxHOLE is a nullary constructor, where the `a` type index is the same as the `v` type index.
-  CtxHOLE ::
-    HasSpec v =>
-    Ctx v v
-  -- | The application `f vs Ctx vs'`
-  CtxApp ::
-    ( AppRequires fn as b
-    , HasSpec b
-    , TypeList as
-    , Typeable as
-    , All HasSpec as
-    , Logic fn
-    ) =>
-    fn as b ->
-    -- This is basically a `List` where
-    -- everything is `Value` except for
-    -- one entry which is `Ctx fn v`.
-    ListCtx Value as (Ctx v) ->
-    Ctx v b
-
--- | This is used together with `ListCtx` to form
--- just the arguments to `f vs Ctx vs'` - replacing
--- `Ctx` with `HOLE`, to get a `ListCtx Value as (HOLE a)` which then can be used as an input to `propagate`.
-data HOLE a b where
-  HOLE :: HOLE a a
-
--- | Try to convert a `Term` to a single-hole context - works only if the `Var`
--- is the _only_ variable in the term _and_ it appears only once in the `Term`.
-toCtx ::
-  forall m v a.
-  ( Typeable v
-  , Show v
-  , MonadGenError m
-  , HasCallStack
-  ) =>
-  Var v ->
-  Term a ->
-  m (Ctx v a)
-toCtx v = go
-  where
-    go :: forall b. Term b -> m (Ctx v b)
-    go (Lit i) =
-      fatalErrorNE $
-        NE.fromList
-          [ "toCtx applied to literal: (Lit " ++ show i ++ ")"
-          , "A context is always constructed from an (App f xs) term."
-          ]
-    go (App f as) = CtxApp f <$> toCtxList v as
-    go (V v')
-      | Just Refl <- eqVar v v' = pure $ CtxHOLE
-      | otherwise =
-          fatalErrorNE $
-            NE.fromList
-              [ "A context is always constructed from an (App f xs) term,"
-              , "with a single occurence of the variable " ++ show v ++ "@(" ++ show (typeOf v) ++ ")"
-              , "Instead we found an unknown variable " ++ show v' ++ "@(" ++ show (typeOf v') ++ ")"
-              ]
-
--- | `toCtx` lifted to a `List` of `Term`s
-toCtxList ::
-  forall m v as.
-  (Show v, Typeable v, MonadGenError m, HasCallStack) =>
-  Var v ->
-  List Term as ->
-  m (ListCtx Value as (Ctx v))
-toCtxList v xs = prefix xs
-  where
-    prefix :: forall as'. HasCallStack => List Term as' -> m (ListCtx Value as' (Ctx v))
-    prefix Nil = fatalError ("toCtxList without hole, for variable " ++ show v)
-    prefix (Lit l :> ts) = do
-      ctx <- prefix ts
-      pure $ Value l :! ctx
-    prefix (t :> ts) = do
-      hole <- toCtx v t
-      suf <- suffix ts
-      pure $ hole :? suf
-
-    suffix :: forall as'. List Term as' -> m (List Value as')
-    suffix Nil = pure Nil
-    suffix (Lit l :> ts) = (Value l :>) <$> suffix ts
-    suffix (_ :> _) = fatalErrorNE $ NE.fromList ["toCtxList with too many holes, for variable " ++ show v]
-
--- | A Convenient pattern for singleton contexts
-pattern Unary :: HOLE a' a -> ListCtx f '[a] (HOLE a')
-pattern Unary h = NilCtx h
-
-{-# COMPLETE Unary #-}
-
--- | Convenient patterns for binary contexts (the arrow :<: points towards the hole)
-pattern (:<:) :: (Typeable b, Show b) => HOLE c a -> b -> ListCtx Value '[a, b] (HOLE c)
-pattern h :<: a = h :? Value a :> Nil
-
--- | Convenient patterns for binary contexts (the arrow :>: points towards the hole)
-pattern (:>:) :: (Typeable a, Show a) => a -> HOLE c b -> ListCtx Value '[a, b] (HOLE c)
-pattern a :>: h = Value a :! NilCtx h
-
-{-# COMPLETE (:<:), (:>:) #-}
-
--- | Flip a binary context around
-flipCtx ::
-  (Typeable a, Show a, Typeable b, Show b) =>
-  ListCtx Value '[a, b] (HOLE c) -> ListCtx Value '[b, a] (HOLE c)
-flipCtx (HOLE :<: x) = x :>: HOLE
-flipCtx (x :>: HOLE) = HOLE :<: x
-
--- | From a ListCtx, build a (List Term as), to which the function symbol can be applied.
-fromListCtx :: All HasSpec as => ListCtx Value as (HOLE a) -> Term a -> List Term as
-fromListCtx ctx t = fillListCtx (mapListCtxC @HasSpec (\(Value a) -> Lit a) ctx) (\HOLE -> t)
-
--- =================================================================
--- The class (HasSpec a) tells us what operations type 'a' must
--- support to add it to the constraint solver and generator
--- Writing HasSpec instances gives the system the power to grow
--- Don't be afraid of all the methods. Most have default implementations.
--- =================================================================
-
--- | A type where the `HasSpec` instance has been instantiated via the `SimpleRep` with
--- constraints that give good type errors
-type GenericallyInstantiated a =
-  ( AssertComputes
-      (SimpleRep a)
-      ( Text "Trying to use a generic instantiation of "
-          :<>: ShowType a
-          :<>: Text ", likely in a HasSpec instance."
-          :$$: Text
-                 "However, the type has no definition of SimpleRep, likely because of a missing instance of HasSimpleRep."
-      )
-  , HasSimpleRep a
-  , HasSpec (SimpleRep a)
-  , TypeSpec a ~ TypeSpec (SimpleRep a)
-  )
-
--- | `Eq` and `Show` for `TypeSpec` with additional constraints to ensure good type errors
-type TypeSpecEqShow a =
-  ( AssertComputes
-      (TypeSpec a)
-      ( Text "Can't compute "
-          :<>: ShowType (TypeSpec a)
-          :$$: Text "Either because of a missing definition of TypeSpec or a missing instance of HasSimpleRep."
-      )
-  , Show (TypeSpec a)
-  , Typeable (TypeSpec a)
-  )
-
-{- NOTE: type errors in constrained-generators
-    It's easy to make a mistake like this:
-      data Bad = Bad | Worse deriving (Eq, Show)
-      instance HasSpec Bad
-    Missing that this requires an instance of HasSimpleRep for Bad to work.
-    The two `AssertComputes` uses above are here to give you better error messages when you make this mistake,
-    e.g. giving you something like this:
-      src/Constrained/Examples/Basic.hs:327:10: error: [GHC-64725]
-          • Can't compute TypeSpec (SimpleRep Bad)
-            Either because of a missing definition of TypeSpec or a missing instance of HasSimpleRep.
-          • In the instance declaration for ‘HasSpec Bad’
-          |
-      327 | instance HasSpec Bad
-          |          ^^^^^^^^^^^
-
-      src/Constrained/Examples/Basic.hs:327:10: error: [GHC-64725]
-          • Trying to use a generic instantiation of Bad, likely in a HasSpec instance.
-            However, the type has no definition of SimpleRep, likely because of a missing instance of HasSimpleRep.
-          • In the expression: Constrained.Base.$dmemptySpec @(Bad)
-            In an equation for ‘emptySpec’:
-                emptySpec = Constrained.Base.$dmemptySpec @(Bad)
-            In the instance declaration for ‘HasSpec Bad’
-          |
-      327 | instance HasSpec Bad
-          |          ^^^^^^^^^^^
--}
-
--- | Class for talking about types that we can write `Specification`s about
-class
-  ( Typeable a
-  , Eq a
-  , Show a
-  , TypeSpecEqShow a
-  ) =>
-  HasSpec a
-  where
-  -- | The `TypeSpec a` is the type-specific `Specification a`.
-  type TypeSpec a
-
-  type TypeSpec a = TypeSpec (SimpleRep a)
-
-  -- `TypeSpec` behaves sort-of like a monoid with a neutral
-  -- element `emptySpec` and a `combineSpec` for combining
-  -- two `TypeSpec a`. However, in order to provide flexibilty
-  -- `combineSpec` takes two `TypeSpec` and constucts a `Specification`. This
-  -- avoids e.g. having to have a separate implementation of `ErrorSpec`
-  -- and `MemberSpec` in `TypeSpec`.
-
-  -- | Trivial `TypeSpec` that admits anything
-  emptySpec :: TypeSpec a
-
-  -- | Conjunction of two `TypeSpec`s
-  combineSpec :: TypeSpec a -> TypeSpec a -> Specification a
-
-  -- | Generate a value that satisfies the `TypeSpec`.
-  -- The key property for this generator is soundness:
-  --  ∀ a ∈ genFromTypeSpec spec. a `conformsTo` spec
-  genFromTypeSpec :: (HasCallStack, MonadGenError m) => TypeSpec a -> GenT m a
-
-  -- | Check conformance to the spec.
-  conformsTo :: HasCallStack => a -> TypeSpec a -> Bool
-
-  -- | Shrink an `a` with the aide of a `TypeSpec`
-  shrinkWithTypeSpec :: TypeSpec a -> a -> [a]
-
-  -- | Convert a spec to predicates:
-  -- The key property here is:
-  --   ∀ a. a `conformsTo` spec == a `conformsTo` constrained (\t -> toPreds t spec)
-  toPreds :: Term a -> TypeSpec a -> Pred
-
-  -- | Compute an upper and lower bound on the number of solutions genFromTypeSpec might return
-  cardinalTypeSpec :: TypeSpec a -> Specification Integer
-
-  -- | A bound on the number of solutions `genFromTypeSpec TrueSpec` can produce.
-  --   For a type with finite elements, we can get a much more accurate
-  --   answer than TrueSpec
-  cardinalTrueSpec :: Specification Integer
-  cardinalTrueSpec = TrueSpec
-
-  -- Each instance can decide if a TypeSpec has an Error, and what String
-  -- to pass to ErrorSpec to create an ErrorSpec value. Particulary
-  -- useful for type Sum and Prod. The default instance uses guardTypeSpec,
-  -- which also has a default value, and if that defualt value is used, typeSpecHasError will
-  -- return Nothing. Both 'typeSpecHasError' and 'guardTypeSpec' can be set individually.
-  -- If you're only writing one of these non default values, give it to 'guardTypeSpec'
-  typeSpecHasError :: TypeSpec a -> Maybe (NE.NonEmpty String)
-  typeSpecHasError tspec = case guardTypeSpec @a [] tspec of
-    ErrorSpec msgs -> Just msgs
-    _ -> Nothing
-
-  -- Some binary TypeSpecs, which nest to the right
-  -- e.g. something like this (X a (TypeSpec (X b (TypeSpec (X c w))))))
-  -- An would look better in Vertical mode as (X [a,b,c] m).
-  -- This lets each HasSpec instance decide. Particulary useful for type Sum and Prod
-  alternateShow :: TypeSpec a -> BinaryShow
-  alternateShow _ = NonBinary
-
-  monadConformsTo :: a -> TypeSpec a -> Writer [String] Bool
-  monadConformsTo x spec =
-    if conformsTo @a x spec
-      then pure True
-      else tell ["Fails by " ++ show spec] >> pure False
-
-  -- | For some types (especially finite ones) there may be much better ways to construct
-  --   a Specification than the default method of just adding a large 'bad' list to TypSpec. This
-  --   function allows each HasSpec instance to decide.
-  typeSpecOpt :: TypeSpec a -> [a] -> Specification a
-  typeSpecOpt tySpec bad = TypeSpec tySpec bad
-
-  -- | This can be used to detect self inconsistencies in a (TypeSpec t)
-  --   Note this is similar to 'typeSpecHasError', and the default
-  --   value for 'typeSpecHasError' is written in terms of 'guardTypeSpec'
-  --   Both 'typeSpecHasError' and 'guardTypeSpec' can be set individually.
-  guardTypeSpec :: [String] -> TypeSpec a -> Specification a
-  guardTypeSpec _ ty = typeSpec ty
-
-  -- | Prerequisites for the instance that are sometimes necessary
-  -- when working with e.g. `Specification`s or functions in the universe.
-  type Prerequisites a :: Constraint
-
-  type Prerequisites a = ()
-
-  -- | Materialize the `Prerequisites` dictionary. It should not be necessary to
-  -- implement this function manually.
-  prerequisites :: Evidence (Prerequisites a)
-  default prerequisites :: Prerequisites a => Evidence (Prerequisites a)
-  prerequisites = Evidence
-
-  {- NOTE: Below follows default implementations for the functions in this
-     class based on Generics.  They are meant to provide an implementation of
-     `HasSpec a` when `HasSimpleRep a` and `HasSpec (SimpleRep a)`. For example,
-     for a newtype wrapper like `newtype Foo = Foo Word64` we can define `SimpleRep
-     Foo = Word64` with the requisite instance for `HasSimpleRep` (all of which
-     is derived from `Generic Foo`) and the instance for `HasSpec Foo` is
-     essentially the same as the instance for `Word64`. This is achieved by
-     ensuring that `TypeSpec Foo = TypeSpec Word64` (c.f. the default
-     implementation of `TypeSpec` above). To this end, the implementations
-     below simply convert the relevant things between `SimpleRep a` and `a`.
-     For example, in the implementation of `combineSpec s s'` we treat `s` and
-     `s'` (which have type `TypeSpec a`) as `TypeSpec (SimpleRep a)`,
-     combine them, and go from the resulting `Specification (SimpleRep a)` to `Specification
-     a` using `fromSimpleRepSpec`.
-   -}
-
-  default emptySpec :: GenericallyInstantiated a => TypeSpec a
-  emptySpec = emptySpec @(SimpleRep a)
-
-  default combineSpec ::
-    GenericallyInstantiated a =>
-    TypeSpec a ->
-    TypeSpec a ->
-    Specification a
-  combineSpec s s' = fromSimpleRepSpec $ combineSpec @(SimpleRep a) s s'
-
-  default genFromTypeSpec ::
-    (GenericallyInstantiated a, HasCallStack, MonadGenError m) =>
-    TypeSpec a ->
-    GenT m a
-  genFromTypeSpec s = fromSimpleRep <$> genFromTypeSpec s
-
-  default conformsTo ::
-    (GenericallyInstantiated a, HasCallStack) =>
-    a ->
-    TypeSpec a ->
-    Bool
-  a `conformsTo` s = conformsTo (toSimpleRep a) s
-
-  default toPreds ::
-    GenericallyInstantiated a =>
-    Term a ->
-    TypeSpec a ->
-    Pred
-  toPreds v s = toPreds (toGeneric_ v) s
-
-  default shrinkWithTypeSpec ::
-    GenericallyInstantiated a =>
-    TypeSpec a ->
-    a ->
-    [a]
-  shrinkWithTypeSpec spec a = map fromSimpleRep $ shrinkWithTypeSpec spec (toSimpleRep a)
-
-  default cardinalTypeSpec ::
-    GenericallyInstantiated a =>
-    TypeSpec a ->
-    Specification Integer
-  cardinalTypeSpec = cardinalTypeSpec @(SimpleRep a)
-
-------------------------------------------------------------------------
--- Some instances of HasSpec
-------------------------------------------------------------------------
-
--- | NOTE: this instance means we have to use `ifElse`, `whenTrue`, and `whenFalse` instead
--- of `caseOn` for `Bool`
-instance HasSpec Bool where
-  type TypeSpec Bool = ()
-  emptySpec = ()
-  combineSpec _ _ = typeSpec ()
-  genFromTypeSpec _ = pureGen arbitrary
-  cardinalTypeSpec _ = equalSpec 2
-  cardinalTrueSpec = equalSpec 2
-  shrinkWithTypeSpec _ = shrink
-  conformsTo _ _ = True
-  toPreds _ _ = TruePred
-
-instance HasSpec () where
-  type TypeSpec () = ()
-  emptySpec = ()
-  combineSpec _ _ = typeSpec ()
-  _ `conformsTo` _ = True
-  shrinkWithTypeSpec _ _ = []
-  genFromTypeSpec _ = pure ()
-  toPreds _ _ = TruePred
-  cardinalTypeSpec _ = MemberSpec (pure 1)
-  cardinalTrueSpec = equalSpec 1
-  typeSpecOpt _ [] = TrueSpec
-  typeSpecOpt _ (_ : _) = ErrorSpec (pure "Non null 'cant' set in typeSpecOpt @()")
-
--- ===================================================================
--- toGeneric and fromGeneric as Function Symbols
--- That means they can be used inside (Term a)
--- ===================================================================
-
--- | The things you need to know to work with the generics which translates things
--- into their SimpleRep, made of Sum and Prod
-type GenericRequires a =
-  ( HasSpec a -- This gives Show, Eq, and Typeable instances
-  , GenericallyInstantiated a
-  )
-
--- | The constructors of BaseW, are first order data (i.e Function Symbols) that describe functions.
--- The Base functions are just the functions neccessary to define Specification, and the classes
--- HasSimpleRep, HasSpec, Syntax, Semantics, and Logic. We call BaseW a 'witness type', and use
--- the convention that all witness types (and their constructors) have "W" as thrit last character.
-data BaseW (dom :: [Type]) (rng :: Type) where
-  ToGenericW :: GenericRequires a => BaseW '[a] (SimpleRep a)
-  FromGenericW :: GenericRequires a => BaseW '[SimpleRep a] a
-
-deriving instance Eq (BaseW dom rng)
-
-instance Show (BaseW d r) where
-  show ToGenericW = "toSimpleRep"
-  show FromGenericW = "fromSimpleRep"
-
-instance Syntax BaseW where
-  prettySymbol ToGenericW (x :> Nil) p = Just $ "to" <+> pretty (WithPrec p x)
-  prettySymbol FromGenericW (x :> Nil) p = Just $ "from" <+> pretty (WithPrec p x)
-
-instance Semantics BaseW where
-  semantics FromGenericW = fromSimpleRep
-  semantics ToGenericW = toSimpleRep
-
--- -- ============== ToGenericW Logic instance
-
-instance Logic BaseW where
-  propagateTypeSpec ToGenericW (Unary HOLE) s cant = TypeSpec s (fromSimpleRep <$> cant)
-  propagateTypeSpec FromGenericW (Unary HOLE) s cant = TypeSpec s (toSimpleRep <$> cant)
-
-  propagateMemberSpec ToGenericW (Unary HOLE) es = MemberSpec (fmap fromSimpleRep es)
-  propagateMemberSpec FromGenericW (Unary HOLE) es = MemberSpec (fmap toSimpleRep es)
-
-  mapTypeSpec ToGenericW ts = typeSpec ts
-  mapTypeSpec FromGenericW ts = typeSpec ts
-
-  rewriteRules ToGenericW (FromGeneric x :> Nil) Evidence = Just x
-  rewriteRules (FromGenericW :: BaseW dom rng) (ToGeneric (x :: Term a) :> Nil) Evidence
-    | Just Refl <- eqT @rng @a = Just x
-  rewriteRules _ _ _ = Nothing
-
--- | Convert an @a@ to a @`SimpleRep` a@
-toGeneric_ ::
-  forall a.
-  GenericRequires a =>
-  Term a ->
-  Term (SimpleRep a)
-toGeneric_ = appTerm ToGenericW
-
--- | Convert an @`SimpleRep` a@ to an @a@
-fromGeneric_ ::
-  forall a.
-  (GenericRequires a, AppRequires BaseW '[SimpleRep a] a) =>
-  Term (SimpleRep a) ->
-  Term a
-fromGeneric_ = appTerm FromGenericW
-
--- ====================================================================
--- Generic Transformers
--- Using Generics to transform from ordinary (Specifications a) to
--- Specifications over 'a's SimpleRep (Specification (SimpleRep a))
--- ====================================================================
-
--- | Convert a `Specification` for a @`SimpleRep` a@ to one for @a@
-fromSimpleRepSpec ::
-  GenericRequires a =>
-  Specification (SimpleRep a) ->
-  Specification a
-fromSimpleRepSpec = \case
-  ExplainSpec es s -> explainSpec es (fromSimpleRepSpec s)
-  TrueSpec -> TrueSpec
-  ErrorSpec e -> ErrorSpec e
-  TypeSpec s'' cant -> TypeSpec s'' $ map fromSimpleRep cant
-  MemberSpec elems -> MemberSpec $ NE.nub (fmap fromSimpleRep elems)
-  SuspendedSpec x p ->
-    constrained $ \x' ->
-      Let (toGeneric_ x') (x :-> p) :: Pred
-
--- | Convert a @`Specification` a@ to one for @`SimpleRep` a@
-toSimpleRepSpec ::
-  forall a.
-  GenericRequires a =>
-  Specification a ->
-  Specification (SimpleRep a)
-toSimpleRepSpec = \case
-  ExplainSpec es s -> explainSpec es (toSimpleRepSpec s)
-  TrueSpec -> TrueSpec
-  ErrorSpec e -> ErrorSpec e
-  TypeSpec s'' cant -> TypeSpec s'' $ map toSimpleRep cant
-  MemberSpec elems -> MemberSpec $ NE.nub $ fmap toSimpleRep elems
-  SuspendedSpec x p ->
-    constrained $ \x' ->
-      Let (fromGeneric_ x') (x :-> p) :: Pred
-
--- =====================================================================
--- Now the supporting operations and types.
--- =====================================================================
-
--- | Used to show binary operators like SumSpec and PairSpec
-data BinaryShow where
-  BinaryShow :: forall a. String -> [Doc a] -> BinaryShow
-  NonBinary :: BinaryShow
-
--- =================================================
--- Term
-
--- | Like 'appSym' but builds functions over terms, rather that just one App term.
-appTerm ::
-  forall t ds r.
-  AppRequires t ds r =>
-  t ds r ->
-  FunTy (MapList Term ds) (Term r)
-appTerm sym = curryList @ds (App @Deps @t @ds @r sym)
-
--- | Give a `Term` a `String` name-hint _if_ the `Term` is a variable
-name :: String -> Term a -> Term a
-name nh (V (Var i _)) = V (Var i nh)
-name _ _ = error "applying name to non-var thing! Shame on you!"
-
--- | Create a `Binder` with a fresh variable, used in e.g. `constrained`
-bind :: (HasSpec a, IsPred p) => (Term a -> p) -> Binder a
-bind bodyf = newv :-> bodyPred
-  where
-    bodyPred = toPred body
-    newv = Var (nextVar bodyPred) "v"
-    body = bodyf (V newv)
-
-    nextVar q = 1 + bound q
-
-    boundBinder :: Binder a -> Int
-    boundBinder (x :-> p) = max (nameOf x) (bound p)
-
-    bound (ElemPred _ _ _) = -1
-    bound (Explain _ p) = bound p
-    bound (Subst x _ p) = max (nameOf x) (bound p)
-    bound (And ps) = maximum $ (-1) : map bound ps -- (-1) as the default to get 0 as `nextVar p`
-    bound (Exists _ b) = boundBinder b
-    bound (Let _ b) = boundBinder b
-    bound (ForAll _ b) = boundBinder b
-    bound (Case _ cs) = getMax $ foldMapList (Max . boundBinder . thing) cs
-    bound (When _ p) = bound p
-    bound Reifies {} = -1
-    bound GenHintD {} = -1
-    bound Assert {} = -1
-    bound DependsOn {} = -1
-    bound TruePred = -1
-    bound FalsePred {} = -1
-    bound Monitor {} = -1
-
--- ==================================================
--- Pred
-
--- | A collection @t@ with elements of type @e@ where the `forAll` syntax will
--- work
-class Forallable t e | t -> e where
-  -- | Lift the `Specification` for the elements to the collection
-  fromForAllSpec ::
-    (HasSpec t, HasSpec e) => Specification e -> Specification t
-  default fromForAllSpec ::
-    ( HasSpec e
-    , Forallable (SimpleRep t) e
-    , GenericRequires t
-    ) =>
-    Specification e ->
-    Specification t
-  fromForAllSpec es = fromSimpleRepSpec $ fromForAllSpec @(SimpleRep t) @e es
-
-  -- | Get the underlying items in the collection
-  forAllToList :: t -> [e]
-  default forAllToList ::
-    ( HasSimpleRep t
-    , Forallable (SimpleRep t) e
-    ) =>
-    t ->
-    [e]
-  forAllToList t = forAllToList (toSimpleRep t)
-
--- ===========================================
--- IsPred
-
--- | Something from which we can construct a `Pred`, useful for providing
--- flexible syntax for `constrained` and friends.
-class Show p => IsPred p where
-  -- | Convert to a `Pred`
-  toPred :: p -> Pred
-
-instance IsPred Pred where
-  toPred (Assert (Lit False)) = FalsePred (pure "toPred(Lit False)")
-  toPred (Assert (Lit True)) = TruePred
-  toPred (Explain xs p) = Explain xs (toPred p)
-  toPred (And ps) = And (map toPred ps)
-  toPred x = x
-
-instance IsPred p => IsPred [p] where
-  toPred xs = And (map toPred xs)
-
-instance IsPred Bool where
-  toPred True = TruePred
-  toPred False = FalsePred (pure "toPred False")
-
-instance IsPred (Term Bool) where
-  toPred (Lit b) = toPred b
-  toPred term = Assert term
-
--- ============================================================
--- Simple Widely used operations on Specification
-
--- | return a MemberSpec or ans ErrorSpec depending on if 'xs' is null or not
-memberSpec :: Foldable f => f a -> NE.NonEmpty String -> Specification a
-memberSpec (toList -> xs) messages =
-  case NE.nonEmpty xs of
-    Nothing -> ErrorSpec messages
-    Just ys -> MemberSpec ys
-
--- | Attach an explanation to a specification in order to track issues with satisfiability
-explainSpec :: [String] -> Specification a -> Specification a
-explainSpec [] x = x
-explainSpec es (ExplainSpec es' spec) = ExplainSpec (es ++ es') spec
-explainSpec es spec = ExplainSpec es spec
-
--- | A "discrete" specification satisfied by exactly one element
-equalSpec :: a -> Specification a
-equalSpec = MemberSpec . pure
-
--- | Anything but this
-notEqualSpec :: forall a. HasSpec a => a -> Specification a
-notEqualSpec = TypeSpec (emptySpec @a) . pure
-
--- | Anything but these
-notMemberSpec :: forall a f. (HasSpec a, Foldable f) => f a -> Specification a
-notMemberSpec = typeSpecOpt (emptySpec @a) . toList
-
--- | Build a `Specification` using predicates, e.g.
--- > constrained $ \ x -> assert $ x `elem_` lit [1..10 :: Int]
-constrained ::
-  forall a p.
-  (IsPred p, HasSpec a) =>
-  (Term a -> p) ->
-  Specification a
-constrained body =
-  let x :-> p = bind body
-   in SuspendedSpec x p
-
--- | Sound but not complete check for empty `Specification`s
-isErrorLike :: forall a. Specification a -> Bool
-isErrorLike (ExplainSpec _ s) = isErrorLike s
-isErrorLike ErrorSpec {} = True
-isErrorLike (TypeSpec x _) =
-  case typeSpecHasError @a x of
-    Nothing -> False
-    Just _ -> True
-isErrorLike _ = False
-
--- | Get the error message of an `isErrorLike` `Specification`
-errorLikeMessage :: forall a. Specification a -> NE.NonEmpty String
-errorLikeMessage (ErrorSpec es) = es
-errorLikeMessage (TypeSpec x _) =
-  case typeSpecHasError @a x of
-    Nothing -> pure ("Bad call to errorLikeMessage case 1, not guarded by isErrorLike")
-    Just xs -> xs
-errorLikeMessage _ = pure ("Bad call to errorLikeMessage, case 2, not guarded by isErrorLike")
-
--- | Add the explanations, if it's an ErrorSpec, else drop them
-addToErrorSpec :: NE.NonEmpty String -> Specification a -> Specification a
-addToErrorSpec es (ExplainSpec [] x) = addToErrorSpec es x
-addToErrorSpec es (ExplainSpec es2 x) = ExplainSpec es2 (addToErrorSpec es x)
-addToErrorSpec es (ErrorSpec es') = ErrorSpec (es <> es')
-addToErrorSpec _ s = s
-
-------------------------------------------------------------------------
--- Pretty and Show instances
-------------------------------------------------------------------------
-
--- | The Fun type encapuslates a Logic instance and symbol universe type to
--- hide everything but the domain and range. This is a way to pass around
--- functions without pain. Usefull in the ListFoldy implementaion that deals
--- with higher order functions.
-data Fun dom rng where
-  Fun ::
-    forall t dom rng.
-    AppRequires t dom rng =>
-    t dom rng ->
-    Fun dom rng
-
-instance Show (Fun dom r) where
-  show (Fun (f :: t dom rng)) = "(Fun " ++ show f ++ ")"
-
--- | Apply a single-argument `Fun` to a `Term`
-appFun :: Fun '[x] b -> Term x -> Term b
-appFun (Fun f) x = App f (x :> Nil)
-
-sameFun :: Fun d1 r1 -> Fun d2 r2 -> Bool
-sameFun (Fun f) (Fun g) = case cast f of
-  Just f' -> f' == g
-  Nothing -> False
-
-instance Eq (Fun d r) where
-  (==) = sameFun
-
--- | Pattern-match on an application of `fromGeneric_`, useful for writing
--- custom rewrite rules to help the solver
-pattern FromGeneric ::
-  forall rng.
-  () =>
-  forall a.
-  (rng ~ a, GenericRequires a, HasSpec a, AppRequires BaseW '[SimpleRep a] rng) =>
-  Term (SimpleRep a) ->
-  Term rng
-pattern FromGeneric x <-
-  (App (getWitness -> Just FromGenericW) (x :> Nil))
-
--- | Pattern-match on an application of `toGeneric_`, useful for writing custom
--- rewrite rules to help the solver
-pattern ToGeneric ::
-  forall rng.
-  () =>
-  forall a.
-  (rng ~ SimpleRep a, GenericRequires a, HasSpec a, AppRequires BaseW '[a] rng) =>
-  Term a ->
-  Term rng
-pattern ToGeneric x <- (App (getWitness -> Just ToGenericW) (x :> Nil))
-
--- | Hints are things that only affect generation, and not validation. For instance, parameters to
---   control distribution of generated values.
-class (HasSpec a, Show (Hint a)) => HasGenHint a where
-  type Hint a
-  giveHint :: Hint a -> Specification a
diff --git a/libs/constrained-generators/src/Constrained/Conformance.hs b/libs/constrained-generators/src/Constrained/Conformance.hs
deleted file mode 100644
index 394138bfc4d..00000000000
--- a/libs/constrained-generators/src/Constrained/Conformance.hs
+++ /dev/null
@@ -1,325 +0,0 @@
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE ImportQualifiedPost #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE PatternSynonyms #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}
--- Semigroup (Specification a), Monoid (Specification a)
-{-# OPTIONS_GHC -Wno-orphans #-}
-
--- | Functions primarily for checking that a value conforms to a
--- `Specification`
-module Constrained.Conformance (
-  monitorSpec,
-  conformsToSpec,
-  conformsToSpecE,
-  satisfies,
-  checkPred,
-  checkPredsE,
-) where
-
-import Constrained.AbstractSyntax
-import Constrained.Base
-import Constrained.Core
-import Constrained.Env
-import Constrained.Env qualified as Env
-import Constrained.GenT
-import Constrained.List
-import Constrained.PrettyUtils
-import Constrained.Syntax
-import Data.List (intersect, nub)
-import Data.List.NonEmpty qualified as NE
-import Data.Maybe
-import Data.Semigroup (sconcat)
-import Prettyprinter hiding (cat)
-import Test.QuickCheck (Property, Testable, property)
-
--- =========================================================================
-
--- | Does the Pred evaluate to true under the given Env.
---   If it doesn't, some explanation appears in the failure of the monad 'm'
-checkPred :: forall m. MonadGenError m => Env -> Pred -> m Bool
-checkPred env = \case
-  p@(ElemPred bool term xs) -> do
-    v <- runTerm env term
-    case (elem v xs, bool) of
-      (True, True) -> pure True
-      (True, False) -> fatalErrorNE ("notElemPred reduces to True" :| [show p])
-      (False, True) -> fatalErrorNE ("elemPred reduces to False" :| [show p])
-      (False, False) -> pure True
-  Monitor {} -> pure True
-  Subst x t p -> checkPred env $ substitutePred x t p
-  Assert t -> runTerm env t
-  GenHint {} -> pure True
-  p@(Reifies t' t f) -> do
-    val <- runTerm env t
-    val' <- runTerm env t'
-    explainNE (NE.fromList ["Reification:", "  " ++ show p]) $ pure (f val == val')
-  ForAll t (x :-> p) -> do
-    set <- runTerm env t
-    and
-      <$> sequence
-        [ checkPred env' p
-        | v <- forAllToList set
-        , let env' = Env.extend x v env
-        ]
-  Case t bs -> do
-    v <- runTerm env t
-    runCaseOn v (mapList thing bs) (\x val ps -> checkPred (Env.extend x val env) ps)
-  When bt p -> do
-    b <- runTerm env bt
-    if b then checkPred env p else pure True
-  TruePred -> pure True
-  FalsePred es -> explainNE es $ pure False
-  DependsOn {} -> pure True
-  And ps -> checkPreds env ps
-  Let t (x :-> p) -> do
-    val <- runTerm env t
-    checkPred (Env.extend x val env) p
-  Exists k (x :-> p) -> do
-    a <- runGE $ k (errorGE . explain "checkPred: Exists" . runTerm env)
-    checkPred (Env.extend x a env) p
-  Explain es p -> explainNE es $ checkPred env p
-
-checkPreds :: (MonadGenError m, Traversable t) => Env -> t Pred -> m Bool
-checkPreds env ps = and <$> mapM (checkPred env) ps
-
--- ==========================================================
-
--- | Like checkPred, But it takes [Pred] rather than a single Pred,
---   and it builds a much more involved explanation if it fails.
---   Does the Pred evaluate to True under the given Env?
---   If it doesn't, an involved explanation appears in the (Just message)
---   If it does, then it returns Nothing
-checkPredsE ::
-  NE.NonEmpty String ->
-  Env ->
-  [Pred] ->
-  Maybe (NE.NonEmpty String)
-checkPredsE msgs env ps =
-  case catMaybes (fmap (checkPredE env msgs) ps) of
-    [] -> Nothing
-    (x : xs) -> Just (NE.nub (sconcat (x NE.:| xs)))
-
--- | An involved explanation for a single Pred
---   The most important explanations come when an assertion fails.
-checkPredE :: Env -> NE.NonEmpty String -> Pred -> Maybe (NE.NonEmpty String)
-checkPredE env msgs = \case
-  p@(ElemPred bool t xs) ->
-    case runTermE env t of
-      Left message -> Just (msgs <> message)
-      Right v -> case (elem v xs, bool) of
-        (True, True) -> Nothing
-        (True, False) -> Just ("notElemPred reduces to True" :| [show p])
-        (False, True) -> Just ("elemPred reduces to False" :| [show p])
-        (False, False) -> Nothing
-  Monitor {} -> Nothing
-  Subst x t p -> checkPredE env msgs $ substitutePred x t p
-  Assert t -> case runTermE env t of
-    Right True -> Nothing
-    Right False ->
-      Just
-        (msgs <> pure ("Assert " ++ show t ++ " returns False") <> pure ("\nenv=\n" ++ show (pretty env)))
-    Left es -> Just (msgs <> es)
-  GenHint {} -> Nothing
-  p@(Reifies t' t f) ->
-    case runTermE env t of
-      Left es -> Just (msgs <> NE.fromList ["checkPredE: Reification fails", "  " ++ show p] <> es)
-      Right val -> case runTermE env t' of
-        Left es -> Just (msgs <> NE.fromList ["checkPredE: Reification fails", "  " ++ show p] <> es)
-        Right val' ->
-          if f val == val'
-            then Nothing
-            else
-              Just
-                ( msgs
-                    <> NE.fromList
-                      [ "checkPredE: Reification doesn't match up"
-                      , "  " ++ show p
-                      , show (f val) ++ " /= " ++ show val'
-                      ]
-                )
-  ForAll t (x :-> p) -> case runTermE env t of
-    Left es -> Just $ (msgs <> NE.fromList ["checkPredE: ForAll fails to run."] <> es)
-    Right set ->
-      let answers =
-            catMaybes
-              [ checkPredE env' (pure "Some items in ForAll fail") p
-              | v <- forAllToList set
-              , let env' = Env.extend x v env
-              ]
-       in case answers of
-            [] -> Nothing
-            (y : ys) -> Just (NE.nub (sconcat (y NE.:| ys)))
-  Case t bs -> case runTermE env t of
-    Right v -> runCaseOn v (mapList thing bs) (\x val ps -> checkPredE (Env.extend x val env) msgs ps)
-    Left es -> Just (msgs <> pure "checkPredE: Case fails" <> es)
-  When bt p -> case runTermE env bt of
-    Right b -> if b then checkPredE env msgs p else Nothing
-    Left es -> Just (msgs <> pure "checkPredE: When fails" <> es)
-  TruePred -> Nothing
-  FalsePred es -> Just (msgs <> pure "checkPredE: FalsePred" <> es)
-  DependsOn {} -> Nothing
-  And ps ->
-    case catMaybes (fmap (checkPredE env (pure "Some items in And  fail")) ps) of
-      [] -> Nothing
-      (x : xs) -> Just (msgs <> NE.nub (sconcat (x NE.:| xs)))
-  Let t (x :-> p) -> case runTermE env t of
-    Right val -> checkPredE (Env.extend x val env) msgs p
-    Left es -> Just (msgs <> pure "checkPredE: Let fails" <> es)
-  Exists k (x :-> p) ->
-    let eval :: forall b. Term b -> b
-        eval term = case runTermE env term of
-          Right v -> v
-          Left es -> error $ unlines $ NE.toList (msgs <> es)
-     in case k eval of
-          Result a -> checkPredE (Env.extend x a env) msgs p
-          FatalError es -> Just (msgs <> catMessageList es)
-          GenError es -> Just (msgs <> catMessageList es)
-  Explain es p -> checkPredE env (msgs <> es) p
-
--- | @conformsToSpec@ with explanation. Nothing if (conformsToSpec a spec),
---   but (Just explanations) if not(conformsToSpec a spec).
-conformsToSpecE ::
-  forall a.
-  HasSpec a =>
-  a ->
-  Specification a ->
-  NE.NonEmpty String ->
-  Maybe (NE.NonEmpty String)
-conformsToSpecE a (ExplainSpec [] s) msgs = conformsToSpecE a s msgs
-conformsToSpecE a (ExplainSpec (x : xs) s) msgs = conformsToSpecE a s ((x :| xs) <> msgs)
-conformsToSpecE _ TrueSpec _ = Nothing
-conformsToSpecE a (MemberSpec as) msgs =
-  if elem a as
-    then Nothing
-    else
-      Just
-        ( msgs
-            <> NE.fromList
-              ["conformsToSpecE MemberSpec case", "  " ++ show a, "  not an element of", "  " ++ show as, ""]
-        )
-conformsToSpecE a spec@(TypeSpec s cant) msgs =
-  if notElem a cant && conformsTo a s
-    then Nothing
-    else
-      Just
-        ( msgs
-            <> NE.fromList
-              ["conformsToSpecE TypeSpec case", "  " ++ show a, "  (" ++ show spec ++ ")", "fails", ""]
-        )
-conformsToSpecE a (SuspendedSpec v ps) msgs =
-  case checkPredE (Env.singleton v a) msgs ps of
-    Nothing -> Nothing
-    Just es -> Just (pure ("conformsToSpecE SuspendedSpec case on var " ++ show v ++ " fails") <> es)
-conformsToSpecE _ (ErrorSpec es) msgs = Just (msgs <> pure "conformsToSpecE ErrorSpec case" <> es)
-
--- | Check if an @a@ conforms to a @`Specification` a@
-conformsToSpec :: HasSpec a => a -> Specification a -> Bool
-conformsToSpec a x = case conformsToSpecE a x (pure "call to conformsToSpecE") of
-  Nothing -> True
-  Just _ -> False
-
--- | Embed a `Specification` in a `Pred`. Useful for re-using `Specification`s
-satisfies :: forall a. HasSpec a => Term a -> Specification a -> Pred
-satisfies e (ExplainSpec [] s) = satisfies e s
-satisfies e (ExplainSpec (x : xs) s) = Explain (x :| xs) $ satisfies e s
-satisfies _ TrueSpec = TruePred
-satisfies e (MemberSpec nonempty) = ElemPred True e nonempty
-satisfies t (SuspendedSpec x p) = Subst x t p
-satisfies e (TypeSpec s cant) = case cant of
-  [] -> toPreds e s
-  (c : cs) -> ElemPred False e (c :| cs) <> toPreds e s
-satisfies _ (ErrorSpec e) = FalsePred e
-
--- ==================================================================
-
-instance HasSpec a => Semigroup (Specification a) where
-  ExplainSpec es x <> y = explainSpec es (x <> y)
-  x <> ExplainSpec es y = explainSpec es (x <> y)
-  TrueSpec <> s = s
-  s <> TrueSpec = s
-  ErrorSpec e <> ErrorSpec e' =
-    ErrorSpec
-      ( e
-          <> pure ("------ spec <> spec ------ @" ++ showType @a)
-          <> e'
-      )
-  ErrorSpec e <> _ = ErrorSpec e
-  _ <> ErrorSpec e = ErrorSpec e
-  MemberSpec as <> MemberSpec as' =
-    addToErrorSpec
-      ( NE.fromList
-          ["Intersecting: ", "  MemberSpec " ++ show (NE.toList as), "  MemberSpec " ++ show (NE.toList as')]
-      )
-      ( memberSpec
-          (nub $ intersect (NE.toList as) (NE.toList as'))
-          (pure "Empty intersection")
-      )
-  ms@(MemberSpec as) <> ts@TypeSpec {} =
-    memberSpec
-      (nub $ NE.filter (`conformsToSpec` ts) as)
-      ( NE.fromList
-          [ "The two " ++ showType @a ++ " Specifications are inconsistent."
-          , "  " ++ show ms
-          , "  " ++ show ts
-          ]
-      )
-  TypeSpec s cant <> MemberSpec as = MemberSpec as <> TypeSpec s cant
-  SuspendedSpec v p <> SuspendedSpec v' p' = SuspendedSpec v (p <> rename v' v p')
-  SuspendedSpec v ps <> s = SuspendedSpec v (ps <> satisfies (V v) s)
-  s <> SuspendedSpec v ps = SuspendedSpec v (ps <> satisfies (V v) s)
-  TypeSpec s cant <> TypeSpec s' cant' = case combineSpec s s' of
-    -- NOTE: This might look like an unnecessary case, but doing
-    -- it like this avoids looping.
-    TypeSpec s'' cant'' -> TypeSpec s'' (cant <> cant' <> cant'')
-    s'' -> s'' <> notMemberSpec (cant <> cant')
-
-instance HasSpec a => Monoid (Specification a) where
-  mempty = TrueSpec
-
--- =========================================================================
-
--- | Collect the 'monitor' calls from a specification instantiated to the given value. Typically,
---
---   > quickCheck $ forAll (genFromSpec spec) $ \ x -> monitorSpec spec x $ ...
-monitorSpec :: Testable p => Specification a -> a -> p -> Property
-monitorSpec (SuspendedSpec x p) a =
-  errorGE (monitorPred (Env.singleton x a) p) . property
-monitorSpec _ _ = property
-
-monitorPred ::
-  forall m. MonadGenError m => Env -> Pred -> m (Property -> Property)
-monitorPred env = \case
-  ElemPred {} -> pure id -- Not sure about this, but ElemPred is a lot like Assert, so ...
-  Monitor m -> pure (m $ errorGE . explain "monitorPred: Monitor" . runTerm env)
-  Subst x t p -> monitorPred env $ substitutePred x t p
-  Assert {} -> pure id
-  GenHint {} -> pure id
-  Reifies {} -> pure id
-  ForAll t (x :-> p) -> do
-    set <- runTerm env t
-    foldr (.) id
-      <$> sequence
-        [ monitorPred env' p
-        | v <- forAllToList set
-        , let env' = Env.extend x v env
-        ]
-  Case t bs -> do
-    v <- runTerm env t
-    runCaseOn v (mapList thing bs) (\x val ps -> monitorPred (Env.extend x val env) ps)
-  When b p -> do
-    v <- runTerm env b
-    if v then monitorPred env p else pure id
-  TruePred -> pure id
-  FalsePred {} -> pure id
-  DependsOn {} -> pure id
-  And ps -> foldr (.) id <$> mapM (monitorPred env) ps
-  Let t (x :-> p) -> do
-    val <- runTerm env t
-    monitorPred (Env.extend x val env) p
-  Exists k (x :-> p) -> do
-    case k (errorGE . explain "monitorPred: Exists" . runTerm env) of
-      Result a -> monitorPred (Env.extend x a env) p
-      _ -> pure id
-  Explain es p -> explainNE es $ monitorPred env p
diff --git a/libs/constrained-generators/src/Constrained/Core.hs b/libs/constrained-generators/src/Constrained/Core.hs
deleted file mode 100644
index 95714e32678..00000000000
--- a/libs/constrained-generators/src/Constrained/Core.hs
+++ /dev/null
@@ -1,141 +0,0 @@
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE ImportQualifiedPost #-}
-{-# LANGUAGE QuantifiedConstraints #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeOperators #-}
--- Arbitrary NonEmpty
--- TOOD: fixme by bumping QuickCheck to 3.0 when it's released
-{-# OPTIONS_GHC -Wno-orphans #-}
-
--- | This is a collection of relatively core concepts that are re-used
--- throughout the codebase.
-module Constrained.Core (
-  -- * Variables and renaming
-  Var (..),
-  eqVar,
-  Rename (..),
-  freshen,
-
-  -- * Random cruft
-  Value (..),
-  unValue,
-  NonEmpty ((:|)),
-  Evidence (..),
-  unionWithMaybe,
-) where
-
-import Constrained.List (
-  List (..),
-  mapList,
- )
-import Constrained.PrettyUtils
-import Control.Applicative
-import Data.Function
-import Data.List.NonEmpty (NonEmpty ((:|)))
-import Data.List.NonEmpty qualified as NE
-import Data.Set (Set)
-import Data.Set qualified as Set
-import Data.Typeable
-import Test.QuickCheck (Arbitrary (..), NonEmptyList (NonEmpty))
-
--- Variables --------------------------------------------------------------
-
--- | Typed, optionally named, variables
-data Var a = Var {nameOf :: Int, nameHint :: String}
-
-instance Ord (Var a) where
-  compare = compare `on` nameOf
-
-instance Eq (Var a) where
-  (==) = (==) `on` nameOf
-
-instance Show (Var a) where
-  show v = nameHint v ++ "_" ++ show (nameOf v)
-
--- | Check if two variables of different type are equal
-eqVar :: forall a a'. (Typeable a, Typeable a') => Var a -> Var a' -> Maybe (a :~: a')
-eqVar v v' | nameOf v == nameOf v' = eqT @a @a'
-eqVar _ _ = Nothing
-
--- Variable renaming ------------------------------------------------------
-
--- | Things where variables can be renamed
-class Rename a where
-  rename :: Typeable x => Var x -> Var x -> a -> a
-
-instance Typeable a => Rename (Var a) where
-  rename v v' vOld
-    | Just Refl <- eqVar v vOld = v'
-    | otherwise = vOld
-
-instance Rename () where
-  rename _ _ _ = ()
-
-instance (Rename a, Rename b) => Rename (a, b) where
-  rename x x' (a, b) = (rename x x' a, rename x x' b)
-
-instance {-# OVERLAPPABLE #-} (Functor t, Rename a) => Rename (t a) where
-  rename v v'
-    | v == v' = id
-    | otherwise = fmap (rename v v')
-
-instance (Ord a, Rename a) => Rename (Set a) where
-  rename v v'
-    | v == v' = id
-    | otherwise = Set.map (rename v v')
-
-instance (forall a. Rename (f a)) => Rename (List f as) where
-  rename v v' = mapList (rename v v')
-
-instance Rename a => Rename [a] where
-  rename v v' = map (rename v v')
-
-freshVar :: Var a -> Set Int -> Var a
-freshVar (Var n nh) ns
-  | Set.member n ns = Var (1 + Set.findMax ns) nh
-  | otherwise = Var n nh
-
--- | Freshen a variable and rename it in a term where it is used given a set of
--- used names that we can't overlap with
-freshen :: (Typeable a, Rename t) => Var a -> t -> Set Int -> (Var a, t)
-freshen v t nms
-  | nameOf v `Set.member` nms = let v' = freshVar v nms in (v', rename v v' t)
-  | otherwise = (v, t)
-
--- Values -----------------------------------------------------------------
-
--- | Simple values that we can show
-data Value a where
-  Value :: Show a => !a -> Value a
-
-deriving instance Eq a => Eq (Value a)
-
-deriving instance Ord a => Ord (Value a)
-
-instance Show (Value a) where
-  showsPrec p (Value a) = showsPrec p a
-
--- | Extract an underlying value from a t`Value`
-unValue :: Value a -> a
-unValue (Value v) = v
-
--- Cruft ------------------------------------------------------------------
-
--- | Evidence that a constraint it satisfied, a runtime dict
-data Evidence c where
-  Evidence :: c => Evidence c
-
-instance Typeable c => Show (Evidence c) where
-  show _ = "Evidence@(" ++ showType @c ++ ")"
-
--- | Take the union of two `Maybe` values with a given union operator
-unionWithMaybe :: (a -> a -> a) -> Maybe a -> Maybe a -> Maybe a
-unionWithMaybe f ma ma' = (f <$> ma <*> ma') <|> ma <|> ma'
-
-instance Arbitrary a => Arbitrary (NonEmpty a) where
-  arbitrary = do
-    NonEmpty xs <- arbitrary
-    pure (NE.fromList xs)
diff --git a/libs/constrained-generators/src/Constrained/DependencyInjection.hs b/libs/constrained-generators/src/Constrained/DependencyInjection.hs
deleted file mode 100644
index 584bf6d2c3c..00000000000
--- a/libs/constrained-generators/src/Constrained/DependencyInjection.hs
+++ /dev/null
@@ -1,29 +0,0 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE TypeFamilies #-}
-
--- | In this module we introduce the `Dependencies` class which is intended to
---    collect type classes and type families that are necessary in the abstract
---    syntax of terms, predicates, and specifications but which we don't want to
---    define in the same place as we define the abstract syntax. C.f.
---    `Constrained.AbstractSyntax` for an example of how we use this module.
---
---    This is typically because the type classes have large default instances that
---    mean the type classes themselves need a lot of code before we can define
---    them. By making these classes abstract in the GADTs we avoid the code-base
---    blowing up with a lot of interdependencies.
---
---    The `Dependencies` class will eventually only be instantiated once by an
---    uninhabited type @data Deps@.
-module Constrained.DependencyInjection where
-
-import Data.Kind
-
--- | A collection of names of type families and type classes to be instantiated
--- later.
-class Dependencies d where
-  type HasSpecD d :: Type -> Constraint
-  type TypeSpecD d :: Type -> Type
-  type LogicD d :: ([Type] -> Type -> Type) -> Constraint
-  type ForallableD d :: Type -> Type -> Constraint
-  type HasGenHintD d :: Type -> Constraint
-  type HintD d :: Type -> Type
diff --git a/libs/constrained-generators/src/Constrained/Env.hs b/libs/constrained-generators/src/Constrained/Env.hs
deleted file mode 100644
index 0e9beaa374d..00000000000
--- a/libs/constrained-generators/src/Constrained/Env.hs
+++ /dev/null
@@ -1,82 +0,0 @@
-{-# LANGUAGE DerivingVia #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE ImportQualifiedPost #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE StandaloneDeriving #-}
-
--- | Environments that map types variables to values
-module Constrained.Env (
-  Env,
-  singleton,
-  extend,
-  lookup,
-  find,
-  remove,
-) where
-
-import Constrained.Core
-import Constrained.GenT
-import Data.Map (Map)
-import Data.Map qualified as Map
-import Data.Typeable
-import Prettyprinter
-import Prelude hiding (lookup)
-
--- | Typed environments for mapping @t`Var` a@ to @a@
-newtype Env = Env {unEnv :: Map EnvKey EnvValue}
-  deriving newtype (Semigroup, Monoid)
-  deriving stock (Show)
-
-data EnvValue where
-  EnvValue :: (Typeable a, Show a) => !a -> EnvValue
-
-deriving instance Show EnvValue
-
-data EnvKey where
-  EnvKey :: !(Var a) -> EnvKey
-
-instance Eq EnvKey where
-  EnvKey v == EnvKey v' = nameOf v == nameOf v'
-
-instance Ord EnvKey where
-  compare (EnvKey v) (EnvKey v') = compare (nameOf v) (nameOf v')
-
-instance Show EnvKey where
-  show (EnvKey var) = show var
-
--- | Extend an environment with a new variable value pair
-extend :: (Typeable a, Show a) => Var a -> a -> Env -> Env
-extend v a (Env m) = Env $ Map.insert (EnvKey v) (EnvValue a) m
-
--- | Remove a variable from an environment if it exists
-remove :: Var a -> Env -> Env
-remove v (Env m) = Env $ Map.delete (EnvKey v) m
-
--- | Create a singleton environment
-singleton :: (Typeable a, Show a) => Var a -> a -> Env
-singleton v a = Env $ Map.singleton (EnvKey v) (EnvValue a)
-
--- | Lookup a avariable in the environment
-lookup :: Typeable a => Env -> Var a -> Maybe a
-lookup (Env m) v = do
-  EnvValue val <- Map.lookup (EnvKey v) m
-  cast val
-
--- | `lookup` generalized to any `MonadGenError` monad @m@
-find :: (Typeable a, MonadGenError m) => Env -> Var a -> m a
-find env var = do
-  case lookup env var of
-    Just a -> pure a
-    Nothing -> genError ("Couldn't find " ++ show var ++ " in " ++ show env)
-
-instance Pretty EnvValue where
-  pretty (EnvValue x) = pretty $ take 80 (show x)
-
-instance Pretty EnvKey where
-  pretty (EnvKey x) = viaShow x
-
-instance Pretty Env where
-  pretty (Env m) = vsep ("Env" : (map f (Map.toList m)))
-    where
-      f (k, v) = hsep [pretty k, "->", pretty v]
diff --git a/libs/constrained-generators/src/Constrained/FunctionSymbol.hs b/libs/constrained-generators/src/Constrained/FunctionSymbol.hs
deleted file mode 100644
index d53814374b0..00000000000
--- a/libs/constrained-generators/src/Constrained/FunctionSymbol.hs
+++ /dev/null
@@ -1,55 +0,0 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE PolyKinds #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeOperators #-}
-
--- | Utility functions and key concepts for talking about typed function
--- symbols, i.e. witness type formers @W :: (as :: [Type]) -> (r :: Type) ->
--- Type@ whose constructors stand in for functions of type @`FunTy` as r@.
-module Constrained.FunctionSymbol (sameFunSym, getWitness, Semantics (..)) where
-
-import Constrained.List
-import Data.Kind
-import Data.Typeable
-
--- | Check if two function symbols of different type are the same
-sameFunSym ::
-  forall (t1 :: [Type] -> Type -> Type) d1 r1 (t2 :: [Type] -> Type -> Type) d2 r2.
-  ( Typeable t1
-  , Typeable d1
-  , Typeable r1
-  , Typeable t2
-  , Typeable d2
-  , Typeable r2
-  , Eq (t1 d1 r1)
-  ) =>
-  t1 d1 r1 ->
-  t2 d2 r2 ->
-  Maybe (t1 :~: t2, d1 :~: d2, r1 :~: r2)
-sameFunSym x y = do
-  Refl <- eqT @t1 @t2
-  Refl <- eqT @d1 @d2
-  Refl <- eqT @r1 @r2
-  if x == y
-    then Just (Refl, Refl, Refl)
-    else Nothing
-
--- | Try to cast from an unknown function symbol universe @t@ to a known
--- universe @t'@
-getWitness ::
-  forall t t' d r.
-  ( Typeable t
-  , Typeable d
-  , Typeable r
-  , Typeable t'
-  ) =>
-  t d r -> Maybe (t' d r)
-getWitness = cast
-
--- | Semantic operations are ones that give the function symbol, meaning as a
--- function. I.e. how to apply the function to a list of arguments and return
--- a value.
-class Semantics (t :: [Type] -> Type -> Type) where
-  semantics :: t d r -> FunTy d r -- e.g. FunTy '[a, Int] Bool ~ a -> Int -> Bool
diff --git a/libs/constrained-generators/src/Constrained/GenT.hs b/libs/constrained-generators/src/Constrained/GenT.hs
deleted file mode 100644
index d2a2bef4439..00000000000
--- a/libs/constrained-generators/src/Constrained/GenT.hs
+++ /dev/null
@@ -1,463 +0,0 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE ImportQualifiedPost #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE TypeApplications #-}
--- NOTE: this is for `split` vs. `splitGen` that we haven't had
--- time to fix in `QuickCheck`.
-{-# OPTIONS_GHC -Wno-deprecations #-}
-
--- | This module provides an interface for writing and working with generators
---     that may fail in both recoverable and unrecoverable ways.
-module Constrained.GenT (
-  -- * Types
-  GE (..),
-  GenT,
-  GenMode (..),
-
-  -- * Writing t`GenT` generators
-  MonadGenError (..),
-  pureGen,
-  genFromGenT,
-  suchThatT,
-  suchThatWithTryT,
-  scaleT,
-  firstGenT,
-  tryGenT,
-  chooseT,
-  sizeT,
-  withMode,
-  frequencyT,
-  oneofT,
-  vectorOfT,
-  listOfUntilLenT,
-  listOfT,
-  resizeT,
-  strictGen,
-  looseGen,
-
-  -- * So far undocumented
-  fatalError,
-  catMessages,
-  catMessageList,
-  explain,
-  errorGE,
-  fromGE,
-  runGE,
-  inspect,
-  genError,
-  pushGE,
-  push,
-  dropGen,
-  catchGen,
-  getMode,
-  headGE,
-  fromGEProp,
-  fromGEDiscard,
-  listFromGE,
-) where
-
-import Control.Monad
-import Data.Foldable
-import Data.List.NonEmpty (NonEmpty ((:|)), (<|))
-import Data.List.NonEmpty qualified as NE
-import Data.Typeable
-import GHC.Stack
-import System.Random
-import Test.QuickCheck hiding (Args, Fun)
-import Test.QuickCheck.Gen
-
--- ==============================================================
--- The GE Monad
-
--- | This is like an @Error@ monad that distinguishes between two kinds of
--- errors: @FatalError@s and non-fatal @GenError@s.
-data GE a
-  = FatalError (NonEmpty (NonEmpty String))
-  | GenError (NonEmpty (NonEmpty String))
-  | Result a
-  deriving (Ord, Eq, Show, Functor)
-
-instance Applicative GE where
-  pure = Result
-  (<*>) = ap
-
-instance Monad GE where
-  FatalError es >>= _ = FatalError es
-  GenError es >>= _ = GenError es
-  Result a >>= k = k a
-
-------------------------------------------------------------------------
--- The GenT monad
--- An environment monad on top of GE
-------------------------------------------------------------------------
-
--- | Generation mode - how strict are we about requiring the generator to
--- succeed. This is necessary because sometimes failing to find a value means
--- there is an actual problem (a generator _should_ be satisfiable but for
--- whatever buggy reason it isn't) and sometimes failing to find a value just
--- means there are no values. The latter case is very relevant when you're
--- generating e.g. lists or sets of values that can be empty.
-data GenMode
-  = Loose
-  | Strict
-  deriving (Ord, Eq, Show)
-
--- | A `Gen` monad wrapper that allows different generation modes and different
--- failure types.
-newtype GenT m a = GenT {runGenT :: GenMode -> [NonEmpty String] -> Gen (m a)}
-  deriving (Functor)
-
-instance Monad m => Applicative (GenT m) where
-  pure a = GenT (\_ _ -> pure @Gen (pure @m a))
-  (<*>) = ap
-
--- I think this might be an inlined use of the Gen monad transformer?
-instance Monad m => Monad (GenT m) where
-  GenT m >>= k = GenT $ \mode -> \msgs -> MkGen $ \r n -> do
-    let (r1, r2) = split r
-    a <- unGen (m mode msgs) r1 n
-    unGen (runGenT (k a) mode msgs) r2 n
-
-instance MonadGenError m => MonadFail (GenT m) where
-  fail s = genError s
-
-------------------------------------------------------------------------
--- The MonadGenError transformer
-----------------------------------------------------------------------
-
--- | A class for different types of errors with a stack of `explain` calls to
--- narrow down problems. The @NonEmpty String@ means one cannot cause an error
--- without at least one string to explain it.
-class Monad m => MonadGenError m where
-  genErrors :: HasCallStack => NonEmpty (NonEmpty String) -> m a
-  fatalErrors :: HasCallStack => NonEmpty (NonEmpty String) -> m a
-  genErrorNE :: HasCallStack => NonEmpty String -> m a
-  fatalErrorNE :: HasCallStack => NonEmpty String -> m a
-  explainNE :: HasCallStack => NonEmpty String -> m a -> m a
-
--- | A potentially recoverable generation error
-genError :: MonadGenError m => String -> m a
-genError = genErrorNE . pure
-
--- | A non-recoverable fatal error
-fatalError :: MonadGenError m => String -> m a
-fatalError = fatalErrorNE . pure
-
--- | Attach an explanation to a computation in case of error
-explain :: MonadGenError m => String -> m a -> m a
-explain s
-  | null s = id
-  | otherwise = explainNE (pure s)
-
--- GE instance
-
-instance MonadGenError GE where
-  genErrorNE msg = GenError (pure msg)
-  genErrors msgs = GenError msgs
-  fatalErrorNE msg = FatalError (pure msg)
-  fatalErrors msgs = FatalError msgs
-  explainNE m (GenError ms) = GenError (m <| ms)
-  explainNE m (FatalError ms) = FatalError (m <| ms)
-  explainNE _ (Result x) = Result x
-
--- GenT instance
-
--- | calls to genError and fatalError, add the stacked messages in the monad.
-instance MonadGenError m => MonadGenError (GenT m) where
-  genErrorNE e = GenT $ \_ xs -> pure $ genErrors (add e xs)
-  genErrors es = GenT $ \_ xs -> pure $ genErrors (cat es xs)
-
-  -- Perhaps we want to turn genError into fatalError, if mode_ is Strict?
-  fatalErrorNE e = GenT $ \_ xs -> pure $ fatalErrors (add e xs)
-  fatalErrors es = GenT $ \_ xs -> pure $ fatalErrors (cat es xs)
-
-  -- Perhaps we want to turn fatalError into genError, if mode_ is Loose?
-  explainNE e (GenT f) = GenT $ \mode es -> fmap (explainNE e) (f mode es)
-
--- ====================================================
--- useful operations on NonEmpty
-
-add :: NonEmpty a -> [NonEmpty a] -> NonEmpty (NonEmpty a)
-add a [] = pure a
-add a (x : xs) = a <| (x :| xs)
-
-cat :: NonEmpty (NonEmpty a) -> [NonEmpty a] -> NonEmpty (NonEmpty a)
-cat a [] = a
-cat a (x : xs) = a <> (x :| xs)
-
--- | Sometimes we have a bunch of `genError` or `fatalError` messages we want
--- to combine into one big message. This happens when we want to lift one of
--- these into an input for 'error'
-catMessages :: NonEmpty (NonEmpty String) -> String
-catMessages xs = unlines (NE.toList (catMessageList xs))
-
--- | Turn each inner @NonEmpty String@ into a String
-catMessageList :: NonEmpty (NonEmpty String) -> NonEmpty String
-catMessageList = fmap (unlines . NE.toList)
-
--- ========================================================
--- Useful operations on GE
-
--- If none of the GE's are FatalError, then concat together all the
--- Results (skipping over GenError). If there is at least one
--- @FatalError xs@ abort, and lift all those @xs@ as errors in the monad @m@.
-catGEs :: forall m a. MonadGenError m => [GE a] -> m [a]
-catGEs ges0 = go [] ges0
-  where
-    go acc [] = pure $ reverse acc
-    go !acc (g : ges) =
-      case g of
-        Result a -> go (a : acc) ges
-        GenError _ -> go acc ges
-        FatalError xs -> fatalErrors xs
-
--- | Turn @'GE' a@ into @a@ given a function for handling @GenError@, and handle
--- @FatalError@ with 'error'
-fromGE :: HasCallStack => (NonEmpty (NonEmpty String) -> a) -> GE a -> a
-fromGE f ge = case ge of
-  Result a -> a
-  GenError xs -> f xs
-  FatalError es -> error $ catMessages es
-
--- | Turn @'GE' a@ into where both @GenError@ and @FatalError@ are handled by
--- using 'error'
-errorGE :: GE a -> a
-errorGE = fromGE (error . catMessages)
-
-isOk :: GE a -> Bool
-isOk ge = case ge of
-  GenError {} -> False
-  FatalError {} -> False
-  Result {} -> True
-
--- | Convert a `GE` into an arbitrary monad that has an instance of
--- `MonadGenError`
-runGE :: forall m r. MonadGenError m => GE r -> m r
-runGE ge = case ge of
-  GenError es -> genErrors es
-  FatalError es -> fatalErrors es
-  Result a -> pure a
-
--- | Turn a `GE` for something testable into a `Property`, failing on any
--- kind of error.
-fromGEProp :: Testable p => GE p -> Property
-fromGEProp ge = case ge of
-  GenError es -> counterexample (catMessages es) False
-  FatalError es -> counterexample (catMessages es) False
-  Result p -> property p
-
--- | Turn a `GE` into a property, `discard`ing any failure.
-fromGEDiscard :: Testable p => GE p -> Property
-fromGEDiscard ge = case ge of
-  Result p -> property p
-  _ -> discard
-
--- | Like `Prelude.head` in the `GE` monad
-headGE :: Foldable t => t a -> GE a
-headGE t
-  | x : _ <- toList t = pure x
-  | otherwise = fatalError "head of empty structure"
-
--- | Turn a `GE [a]` to `[a]`, `genError` goes to `[]` and `fatalError` to `error`.
-listFromGE :: GE [a] -> [a]
-listFromGE = fromGE (const []) . explain "listFromGE"
-
--- ========================================================
--- Useful operations on GenT
-
--- | Run a t`GenT` generator in `Strict` mode
-strictGen :: GenT m a -> Gen (m a)
-strictGen genT = runGenT genT Strict []
-
--- | Run a t`GenT` generator in `Loose` mode
-looseGen :: GenT m a -> Gen (m a)
-looseGen genT = runGenT genT Loose []
-
--- | Turn a t`GenT` generator into a `Gen` generator in `Strict` mode
-genFromGenT :: GenT GE a -> Gen a
-genFromGenT genT = errorGE <$> strictGen genT
-
--- | Locally change the generation size
-resizeT :: (Int -> Int) -> GenT m a -> GenT m a
-resizeT f (GenT gm) = GenT $ \mode msgs -> sized $ \sz -> resize (f sz) (gm mode msgs)
-
--- | Turn a `Gen` generator into a t`GenT` generator that never fails.
-pureGen :: Applicative m => Gen a -> GenT m a
-pureGen gen = GenT $ \_ _ -> pure <$> gen
-
--- | Lift `listOf` to t`GenT`
-listOfT :: MonadGenError m => GenT GE a -> GenT m [a]
-listOfT gen = do
-  lst <- pureGen . listOf $ runGenT gen Loose []
-  catGEs lst
-
--- | Generate a list of elements of length at most @goalLen@, but accepting
--- failure to get that many elements so long as @validLen@ is true.
-listOfUntilLenT ::
-  (Typeable a, MonadGenError m) =>
-  -- | Element generator
-  GenT GE a ->
-  -- | @goalLen@ goal length
-  Int ->
-  -- | @validLen@ filter
-  (Int -> Bool) ->
-  GenT m [a]
-listOfUntilLenT gen goalLen validLen =
-  genList `suchThatT` validLen . length
-  where
-    genList = do
-      res <- pureGen . vectorOf goalLen $ runGenT gen Loose []
-      catGEs res
-
--- | Lift `vectorOf` to t`GenT`
-vectorOfT :: MonadGenError m => Int -> GenT GE a -> GenT m [a]
-vectorOfT i gen = GenT $ \mode _ -> do
-  res <- fmap sequence . vectorOf i $ runGenT gen Strict []
-  case mode of
-    Strict -> pure $ runGE res
-    Loose -> case res of
-      FatalError es -> pure $ genErrors es
-      _ -> pure $ runGE res
-
-infixl 2 `suchThatT`
-
--- | Lift `suchThat` to t`GenT`, equivalent to @`suchThatT` 100@
-suchThatT :: (Typeable a, MonadGenError m) => GenT m a -> (a -> Bool) -> GenT m a
-suchThatT g p = suchThatWithTryT 100 g p
-
--- | Lift `suchThat` to t`GenT` with special handling of generation mode. In
--- `Strict` mode @suchThatWithTry tries@ will try @tries@ times and fail with a
--- `fatalError` if unsuccessful.  In `Loose` mode however, we will try only
--- once and generate a `genError`.
-suchThatWithTryT ::
-  forall a m. (Typeable a, MonadGenError m) => Int -> GenT m a -> (a -> Bool) -> GenT m a
-suchThatWithTryT tries g p = do
-  mode <- getMode
-  let (n, cont) = case mode of
-        Strict -> (tries, fatalError)
-        Loose -> (1 :: Int, genError) -- TODO: Maybe 1 is not the right number here!
-  go n cont
-  where
-    go 0 cont =
-      cont
-        ("Ran out of tries (" ++ show tries ++ ") on suchThatWithTryT at type " ++ show (typeRep (Proxy @a)))
-    go n cont = do
-      a <- g
-      if p a then pure a else scaleT (+ 1) $ go (n - 1) cont
-
--- | Lift `scale` to t`GenT`
-scaleT :: (Int -> Int) -> GenT m a -> GenT m a
-scaleT sc (GenT gen) = GenT $ \mode msgs -> scale sc $ gen mode msgs
-
--- | Access the `GenMode` we are running in, useful to decide e.g.  if we want
--- to re-try in case of a `GenError` or give up
-getMode :: Applicative m => GenT m GenMode
-getMode = GenT $ \mode _ -> pure (pure mode)
-
-getMessages :: Applicative m => GenT m [NonEmpty String]
-getMessages = GenT $ \_ msgs -> pure (pure msgs)
-
--- | Locally change the generation mode
-withMode :: GenMode -> GenT m a -> GenT m a
-withMode mode gen = GenT $ \_ msgs -> runGenT gen mode msgs
-
--- | Lift `oneof` to t`GenT`
-oneofT :: (Typeable a, MonadGenError m) => [GenT GE a] -> GenT m a
-oneofT gs = frequencyT $ map (1,) gs
-
--- | Lift `frequency` to t`GenT`
-frequencyT :: (Typeable a, MonadGenError m) => [(Int, GenT GE a)] -> GenT m a
-frequencyT gs = do
-  mode <- getMode
-  msgs <- getMessages
-  r <-
-    explain "suchThatT in oneofT" $
-      pureGen (frequency [(f, runGenT g mode msgs) | (f, g) <- gs]) `suchThatT` isOk
-  runGE r
-
--- | Lift `choose` to t`GenT`, failing with a `genError` in case of an empty interval
-chooseT :: (Random a, Ord a, Show a, MonadGenError m) => (a, a) -> GenT m a
-chooseT (a, b)
-  | b < a = genError ("chooseT (" ++ show a ++ ", " ++ show b ++ ")")
-  | otherwise = pureGen $ choose (a, b)
-
--- | Get the size provided to the generator
-sizeT :: Monad m => GenT m Int
-sizeT = GenT $ \mode msgs -> sized $ \n -> runGenT (pure n) mode msgs
-
--- ==================================================================
--- Reflective analysis of the internal GE structure of (GenT GE x)
--- This allows "catching" internal FatalError and GenError, and allowing
--- the program to control what happens in those cases.
-
--- | Always succeeds, but returns the internal GE structure for analysis
-inspect :: forall m x. MonadGenError m => GenT GE x -> GenT m (GE x)
-inspect (GenT f) = GenT g
-  where
-    g mode msgs = do geThing <- f mode msgs; pure @Gen (pure @m geThing)
-
--- | Ignore all kinds of Errors, by squashing them into Nothing
-tryGenT :: MonadGenError m => GenT GE a -> GenT m (Maybe a)
-tryGenT g = do
-  r <- inspect g
-  case r of
-    FatalError _ -> pure Nothing
-    GenError _ -> pure Nothing
-    Result a -> pure $ Just a
-
--- Pass on the error messages of both kinds of Errors, by squashing and combining both of them into Left constructor
-catchGenT :: MonadGenError m => GenT GE a -> GenT m (Either (NonEmpty (NonEmpty String)) a)
-catchGenT g = do
-  r <- inspect g
-  case r of
-    FatalError es -> pure $ Left es
-    GenError es -> pure $ Left es
-    Result a -> pure $ Right a
-
--- | Pass on the error messages of both kinds of Errors in the Gen (not the GenT) monad
-catchGen :: GenT GE a -> Gen (Either (NonEmpty (NonEmpty String)) a)
-catchGen g = genFromGenT (catchGenT g)
-
--- | Return the first successfull result from a list of computations, if they all fail
---   return a list of the error messages from each one.
-firstGenT ::
-  forall m a. MonadGenError m => [GenT GE a] -> GenT m (Either [(NonEmpty (NonEmpty String))] a)
-firstGenT gs = loop gs []
-  where
-    loop ::
-      [GenT GE a] -> [NonEmpty (NonEmpty String)] -> GenT m (Either [NonEmpty (NonEmpty String)] a)
-    loop [] ys = pure (Left (reverse ys))
-    loop (x : xs) ys = do
-      this <- catchGenT x
-      case this of
-        Left zs -> loop xs (zs : ys)
-        Right a -> pure (Right a)
-
--- | Drop a @t`GenT` `GE`@ computation into a @t`GenT` m@ computation.
---
--- Depending on the monad @m@ Some error information might be lost as
--- the monad might fold `FatalError`'s and `GenError`'s together.
-dropGen :: MonadGenError m => GenT GE a -> GenT m a
-dropGen y = do
-  r <- inspect y
-  case r of
-    FatalError es -> fatalErrors es
-    GenError es -> genErrors es
-    Result a -> pure a
-
--- ======================================
-
--- | like explain for GenT, but uses [String] rather than (NonEmpty String)
---   if the list is null, it becomes the identity
-push :: forall m a. MonadGenError m => [String] -> m a -> m a
-push [] m = m
-push (x : xs) m = explainNE (x :| xs) m
-
--- | like explain for GE, but uses [String] rather than (NonEmpty String)
---   if the list is null, it becomes the identity
-pushGE :: forall a. [String] -> GE a -> GE a
-pushGE [] x = x
-pushGE (x : xs) m = explainNE (x :| xs) m
diff --git a/libs/constrained-generators/src/Constrained/Generation.hs b/libs/constrained-generators/src/Constrained/Generation.hs
deleted file mode 100644
index 888477f8094..00000000000
--- a/libs/constrained-generators/src/Constrained/Generation.hs
+++ /dev/null
@@ -1,1342 +0,0 @@
-{-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE ImportQualifiedPost #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE PatternSynonyms #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# OPTIONS_GHC -Wno-orphans #-}
-
--- | All the things that are necessary for generation and shrinking.
-module Constrained.Generation (
-  -- * Generation and shrinking
-  genFromSpec,
-  genFromSpecT,
-  genFromSpecWithSeed,
-  shrinkWithSpec,
-  simplifySpec,
-
-  -- ** Debuggin
-  printPlan,
-  debugSpec,
-  prettyPlan,
-
-  -- * Function Symbols
-  or_,
-  not_,
-  injRight_,
-  injLeft_,
-  (==.),
-
-  -- * Other syntax
-  whenTrue,
-
-  -- * Internals
-  CountCases,
-  SumW (..),
-  BoolW (..),
-  EqW (..),
-  SumSpec (..),
-  pattern SumSpec,
-) where
-
-import Constrained.AbstractSyntax
-import Constrained.Base
-import Constrained.Conformance
-import Constrained.Core
-import Constrained.Env (Env)
-import Constrained.Env qualified as Env
-import Constrained.FunctionSymbol
-import Constrained.GenT
-import Constrained.Generic
-import Constrained.Graph hiding (irreflexiveDependencyOn)
-import Constrained.List
-import Constrained.NumOrd
-import Constrained.PrettyUtils
-import Constrained.Syntax
-import Control.Applicative
-import Control.Monad
-import Control.Monad.Writer (Writer, runWriter, tell)
-import Data.Foldable
-import Data.Int
-import Data.Kind
-import Data.List (partition)
-import Data.List.NonEmpty qualified as NE
-import Data.Maybe
-import Data.Semigroup (Any (..), getSum)
-import Data.Semigroup qualified as Semigroup
-import Data.Set (Set)
-import Data.Set qualified as Set
-import Data.String
-import Data.Typeable
-import GHC.Stack
-import GHC.TypeLits
-import Prettyprinter hiding (cat)
-import Test.QuickCheck hiding (Args, Fun, Witness, forAll, witness)
-import Test.QuickCheck.Gen
-import Test.QuickCheck.Random hiding (left, right)
-import Prelude hiding (cycle, pred)
-
-------------------------------------------------------------------------
--- Generation, shrinking, and debugging
-------------------------------------------------------------------------
-
--- | Generate a value that satisfies the spec. This function can fail if the
--- spec is inconsistent, there is a dependency error, or if the underlying
--- generators are not flexible enough.
-genFromSpecT ::
-  forall a m. (HasCallStack, HasSpec a, MonadGenError m) => Specification a -> GenT m a
-genFromSpecT (simplifySpec -> spec) = case spec of
-  ExplainSpec [] s -> genFromSpecT s
-  ExplainSpec es s -> push es (genFromSpecT s)
-  MemberSpec as -> explain ("genFromSpecT on spec" ++ show spec) $ pureGen (elements (NE.toList as))
-  TrueSpec -> genFromSpecT (typeSpec $ emptySpec @a)
-  SuspendedSpec x p
-    -- NOTE: If `x` isn't free in `p` we still have to try to generate things
-    -- from `p` to make sure `p` is sat and then we can throw it away. A better
-    -- approach would be to only do this in the case where we don't know if `p`
-    -- is sat. The proper way to implement such a sat check is to remove
-    -- sat-but-unnecessary variables in the optimiser.
-    | not $ Name x `appearsIn` p -> do
-        !_ <- genFromPreds mempty p
-        genFromSpecT TrueSpec
-    | otherwise -> do
-        env <- genFromPreds mempty p
-        Env.find env x
-  TypeSpec s cant -> do
-    mode <- getMode
-    explainNE
-      ( NE.fromList
-          [ "genFromSpecT on (TypeSpec tspec cant) at type " ++ showType @a
-          , "tspec = "
-          , show s
-          , "cant = " ++ show (short cant)
-          , "with mode " ++ show mode
-          ]
-      )
-      $
-      -- TODO: we could consider giving `cant` as an argument to `genFromTypeSpec` if this
-      -- starts giving us trouble.
-      genFromTypeSpec s `suchThatT` (`notElem` cant)
-  ErrorSpec e -> genErrorNE e
-
--- | A version of `genFromSpecT` that simply errors if the generator fails
-genFromSpec :: forall a. (HasCallStack, HasSpec a) => Specification a -> Gen a
-genFromSpec spec = do
-  res <- catchGen $ genFromSpecT @a @GE spec
-  either (error . ('\n' :) . catMessages) pure res
-
--- | A version of `genFromSpecT` that takes a seed and a size and gives you a result
-genFromSpecWithSeed ::
-  forall a. (HasCallStack, HasSpec a) => Int -> Int -> Specification a -> a
-genFromSpecWithSeed seed size spec = unGen (genFromSpec spec) (mkQCGen seed) size
-
--- ----------------------- Shrinking -------------------------------
-
--- | Shrink a value while preserving adherence to a `Specification`
-shrinkWithSpec :: forall a. HasSpec a => Specification a -> a -> [a]
--- TODO: possibly allow for ignoring the `conformsToSpec` check in the `TypeSpec`
--- case when you know what you're doing
-shrinkWithSpec (simplifySpec -> spec) a = filter (`conformsToSpec` spec) $ case spec of
-  ExplainSpec _ s -> shrinkWithSpec s a
-  -- TODO: filter on can't if we have a known to be sound shrinker
-  TypeSpec s _ -> shrinkWithTypeSpec s a
-  -- TODO: The better way of doing this is to compute the dependency graph,
-  -- shrink one variable at a time, and fixup the rest of the variables
-  SuspendedSpec {} -> shr a
-  MemberSpec {} -> shr a
-  TrueSpec -> shr a
-  ErrorSpec {} -> []
-  where
-    shr = shrinkWithTypeSpec (emptySpec @a)
-
--- Debugging --------------------------------------------------------------
-
--- | A version of `genFromSpecT` that runs in the IO monad. Good for debugging.
-debugSpec :: forall a. HasSpec a => Specification a -> IO ()
-debugSpec spec = do
-  ans <- generate $ genFromGenT $ inspect (genFromSpecT spec)
-  let f x = putStrLn (unlines (NE.toList x))
-      ok x =
-        if conformsToSpec x spec
-          then putStrLn "True"
-          else putStrLn "False, perhaps there is an unsafeExists in the spec?"
-  case ans of
-    FatalError xs -> mapM_ f xs
-    GenError xs -> mapM_ f xs
-    Result x -> print spec >> print x >> ok x
-
--- | Pretty-print the plan for a `Specifcation` in the terminal for debugging
-printPlan :: HasSpec a => Specification a -> IO ()
-printPlan = print . prettyPlan
-
--- | Plan pretty-printer for debugging
-prettyPlan :: HasSpec a => Specification a -> Doc ann
-prettyPlan (simplifySpec -> spec)
-  | SuspendedSpec _ p <- spec
-  , Result plan <- prepareLinearization p =
-      vsep'
-        [ "Simplified spec:" /> pretty spec
-        , pretty plan
-        ]
-  | otherwise = "Simplfied spec:" /> pretty spec
-
--- ---------------------- Building a plan -----------------------------------
-
-substStage :: Env -> SolverStage -> SolverStage
-substStage env (SolverStage y ps spec) = normalizeSolverStage $ SolverStage y (substPred env <$> ps) spec
-
-normalizeSolverStage :: SolverStage -> SolverStage
-normalizeSolverStage (SolverStage x ps spec) = SolverStage x ps'' (spec <> spec')
-  where
-    (ps', ps'') = partition ((1 ==) . Set.size . freeVarSet) ps
-    spec' = fromGESpec $ computeSpec x (And ps')
-
--- TODO: here we can compute both the explicit hints (i.e. constraints that
--- define the order of two variables) and any whole-program smarts.
-computeHints :: [Pred] -> Hints
-computeHints ps =
-  transitiveClosure $ fold [x `irreflexiveDependencyOn` y | DependsOn x y <- ps]
-
--- | Linearize a predicate, turning it into a list of variables to solve and
--- their defining constraints such that each variable can be solved independently.
-prepareLinearization :: Pred -> GE SolverPlan
-prepareLinearization p = do
-  let preds = concatMap saturatePred $ flattenPred p
-      hints = computeHints preds
-      graph = transitiveClosure $ hints <> respecting hints (foldMap computeDependencies preds)
-  plan <-
-    explainNE
-      ( NE.fromList
-          [ "Linearizing"
-          , show $ "  preds: " <> pretty preds
-          , show $ "  graph: " <> pretty graph
-          ]
-      )
-      $ linearize preds graph
-  pure $ backPropagation $ SolverPlan plan graph
-
--- | Flatten nested `Let`, `Exists`, and `And` in a `Pred fn`. `Let` and
--- `Exists` bound variables become free in the result.
-flattenPred :: Pred -> [Pred]
-flattenPred pIn = go (freeVarNames pIn) [pIn]
-  where
-    go _ [] = []
-    go fvs (p : ps) = case p of
-      And ps' -> go fvs (ps' ++ ps)
-      -- NOTE: the order of the arguments to `==.` here are important.
-      -- The whole point of `Let` is that it allows us to solve all of `t`
-      -- before we solve the variables in `t`.
-      Let t b -> goBinder fvs b ps (\x -> (assert (t ==. (V x)) :))
-      Exists _ b -> goBinder fvs b ps (const id)
-      When b pp -> map (When b) (go fvs [pp]) ++ go fvs ps
-      Explain es pp -> map (explanation es) (go fvs [pp]) ++ go fvs ps
-      _ -> p : go fvs ps
-
-    goBinder ::
-      Set Int ->
-      Binder a ->
-      [Pred] ->
-      (HasSpec a => Var a -> [Pred] -> [Pred]) ->
-      [Pred]
-    goBinder fvs (x :-> p) ps k = k x' $ go (Set.insert (nameOf x') fvs) (p' : ps)
-      where
-        (x', p') = freshen x p fvs
-
--- Consider: A + B = C + D
--- We want to fail if A and B are independent.
--- Consider: A + B = A + C, A <- B
--- Here we want to consider this constraint defining for A
-linearize ::
-  MonadGenError m => [Pred] -> DependGraph -> m [SolverStage]
-linearize preds graph = do
-  sorted <- case topsort graph of
-    Left cycle ->
-      fatalError
-        ( show $
-            "linearize: Dependency cycle in graph:"
-              /> vsep'
-                [ "cycle:" /> pretty cycle
-                , "graph:" /> pretty graph
-                ]
-        )
-    Right sorted -> pure sorted
-  go sorted [(freeVarSet ps, ps) | ps <- filter isRelevantPred preds]
-  where
-    isRelevantPred TruePred = False
-    isRelevantPred DependsOn {} = False
-    isRelevantPred (Assert (Lit True)) = False
-    isRelevantPred _ = True
-
-    go [] [] = pure []
-    go [] ps
-      | null $ foldMap fst ps =
-          case checkPredsE (pure "Linearizing fails") mempty (map snd ps) of
-            Nothing -> pure []
-            Just msgs -> genErrorNE msgs
-      | otherwise =
-          fatalErrorNE $
-            NE.fromList
-              [ "Dependency error in `linearize`: "
-              , show $ indent 2 $ "graph: " /> pretty graph
-              , show $
-                  indent 2 $
-                    "the following left-over constraints are not defining constraints for a unique variable:"
-                      /> vsep' (map (pretty . snd) ps)
-              ]
-    go (n@(Name x) : ns) ps = do
-      let (nps, ops) = partition (isLastVariable n . fst) ps
-      (normalizeSolverStage (SolverStage x (map snd nps) mempty) :) <$> go ns ops
-
-    isLastVariable n set = n `Set.member` set && solvableFrom n (Set.delete n set) graph
-
-------------------------------------------------------------------------
--- Simplification of Specifications
-------------------------------------------------------------------------
-
--- | Spec simplification, use with care and don't modify the spec after using this!
-simplifySpec :: HasSpec a => Specification a -> Specification a
-simplifySpec spec = case applyNameHints spec of
-  SuspendedSpec x p ->
-    let optP = optimisePred p
-     in fromGESpec $
-          explain
-            ("\nWhile calling simplifySpec on var " ++ show x ++ "\noptP=\n" ++ show optP ++ "\n")
-            (computeSpecSimplified x optP)
-  MemberSpec xs -> MemberSpec xs
-  ErrorSpec es -> ErrorSpec es
-  TypeSpec ts cant -> TypeSpec ts cant
-  TrueSpec -> TrueSpec
-  ExplainSpec es s -> explainSpec es (simplifySpec s)
-
--- ------- Stages of simplifying -------------------------------
-
--- TODO: it might be necessary to run aggressiveInlining again after the let floating etc.
-optimisePred :: Pred -> Pred
-optimisePred p =
-  simplifyPred
-    . letSubexpressionElimination
-    . letFloating
-    . aggressiveInlining
-    . simplifyPred
-    $ p
-
-aggressiveInlining :: Pred -> Pred
-aggressiveInlining pred
-  | inlined = aggressiveInlining pInlined
-  | otherwise = pred
-  where
-    (pInlined, Any inlined) = runWriter $ go (freeVars pred) [] pred
-
-    underBinder fvs x p = fvs `without` [Name x] <> singleton (Name x) (countOf (Name x) p)
-
-    underBinderSub :: HasSpec a => Subst -> Var a -> Subst
-    underBinderSub sub x =
-      [ x' := t
-      | x' := t <- sub
-      , isNothing $ eqVar x x'
-      ]
-
-    -- NOTE: this is safe because we only use the `Subst` when it results in a literal so there
-    -- is no risk of variable capture.
-    goBinder :: FreeVars -> Subst -> Binder a -> Writer Any (Binder a)
-    goBinder fvs sub (x :-> p) = (x :->) <$> go (underBinder fvs x p) (underBinderSub sub x) p
-
-    -- Check that the name `n` is only ever used as the only variable
-    -- in the expressions where it appears. This ensures that it doesn't
-    -- interact with anything.
-    onlyUsedUniquely n p = case p of
-      Assert t
-        | n `appearsIn` t -> Set.size (freeVarSet t) == 1
-        | otherwise -> True
-      And ps -> all (onlyUsedUniquely n) ps
-      -- TODO: we can (and should) probably add a bunch of cases to this.
-      _ -> False
-
-    go fvs sub pred2 = case pred2 of
-      ElemPred bool t xs
-        | not (isLit t)
-        , Lit a <- substituteAndSimplifyTerm sub t -> do
-            tell $ Any True
-            pure $ ElemPred bool (Lit a) xs
-        | otherwise -> pure $ ElemPred bool t xs
-      Subst x t p -> go fvs sub (substitutePred x t p)
-      Reifies t' t f
-        | not (isLit t)
-        , Lit a <- substituteAndSimplifyTerm sub t -> do
-            tell $ Any True
-            pure $ Reifies t' (Lit a) f
-        | otherwise -> pure $ Reifies t' t f
-      ForAll set b
-        | not (isLit set)
-        , Lit a <- substituteAndSimplifyTerm sub set -> do
-            tell $ Any True
-            pure $ foldMap (`unBind` b) (forAllToList a)
-        | otherwise -> ForAll set <$> goBinder fvs sub b
-      Case t bs
-        | not (isLit t)
-        , Lit a <- substituteAndSimplifyTerm sub t -> do
-            tell $ Any True
-            pure $ runCaseOn a (mapList thing bs) $ \x v p -> substPred (Env.singleton x v) p
-        | (Weighted w (x :-> p) :> Nil) <- bs -> do
-            let t' = substituteAndSimplifyTerm sub t
-            p' <- go (underBinder fvs x p) (x := t' : sub) p
-            pure $ Case t (Weighted w (x :-> p') :> Nil)
-        | otherwise -> Case t <$> mapMList (traverseWeighted $ goBinder fvs sub) bs
-      When b tp
-        | not (isLit b)
-        , Lit a <- substituteAndSimplifyTerm sub b -> do
-            tell $ Any True
-            pure $ if a then tp else TruePred
-        | otherwise -> whenTrue b <$> go fvs sub tp
-      Let t (x :-> p)
-        | all (\n -> count n fvs <= 1) (freeVarSet t) -> do
-            tell $ Any True
-            pure $ substitutePred x t p
-        | onlyUsedUniquely (Name x) p -> do
-            tell $ Any True
-            pure $ substitutePred x t p
-        | not $ Name x `appearsIn` p -> do
-            tell $ Any True
-            pure p
-        | not (isLit t)
-        , Lit a <- substituteAndSimplifyTerm sub t -> do
-            tell $ Any True
-            pure $ unBind a (x :-> p)
-        | otherwise -> Let t . (x :->) <$> go (underBinder fvs x p) (x := t : sub) p
-      Exists k b -> Exists k <$> goBinder fvs sub b
-      And ps -> fold <$> mapM (go fvs sub) ps
-      Assert t
-        | not (isLit t)
-        , Lit b <- substituteAndSimplifyTerm sub t -> do
-            tell $ Any True
-            pure $ toPred b
-        | otherwise -> pure pred2
-      -- If the term turns into a literal, there is no more generation to do here
-      -- so we can ignore the `GenHint`
-      GenHint _ t
-        | not (isLit t)
-        , Lit {} <- substituteAndSimplifyTerm sub t -> do
-            tell $ Any True
-            pure TruePred
-        | otherwise -> pure pred2
-      DependsOn t t'
-        | not (isLit t)
-        , Lit {} <- substituteAndSimplifyTerm sub t -> do
-            tell $ Any True
-            pure $ TruePred
-        | not (isLit t')
-        , Lit {} <- substituteAndSimplifyTerm sub t' -> do
-            tell $ Any True
-            pure $ TruePred
-        | otherwise -> pure pred2
-      TruePred -> pure pred2
-      FalsePred {} -> pure pred2
-      Monitor {} -> pure pred2
-      Explain es p -> Explain es <$> go fvs sub p
-
--- | Apply a substitution and simplify the resulting term if the
--- substitution changed the term.
-substituteAndSimplifyTerm :: Subst -> Term a -> Term a
-substituteAndSimplifyTerm sub t =
-  case runWriter $ substituteTerm' sub t of
-    (t', Any b)
-      | b -> simplifyTerm t'
-      | otherwise -> t'
-
--- | Simplify a Term, if the Term is an 'App', apply the rewrite rules
---   chosen by the (Logic sym t bs a) instance attached
---   to the function witness 'f'
-simplifyTerm :: forall a. Term a -> Term a
-simplifyTerm = \case
-  V v -> V v
-  Lit l -> Lit l
-  App (f :: t bs a) (mapList simplifyTerm -> ts)
-    | Just vs <- fromLits ts -> Lit $ uncurryList_ unValue (semantics f) vs
-    | Just t <- rewriteRules f ts (Evidence @(AppRequires t bs a)) -> simplifyTerm t
-    | otherwise -> App f ts
-
-simplifyPred :: Pred -> Pred
-simplifyPred = \case
-  -- If the term simplifies away to a literal, that means there is no
-  -- more generation to do so we can get rid of `GenHint`
-  GenHint h t -> case simplifyTerm t of
-    Lit {} -> TruePred
-    t' -> GenHint h t'
-  p@(ElemPred bool t xs) -> case simplifyTerm t of
-    Lit x -> case (elem x xs, bool) of
-      (True, True) -> TruePred
-      (True, False) -> FalsePred ("notElemPred reduces to True" :| [show p])
-      (False, True) -> FalsePred ("elemPred reduces to False" :| [show p])
-      (False, False) -> TruePred
-    t' -> ElemPred bool t' xs
-  Subst x t p -> simplifyPred $ substitutePred x t p
-  Assert t -> Assert $ simplifyTerm t
-  Reifies t' t f -> case simplifyTerm t of
-    Lit a ->
-      -- Assert $ simplifyTerm t' ==. Lit (f a)
-      ElemPred True (simplifyTerm t') (pure (f a))
-    t'' -> Reifies (simplifyTerm t') t'' f
-  ForAll (ts :: Term t) (b :: Binder a) -> case simplifyTerm ts of
-    Lit as -> foldMap (`unBind` b) (forAllToList as)
-    -- (App (extractW (UnionW @t) -> Just Refl) xs) -> error "MADE IT"
-    {- Has to wait until we have HasSpec(Set a) instance
-    UnionPat (xs :: Term (Set a)) ys ->
-       let b' = simplifyBinder b
-       in mkForAll xs b' <> mkForAll ys b' -}
-    set' -> case simplifyBinder b of
-      _ :-> TruePred -> TruePred
-      b' -> ForAll set' b'
-  DependsOn _ Lit {} -> TruePred
-  DependsOn Lit {} _ -> TruePred
-  DependsOn x y -> DependsOn x y
-  -- Here is where we need the SumSpec instance
-  Case t bs -> mkCase (simplifyTerm t) (mapList (mapWeighted simplifyBinder) bs)
-  When b p -> whenTrue (simplifyTerm b) (simplifyPred p)
-  TruePred -> TruePred
-  FalsePred es -> FalsePred es
-  And ps -> fold (simplifyPreds ps)
-  Let t b -> case simplifyTerm t of
-    t'@App {} -> Let t' (simplifyBinder b)
-    -- Variable or literal
-    t' | x :-> p <- b -> simplifyPred $ substitutePred x t' p
-  Exists k b -> case simplifyBinder b of
-    _ :-> TruePred -> TruePred
-    -- This is to get rid of exisentials like:
-    -- `constrained $ \ x -> exists $ \ y -> [x ==. y, y + 2 <. 10]`
-    x :-> p | Just t <- pinnedBy x p -> simplifyPred $ substitutePred x t p
-    b' -> Exists k b'
-  Monitor {} -> TruePred
-  -- TODO: This is a bit questionable. On the one hand we could get rid of `Explain` here
-  -- and just return `simplifyPred p` but doing so risks missing explanations when things
-  -- do go wrong.
-  Explain es p -> explanation es $ simplifyPred p
-
-simplifyPreds :: [Pred] -> [Pred]
-simplifyPreds = go [] . map simplifyPred
-  where
-    go acc [] = reverse acc
-    go _ (FalsePred err : _) = [FalsePred err]
-    go acc (TruePred : ps) = go acc ps
-    go acc (p : ps) = go (p : acc) ps
-
-simplifyBinder :: Binder a -> Binder a
-simplifyBinder (x :-> p) = x :-> simplifyPred p
-
--- TODO: this can probably be cleaned up and generalized along with generalizing
--- to make sure we float lets in some missing cases.
-letFloating :: Pred -> Pred
-letFloating = fold . go []
-  where
-    goBlock ctx ps = goBlock' (freeVarNames ctx <> freeVarNames ps) ctx ps
-
-    goBlock' :: Set Int -> [Pred] -> [Pred] -> [Pred]
-    goBlock' _ ctx [] = ctx
-    goBlock' fvs ctx (Let t (x :-> p) : ps) =
-      -- We can do `goBlock'` here because we've already done let floating
-      -- on the inner `p`
-      [Let t (x' :-> fold (goBlock' (Set.insert (nameOf x') fvs) ctx (p' : ps)))]
-      where
-        (x', p') = freshen x p fvs
-    goBlock' fvs ctx (And ps : ps') = goBlock' fvs ctx (ps ++ ps')
-    goBlock' fvs ctx (p : ps) = goBlock' fvs (p : ctx) ps
-
-    goExists ::
-      HasSpec a =>
-      [Pred] ->
-      (Binder a -> Pred) ->
-      Var a ->
-      Pred ->
-      [Pred]
-    goExists ctx ex x (Let t (y :-> p))
-      | not $ Name x `appearsIn` t =
-          let (y', p') = freshen y p (Set.insert (nameOf x) $ freeVarNames p <> freeVarNames t)
-           in go ctx (Let t (y' :-> ex (x :-> p')))
-    goExists ctx ex x p = ex (x :-> p) : ctx
-
-    pushExplain es (Let t (x :-> p)) = Let t (x :-> pushExplain es p)
-    pushExplain es (And ps) = And (pushExplain es <$> ps)
-    pushExplain es (Exists k (x :-> p)) =
-      Exists (explainSemantics k) (x :-> pushExplain es p)
-      where
-        -- TODO: Unfortunately this is necessary on ghc 8.10.7
-        explainSemantics ::
-          forall a.
-          ((forall b. Term b -> b) -> GE a) ->
-          (forall b. Term b -> b) ->
-          GE a
-        explainSemantics k2 env = explainNE es $ k2 env
-    -- TODO: possibly one wants to have a `Term` level explanation in case
-    -- the `b` propagates to ErrorSpec for some reason?
-    pushExplain es (When b p) = When b (pushExplain es p)
-    pushExplain es p = explanation es p
-
-    go ctx = \case
-      ElemPred bool t xs -> ElemPred bool t xs : ctx
-      And ps0 -> goBlock ctx (map letFloating ps0)
-      Let t (x :-> p) -> goBlock ctx [Let t (x :-> letFloating p)]
-      Exists k (x :-> p) -> goExists ctx (Exists k) x (letFloating p)
-      Subst x t p -> go ctx (substitutePred x t p)
-      Reifies t' t f -> Reifies t' t f : ctx
-      Explain es p -> pushExplain es p : ctx
-      -- TODO: float let through forall if possible
-      ForAll t (x :-> p) -> ForAll t (x :-> letFloating p) : ctx
-      -- TODO: float let through the cases if possible
-      Case t bs -> Case t (mapList (mapWeighted (\(x :-> p) -> x :-> letFloating p)) bs) : ctx
-      -- TODO: float let through if possible
-      When b p -> When b (letFloating p) : ctx
-      -- Boring cases
-      Assert t -> Assert t : ctx
-      GenHint h t -> GenHint h t : ctx
-      DependsOn t t' -> DependsOn t t' : ctx
-      TruePred -> TruePred : ctx
-      FalsePred es -> FalsePred es : ctx
-      Monitor m -> Monitor m : ctx
-
--- Common subexpression elimination but only on terms that are already let-bound.
-letSubexpressionElimination :: Pred -> Pred
-letSubexpressionElimination = go []
-  where
-    adjustSub :: HasSpec a => Var a -> Subst -> Subst
-    adjustSub x sub =
-      [ x' := t
-      | x' := t <- sub
-      , isNothing $ eqVar x x'
-      , -- TODO: possibly freshen the binder where
-      -- `x` appears instead?
-      not $ Name x `appearsIn` t
-      ]
-
-    goBinder :: Subst -> Binder a -> Binder a
-    goBinder sub (x :-> p) = x :-> go (adjustSub x sub) p
-
-    go sub = \case
-      ElemPred bool t xs -> ElemPred bool (backwardsSubstitution sub t) xs
-      GenHint h t -> GenHint h (backwardsSubstitution sub t)
-      And ps -> And (go sub <$> ps)
-      Let t (x :-> p) -> Let t' (x :-> go (x := t' : sub') p)
-        where
-          t' = backwardsSubstitution sub t
-          sub' = adjustSub x sub
-      Exists k b -> Exists k (goBinder sub b)
-      Subst x t p -> go sub (substitutePred x t p)
-      Assert t -> Assert (backwardsSubstitution sub t)
-      Reifies t' t f -> Reifies (backwardsSubstitution sub t') (backwardsSubstitution sub t) f
-      -- NOTE: this is a tricky case. One possible thing to do here is to keep the old `DependsOn t t'`
-      -- and have the new DependsOn if `backwardsSubstitution` changed something. With this semantics you
-      -- risk running into unintuitive behaviour if you have something like:
-      -- ```
-      -- let x = y + z in
-      --  {y + z `dependsOn` w
-      --   assert $ w <. y + 2
-      --   ...}
-      -- ```
-      -- This will be rewritten as:
-      -- ```
-      -- let x = y + z in
-      --  {z `dependsOn` w
-      --   assert $ w <. y + 2
-      --   ...}
-      -- ```
-      -- which changes the dependency order of `w` and `y`. However, fixing
-      -- this behaviour in turn makes it more difficult to detect when
-      -- variables are no longer used after being substituted away - which
-      -- blocks some other optimizations. As we strongly encourage users not to
-      -- use `letBind` in their own code most users will never encounter this issue
-      -- so the tradeoff is probably worth it.
-      DependsOn t t' -> DependsOn (backwardsSubstitution sub t) (backwardsSubstitution sub t')
-      ForAll t b -> ForAll (backwardsSubstitution sub t) (goBinder sub b)
-      Case t bs -> Case (backwardsSubstitution sub t) (mapList (mapWeighted $ goBinder sub) bs)
-      When b p -> When (backwardsSubstitution sub b) (go sub p)
-      TruePred -> TruePred
-      FalsePred es -> FalsePred es
-      Monitor m -> Monitor m
-      Explain es p -> Explain es $ go sub p
-
--- Turning Preds into Specifications. Here is where Propagation occurs ----
-
--- | Precondition: the `Pred` defines the `Var a`
--- Runs in `GE` in order for us to have detailed context on failure.
-computeSpecSimplified ::
-  forall a. (HasSpec a, HasCallStack) => Var a -> Pred -> GE (Specification a)
-computeSpecSimplified x pred3 = localGESpec $ case simplifyPred pred3 of
-  ElemPred True t xs -> propagateSpec (MemberSpec xs) <$> toCtx x t
-  ElemPred False (t :: Term b) xs -> propagateSpec (TypeSpec @b (emptySpec @b) (NE.toList xs)) <$> toCtx x t
-  Monitor {} -> pure mempty
-  GenHint h t -> propagateSpec (giveHint h) <$> toCtx x t
-  Subst x' t p' -> computeSpec x (substitutePred x' t p') -- NOTE: this is impossible as it should have gone away already
-  TruePred -> pure mempty
-  FalsePred es -> genErrorNE es
-  And ps -> do
-    spec <- fold <$> mapM (computeSpecSimplified x) ps
-    case spec of
-      ExplainSpec es (SuspendedSpec y ps') -> pure $ explainSpec es (SuspendedSpec y $ simplifyPred ps')
-      SuspendedSpec y ps' -> pure $ SuspendedSpec y $ simplifyPred ps'
-      s -> pure s
-  Let t b -> pure $ SuspendedSpec x (Let t b)
-  Exists k b -> pure $ SuspendedSpec x (Exists k b)
-  Assert (Lit True) -> pure mempty
-  Assert (Lit False) -> genError (show pred3)
-  Assert t -> propagateSpec (equalSpec True) <$> toCtx x t
-  ForAll (Lit s) b -> fold <$> mapM (\val -> computeSpec x $ unBind val b) (forAllToList s)
-  ForAll t b -> do
-    bSpec <- computeSpecBinderSimplified b
-    propagateSpec (fromForAllSpec bSpec) <$> toCtx x t
-  Case (Lit val) bs -> runCaseOn val (mapList thing bs) $ \va vaVal psa -> computeSpec x (substPred (Env.singleton va vaVal) psa)
-  Case t branches -> do
-    branchSpecs <- mapMList (traverseWeighted computeSpecBinderSimplified) branches
-    propagateSpec (caseSpec (Just (showType @a)) branchSpecs) <$> toCtx x t
-  When (Lit b) tp -> if b then computeSpecSimplified x tp else pure TrueSpec
-  -- This shouldn't happen a lot of the time because when the body is trivial we mostly get rid of the `When` entirely
-  When {} -> pure $ SuspendedSpec x pred3
-  Reifies (Lit a) (Lit val) f
-    | f val == a -> pure TrueSpec
-    | otherwise ->
-        pure $
-          ErrorSpec (NE.fromList ["Value does not reify to literal: " ++ show val ++ " -/> " ++ show a])
-  Reifies t' (Lit val) f ->
-    propagateSpec (equalSpec (f val)) <$> toCtx x t'
-  Reifies Lit {} _ _ ->
-    fatalErrorNE $ NE.fromList ["Dependency error in computeSpec: Reifies", "  " ++ show pred3]
-  Explain es p -> do
-    -- In case things crash in here we want the explanation
-    s <- pushGE (NE.toList es) (computeSpecSimplified x p)
-    -- This is because while we do want to propagate `explanation`s into `SuspendedSpec`
-    -- we probably don't want to propagate the full "currently simplifying xyz" explanation.
-    case s of
-      SuspendedSpec x2 p2 -> pure $ SuspendedSpec x2 (explanation es p2)
-      _ -> pure $ addToErrorSpec es s
-  -- Impossible cases that should be ruled out by the dependency analysis and linearizer
-  DependsOn {} ->
-    fatalErrorNE $
-      NE.fromList
-        [ "The impossible happened in computeSpec: DependsOn"
-        , "  " ++ show x
-        , show $ indent 2 (pretty pred3)
-        ]
-  Reifies {} ->
-    fatalErrorNE $
-      NE.fromList
-        ["The impossible happened in computeSpec: Reifies", "  " ++ show x, show $ indent 2 (pretty pred3)]
-  where
-    -- We want `genError` to turn into `ErrorSpec` and we want `FatalError` to turn into `FatalError`
-    localGESpec ge = case ge of
-      (GenError xs) -> Result $ ErrorSpec (catMessageList xs)
-      (FatalError es) -> FatalError es
-      (Result v) -> Result v
-
--- | Precondition: the `Pred fn` defines the `Var a`.
---   Runs in `GE` in order for us to have detailed context on failure.
-computeSpec ::
-  forall a. (HasSpec a, HasCallStack) => Var a -> Pred -> GE (Specification a)
-computeSpec x p = computeSpecSimplified x (simplifyPred p)
-
-computeSpecBinderSimplified :: Binder a -> GE (Specification a)
-computeSpecBinderSimplified (x :-> p) = computeSpecSimplified x p
-
--- | Turn a list of branches into a SumSpec. If all the branches fail return an ErrorSpec.
---   Note the requirement of HasSpec(SumOver).
-caseSpec ::
-  forall as.
-  HasSpec (SumOver as) =>
-  Maybe String ->
-  List (Weighted (Specification)) as ->
-  Specification (SumOver as)
-caseSpec tString ss
-  | allBranchesFail ss =
-      ErrorSpec
-        ( NE.fromList
-            [ "When simplifying SumSpec, all branches in a caseOn" ++ sumType tString ++ " simplify to False."
-            , show spec
-            ]
-        )
-  | True = spec
-  where
-    spec = loop tString ss
-
-    allBranchesFail :: forall as2. List (Weighted Specification) as2 -> Bool
-    allBranchesFail Nil = error "The impossible happened in allBranchesFail"
-    allBranchesFail (Weighted _ s :> Nil) = isErrorLike s
-    allBranchesFail (Weighted _ s :> ss2@(_ :> _)) = isErrorLike s && allBranchesFail ss2
-
-    loop ::
-      forall as3.
-      HasSpec (SumOver as3) =>
-      Maybe String ->
-      List (Weighted Specification) as3 ->
-      Specification (SumOver as3)
-    loop _ Nil = error "The impossible happened in caseSpec"
-    loop _ (s :> Nil) = thing s
-    loop mTypeString (s :> ss1@(_ :> _))
-      | Evidence <- prerequisites @(SumOver as3) =
-          (typeSpec $ SumSpecRaw mTypeString theWeights (thing s) (loop Nothing ss1))
-      where
-        theWeights =
-          case (weight s, totalWeight ss1) of
-            (Nothing, Nothing) -> Nothing
-            (a, b) -> Just (fromMaybe 1 a, fromMaybe (lengthList ss1) b)
-
-------------------------------------------------------------------------
--- SumSpec et al
-------------------------------------------------------------------------
-
--- | The Specification for Sums.
-data SumSpec a b
-  = SumSpecRaw
-      (Maybe String) -- A String which is the type of arg in (caseOn arg branch1 .. branchN)
-      (Maybe (Int, Int))
-      (Specification a)
-      (Specification b)
-
--- | The "normal" view of t`SumSpec` that doesn't take weights into account
-pattern SumSpec ::
-  (Maybe (Int, Int)) -> (Specification a) -> (Specification b) -> SumSpec a b
-pattern SumSpec a b c <- SumSpecRaw _ a b c
-  where
-    SumSpec a b c = SumSpecRaw Nothing a b c
-
-{-# COMPLETE SumSpec #-}
-
-sumType :: Maybe String -> String
-sumType Nothing = ""
-sumType (Just x) = " type=" ++ x
-
-totalWeight :: List (Weighted f) as -> Maybe Int
-totalWeight = fmap getSum . foldMapList (fmap Semigroup.Sum . weight)
-
--- =================================
--- Operations on Stages and Plans
-
--- | Does nothing if the variable is not in the plan already.
-mergeSolverStage :: SolverStage -> [SolverStage] -> [SolverStage]
-mergeSolverStage (SolverStage x ps spec) plan =
-  [ case eqVar x y of
-      Just Refl ->
-        SolverStage
-          y
-          (ps ++ ps')
-          ( addToErrorSpec
-              ( NE.fromList
-                  ( [ "Solving var " ++ show x ++ " fails."
-                    , "Merging the Specs"
-                    , "   1. " ++ show spec
-                    , "   2. " ++ show spec'
-                    ]
-                  )
-              )
-              (spec <> spec')
-          )
-      Nothing -> stage
-  | stage@(SolverStage y ps' spec') <- plan
-  ]
-
-isEmptyPlan :: SolverPlan -> Bool
-isEmptyPlan (SolverPlan plan _) = null plan
-
-stepPlan :: MonadGenError m => Env -> SolverPlan -> GenT m (Env, SolverPlan)
-stepPlan env plan@(SolverPlan [] _) = pure (env, plan)
-stepPlan env (SolverPlan (SolverStage x ps spec : pl) gr) = do
-  (spec', specs) <- runGE
-    $ explain
-      ( show
-          ( "Computing specs for variable "
-              <> pretty x
-                /> vsep' (map pretty ps)
-          )
-      )
-    $ do
-      ispecs <- mapM (computeSpec x) ps
-      pure $ (fold ispecs, ispecs)
-  val <-
-    genFromSpecT
-      ( addToErrorSpec
-          ( NE.fromList
-              ( ( "\nStepPlan for variable: "
-                    ++ show x
-                    ++ " fails to produce Specification, probably overconstrained."
-                    ++ "PS = "
-                    ++ unlines (map show ps)
-                )
-                  : ("Original spec " ++ show spec)
-                  : "Predicates"
-                  : zipWith
-                    (\pred specx -> "  pred " ++ show pred ++ " -> " ++ show specx)
-                    ps
-                    specs
-              )
-          )
-          (spec <> spec')
-      )
-  let env1 = Env.extend x val env
-  pure (env1, backPropagation $ SolverPlan (substStage env1 <$> pl) (deleteNode (Name x) gr))
-
--- | Generate a satisfying `Env` for a `p : Pred fn`. The `Env` contains values for
--- all the free variables in `flattenPred p`.
-genFromPreds :: forall m. MonadGenError m => Env -> Pred -> GenT m Env
--- TODO: remove this once optimisePred does a proper fixpoint computation
-genFromPreds env0 (optimisePred . optimisePred -> preds) =
-  {- explain1 (show $ "genFromPreds fails\nPreds are:" /> pretty preds) -} do
-    -- NOTE: this is just lazy enough that the work of flattening,
-    -- computing dependencies, and linearizing is memoized in
-    -- properties that use `genFromPreds`.
-    plan <- runGE $ prepareLinearization preds
-    go env0 plan
-  where
-    go :: Env -> SolverPlan -> GenT m Env
-    go env plan | isEmptyPlan plan = pure env
-    go env plan = do
-      (env', plan') <-
-        explain (show $ "Stepping the plan:" /> vsep [pretty plan, pretty env]) $ stepPlan env plan
-      go env' plan'
-
--- | Push as much information we can backwards through the plan.
-backPropagation :: SolverPlan -> SolverPlan
--- backPropagation (SolverPlan _plan _graph) =
-backPropagation (SolverPlan initplan graph) = SolverPlan (go [] (reverse initplan)) graph
-  where
-    go :: [SolverStage] -> [SolverStage] -> [SolverStage]
-    go acc [] = acc
-    go acc (s@(SolverStage (x :: Var a) ps spec) : plan) = go (s : acc) plan'
-      where
-        newStages = concatMap (newStage spec) ps
-        plan' = foldr mergeSolverStage plan newStages
-        -- Note use of the Term Pattern Equal
-        newStage specl (Assert (Equal (V x') t)) =
-          termVarEqCases specl x' t
-        newStage specr (Assert (Equal t (V x'))) =
-          termVarEqCases specr x' t
-        newStage _ _ = []
-
-        termVarEqCases :: HasSpec b => Specification a -> Var b -> Term b -> [SolverStage]
-        termVarEqCases (MemberSpec vs) x' t
-          | Set.singleton (Name x) == freeVarSet t =
-              [SolverStage x' [] $ MemberSpec (NE.nub (fmap (\v -> errorGE $ runTerm (Env.singleton x v) t) vs))]
-        termVarEqCases specx x' t
-          | Just Refl <- eqVar x x'
-          , [Name y] <- Set.toList $ freeVarSet t
-          , Result ctx <- toCtx y t =
-              [SolverStage y [] (propagateSpec specx ctx)]
-        termVarEqCases _ _ _ = []
-
--- | Function symbols for `(==.)`
-data EqW :: [Type] -> Type -> Type where
-  EqualW :: (Eq a, HasSpec a) => EqW '[a, a] Bool
-
-deriving instance Eq (EqW dom rng)
-
-instance Show (EqW d r) where
-  show EqualW = "==."
-
-instance Syntax EqW where
-  isInfix EqualW = True
-
-instance Semantics EqW where
-  semantics EqualW = (==)
-
-instance Logic EqW where
-  propagate f ctxt (ExplainSpec es s) = explainSpec es $ propagate f ctxt s
-  propagate _ _ TrueSpec = TrueSpec
-  propagate _ _ (ErrorSpec msgs) = ErrorSpec msgs
-  propagate EqualW (HOLE :? Value x :> Nil) (SuspendedSpec v ps) =
-    constrained $ \v' -> Let (App EqualW (v' :> Lit x :> Nil)) (v :-> ps)
-  propagate EqualW (Value x :! Unary HOLE) (SuspendedSpec v ps) =
-    constrained $ \v' -> Let (App EqualW (Lit x :> v' :> Nil)) (v :-> ps)
-  propagate EqualW (HOLE :? Value s :> Nil) spec =
-    caseBoolSpec spec $ \case
-      True -> equalSpec s
-      False -> notEqualSpec s
-  propagate EqualW (Value s :! Unary HOLE) spec =
-    caseBoolSpec spec $ \case
-      True -> equalSpec s
-      False -> notEqualSpec s
-
-  rewriteRules EqualW (t :> t' :> Nil) Evidence
-    | t == t' = Just $ lit True
-    | otherwise = Nothing
-
-  saturate EqualW (FromGeneric (InjLeft _) :> t :> Nil) = [toPreds t (SumSpec Nothing TrueSpec (ErrorSpec (pure "saturatePred")))]
-  saturate EqualW (FromGeneric (InjRight _) :> t :> Nil) = [toPreds t (SumSpec Nothing (ErrorSpec (pure "saturatePred")) TrueSpec)]
-  saturate _ _ = []
-
-infix 4 ==.
-
--- | Equality on the constraint-level
-(==.) :: HasSpec a => Term a -> Term a -> Term Bool
-(==.) = appTerm EqualW
-
--- | Pattern version of `(==.)` for rewrite rules
-pattern Equal ::
-  forall b.
-  () =>
-  forall a.
-  (b ~ Bool, Eq a, HasSpec a) =>
-  Term a ->
-  Term a ->
-  Term b
-pattern Equal x y <-
-  ( App
-      (getWitness -> Just EqualW)
-      (x :> y :> Nil)
-    )
-
--- | Like @if b then p else assert True@ in constraint-land
-whenTrue :: forall p. IsPred p => Term Bool -> p -> Pred
-whenTrue (Lit True) (toPred -> p) = p
-whenTrue (Lit False) _ = TruePred
-whenTrue b (toPred -> FalsePred {}) = assert (not_ b)
-whenTrue _ (toPred -> TruePred) = TruePred
-whenTrue b (toPred -> p) = When b p
-
--- | Is the variable x pinned to some free term in p? (free term
--- meaning that all the variables in the term are free in p).
---
--- TODO: complete this with more cases!
-pinnedBy :: forall a. HasSpec a => Var a -> Pred -> Maybe (Term a)
-pinnedBy x (Assert (Equal t t'))
-  | V x' <- t, Just Refl <- eqVar x x' = Just t'
-  | V x' <- t', Just Refl <- eqVar x x' = Just t
-pinnedBy x (And ps) = listToMaybe $ catMaybes $ map (pinnedBy x) ps
-pinnedBy _ _ = Nothing
-
--- ==================================================================================================
--- TODO: generalize this to make it more flexible and extensible
---
--- The idea here is that we turn constraints into _extra_ constraints. C.f. the
--- `mapIsJust` example in `Constrained.Examples.Map`:
-
---    mapIsJust :: Specification BaseFn (Int, Int)
---    mapIsJust = constrained' $ \ [var| x |] [var| y |] ->
---      assert $ just_ x ==. lookup_ y (lit $ Map.fromList [(z, z) | z <- [100 .. 102]])
-
--- Without this code the example wouldn't work because `y` is completely unconstrained during
--- generation. With this code we essentially rewrite occurences of `just_ A == B` to
--- `[cJust A == B, case B of Nothing -> False; Just _ -> True]` to add extra information
--- about the variables in `B`. Consequently, `y` in the example above is
--- constrained to `MemberSpec [100 .. 102]` in the plan.
-saturatePred :: Pred -> [Pred]
-saturatePred p =
-  -- [p]
-  --  + ---- if there is an Explain, it is still on 'p' here
-  --  |
-  --  v
-  p : case p of
-    Explain _es x -> saturatePred x -- Note that the Explain is still on the original 'p', so it is not lost
-    -- Note how the saturation is done by the 'saturate' method of the Logic class
-    Assert (App sym xs) -> saturate sym xs
-    _ -> []
-
--- ==================================================================
--- HasSpec for Sums
--- ==================================================================
-
-guardSumSpec ::
-  forall a b.
-  (HasSpec a, HasSpec b, KnownNat (CountCases b)) =>
-  [String] ->
-  SumSpec a b ->
-  Specification (Sum a b)
-guardSumSpec msgs s@(SumSpecRaw tString _ sa sb)
-  | isErrorLike sa
-  , isErrorLike sb =
-      ErrorSpec $
-        NE.fromList $
-          msgs ++ ["All branches in a caseOn" ++ sumType tString ++ " simplify to False.", show s]
-  | otherwise = typeSpec s
-
-instance (KnownNat (CountCases b), HasSpec a, HasSpec b) => Show (SumSpec a b) where
-  show sumspec@(SumSpecRaw tstring hint l r) = case alternateShow @(Sum a b) sumspec of
-    (BinaryShow _ ps) -> show $ parens (fromString ("SumSpec" ++ sumType tstring) /> vsep ps)
-    NonBinary ->
-      "(SumSpec"
-        ++ sumType tstring
-        ++ show (sumWeightL hint)
-        ++ " ("
-        ++ show l
-        ++ ") "
-        ++ show (sumWeightR hint)
-        ++ " ("
-        ++ show r
-        ++ "))"
-
-combTypeName :: Maybe String -> Maybe String -> Maybe String
-combTypeName (Just x) (Just y) =
-  if x == y then Just x else Just ("(" ++ x ++ " | " ++ y ++ ")")
-combTypeName (Just x) Nothing = Just x
-combTypeName Nothing (Just x) = Just x
-combTypeName Nothing Nothing = Nothing
-
-instance (HasSpec a, HasSpec b) => Semigroup (SumSpec a b) where
-  SumSpecRaw t h sa sb <> SumSpecRaw t' h' sa' sb' =
-    SumSpecRaw (combTypeName t t') (unionWithMaybe mergeH h h') (sa <> sa') (sb <> sb')
-    where
-      -- TODO: think more carefully about this, now weights like 2 2 and 10 15 give more weight to 10 15
-      -- than would be the case if you had 2 2 and 2 3. But on the other hand this approach is associative
-      -- whereas actually averaging the ratios is not. One could keep a list. Future work.
-      mergeH (fA, fB) (fA', fB') = (fA + fA', fB + fB')
-
-instance forall a b. (HasSpec a, HasSpec b, KnownNat (CountCases b)) => Monoid (SumSpec a b) where
-  mempty = SumSpec Nothing mempty mempty
-
--- | How many constructors are there in this type?
-type family CountCases a where
-  CountCases (Sum a b) = 1 + CountCases b
-  CountCases _ = 1
-
-countCases :: forall a. KnownNat (CountCases a) => Int
-countCases = fromIntegral (natVal @(CountCases a) Proxy)
-
--- | The HasSpec Sum instance
-instance (HasSpec a, HasSpec b, KnownNat (CountCases b)) => HasSpec (Sum a b) where
-  type TypeSpec (Sum a b) = SumSpec a b
-
-  type Prerequisites (Sum a b) = (HasSpec a, HasSpec b)
-
-  emptySpec = mempty
-
-  combineSpec s s' = guardSumSpec ["When combining SumSpecs", "  " ++ show s, "  " ++ show s'] (s <> s')
-
-  conformsTo (SumLeft a) (SumSpec _ sa _) = conformsToSpec a sa
-  conformsTo (SumRight b) (SumSpec _ _ sb) = conformsToSpec b sb
-
-  genFromTypeSpec (SumSpec h sa sb)
-    | emptyA, emptyB = genError "genFromTypeSpec @SumSpec: empty"
-    | emptyA = SumRight <$> genFromSpecT sb
-    | emptyB = SumLeft <$> genFromSpecT sa
-    | fA == 0, fB == 0 = genError "All frequencies 0"
-    | otherwise =
-        frequencyT
-          [ (fA, SumLeft <$> genFromSpecT sa)
-          , (fB, SumRight <$> genFromSpecT sb)
-          ]
-    where
-      (max 0 -> fA, max 0 -> fB) = fromMaybe (1, countCases @b) h
-      emptyA = isErrorLike sa
-      emptyB = isErrorLike sb
-
-  shrinkWithTypeSpec (SumSpec _ sa _) (SumLeft a) = SumLeft <$> shrinkWithSpec sa a
-  shrinkWithTypeSpec (SumSpec _ _ sb) (SumRight b) = SumRight <$> shrinkWithSpec sb b
-
-  toPreds ct (SumSpec h sa sb) =
-    Case
-      ct
-      ( (Weighted (fst <$> h) $ bind $ \a -> satisfies a sa)
-          :> (Weighted (snd <$> h) $ bind $ \b -> satisfies b sb)
-          :> Nil
-      )
-
-  cardinalTypeSpec (SumSpec _ leftspec rightspec) = addSpecInt (cardinality leftspec) (cardinality rightspec)
-
-  typeSpecHasError (SumSpec _ x y) =
-    case (isErrorLike x, isErrorLike y) of
-      (True, True) -> Just $ (errorLikeMessage x <> errorLikeMessage y)
-      _ -> Nothing
-
-  alternateShow (SumSpec h left right@(TypeSpec r [])) =
-    case alternateShow @b r of
-      (BinaryShow "SumSpec" ps) -> BinaryShow "SumSpec" ("|" <+> sumWeightL h <+> viaShow left : ps)
-      (BinaryShow "Cartesian" ps) ->
-        BinaryShow "SumSpec" ("|" <+> sumWeightL h <+> viaShow left : [parens ("Cartesian" /> vsep ps)])
-      _ ->
-        BinaryShow "SumSpec" ["|" <+> sumWeightL h <+> viaShow left, "|" <+> sumWeightR h <+> viaShow right]
-  alternateShow (SumSpec h left right) =
-    BinaryShow "SumSpec" ["|" <+> sumWeightL h <+> viaShow left, "|" <+> sumWeightR h <+> viaShow right]
-
--- ======================================
--- Here are the Logic Instances for Sum
-
--- | Function symbols for `injLeft_` and `injRight_`
-data SumW dom rng where
-  InjLeftW :: SumW '[a] (Sum a b)
-  InjRightW :: SumW '[b] (Sum a b)
-
-instance Show (SumW dom rng) where
-  show InjLeftW = "injLeft_"
-  show InjRightW = "injRight_"
-
-deriving instance (Eq (SumW dom rng))
-
-instance Syntax SumW
-
-instance Semantics SumW where
-  semantics InjLeftW = SumLeft
-  semantics InjRightW = SumRight
-
-instance Logic SumW where
-  propagateTypeSpec InjLeftW (Unary HOLE) (SumSpec _ sl _) cant = sl <> foldMap notEqualSpec [a | SumLeft a <- cant]
-  propagateTypeSpec InjRightW (Unary HOLE) (SumSpec _ _ sr) cant = sr <> foldMap notEqualSpec [a | SumRight a <- cant]
-
-  propagateMemberSpec InjLeftW (Unary HOLE) es =
-    case [a | SumLeft a <- NE.toList es] of
-      (x : xs) -> MemberSpec (x :| xs)
-      [] ->
-        ErrorSpec $
-          pure $
-            "propMemberSpec (sumleft_ HOLE) on (MemberSpec es) with no SumLeft in es: " ++ show (NE.toList es)
-  propagateMemberSpec InjRightW (Unary HOLE) es =
-    case [a | SumRight a <- NE.toList es] of
-      (x : xs) -> MemberSpec (x :| xs)
-      [] ->
-        ErrorSpec $
-          pure $
-            "propagate(InjRight HOLE) on (MemberSpec es) with no SumLeft in es: " ++ show (NE.toList es)
-
-  mapTypeSpec InjLeftW ts = typeSpec $ SumSpec Nothing (typeSpec ts) (ErrorSpec (pure "mapTypeSpec InjLeftW"))
-  mapTypeSpec InjRightW ts = typeSpec $ SumSpec Nothing (ErrorSpec (pure "mapTypeSpec InjRightW")) (typeSpec ts)
-
--- | Constructor for `Sum`
-injLeft_ :: (HasSpec a, HasSpec b, KnownNat (CountCases b)) => Term a -> Term (Sum a b)
-injLeft_ = appTerm InjLeftW
-
--- | Constructor for `Sum`
-injRight_ :: (HasSpec a, HasSpec b, KnownNat (CountCases b)) => Term b -> Term (Sum a b)
-injRight_ = appTerm InjRightW
-
--- | Pattern for building custom rewrite rules
-pattern InjRight ::
-  forall c.
-  () =>
-  forall a b.
-  ( c ~ Sum a b
-  , AppRequires SumW '[b] c
-  ) =>
-  Term b ->
-  Term c
-pattern InjRight x <- (App (getWitness -> Just InjRightW) (x :> Nil))
-
--- | Pattern for building custom rewrite rules
-pattern InjLeft ::
-  forall c.
-  () =>
-  forall a b.
-  ( c ~ Sum a b
-  , AppRequires SumW '[a] c
-  ) =>
-  Term a ->
-  Term c
-pattern InjLeft x <- App (getWitness -> Just InjLeftW) (x :> Nil)
-
-sumWeightL, sumWeightR :: Maybe (Int, Int) -> Doc a
-sumWeightL Nothing = "1"
-sumWeightL (Just (x, _)) = fromString (show x)
-sumWeightR Nothing = "1"
-sumWeightR (Just (_, x)) = fromString (show x)
-
--- | Operations on Bool
-data BoolW (dom :: [Type]) (rng :: Type) where
-  NotW :: BoolW '[Bool] Bool
-  OrW :: BoolW '[Bool, Bool] Bool
-
-deriving instance Eq (BoolW dom rng)
-
-instance Show (BoolW dom rng) where
-  show NotW = "not_"
-  show OrW = "or_"
-
-boolSem :: BoolW dom rng -> FunTy dom rng
-boolSem NotW = not
-boolSem OrW = (||)
-
-instance Semantics BoolW where
-  semantics = boolSem
-
-instance Syntax BoolW
-
--- ======= Logic instance BoolW
-
-instance Logic BoolW where
-  propagate f ctxt (ExplainSpec [] s) = propagate f ctxt s
-  propagate f ctxt (ExplainSpec es s) = ExplainSpec es $ propagate f ctxt s
-  propagate _ _ TrueSpec = TrueSpec
-  propagate _ _ (ErrorSpec msgs) = ErrorSpec msgs
-  propagate NotW (Unary HOLE) (SuspendedSpec v ps) =
-    constrained $ \v' -> Let (App NotW (v' :> Nil)) (v :-> ps)
-  propagate NotW (Unary HOLE) spec =
-    caseBoolSpec spec (equalSpec . not)
-  propagate OrW (HOLE :<: x) (SuspendedSpec v ps) =
-    constrained $ \v' -> Let (App OrW (v' :> Lit x :> Nil)) (v :-> ps)
-  propagate OrW (x :>: HOLE) (SuspendedSpec v ps) =
-    constrained $ \v' -> Let (App OrW (Lit x :> v' :> Nil)) (v :-> ps)
-  propagate OrW (HOLE :<: s) spec =
-    caseBoolSpec spec (okOr s)
-  propagate OrW (s :>: HOLE) spec =
-    caseBoolSpec spec (okOr s)
-
-  mapTypeSpec NotW () = typeSpec ()
-
--- | We have something like ('constant' ||. HOLE) must evaluate to 'need'.
---   Return a (Specification Bool) for HOLE, that makes that True.
-okOr :: Bool -> Bool -> Specification Bool
-okOr constant need = case (constant, need) of
-  (True, True) -> TrueSpec
-  (True, False) ->
-    ErrorSpec
-      (pure ("(" ++ show constant ++ "||. HOLE) must equal False. That cannot be the case."))
-  (False, False) -> MemberSpec (pure False)
-  (False, True) -> MemberSpec (pure True)
-
--- | Disjunction on @`Term` `Bool`@, note that this will not cause backtracking during generation
-or_ :: Term Bool -> Term Bool -> Term Bool
-or_ = appTerm OrW
-
--- | Negation of booleans
-not_ :: Term Bool -> Term Bool
-not_ = appTerm NotW
-
--- ===============================================================================
--- Syntax for Solving : stages and plans
-
-data SolverStage where
-  SolverStage ::
-    HasSpec a =>
-    { stageVar :: Var a
-    , stagePreds :: [Pred]
-    , stageSpec :: Specification a
-    } ->
-    SolverStage
-
-instance Pretty SolverStage where
-  pretty SolverStage {..} =
-    viaShow stageVar
-      <+> "<-"
-        /> vsep'
-          ( [pretty stageSpec | not $ isTrueSpec stageSpec]
-              ++ ["---" | not $ null stagePreds, not $ isTrueSpec stageSpec]
-              ++ map pretty stagePreds
-          )
-
-data SolverPlan = SolverPlan
-  { solverPlan :: [SolverStage]
-  , solverDependencies :: Graph Name
-  }
-
-instance Pretty SolverPlan where
-  pretty SolverPlan {..} =
-    "\nSolverPlan"
-      /> vsep'
-        [ -- "\nDependencies:" /> pretty solverDependencies, -- Might be usefull someday
-          "\nLinearization:" /> prettyLinear solverPlan
-        ]
-
-isTrueSpec :: Specification a -> Bool
-isTrueSpec TrueSpec = True
-isTrueSpec _ = False
-
-prettyLinear :: [SolverStage] -> Doc ann
-prettyLinear = vsep' . map pretty
-
-fromGESpec :: HasCallStack => GE (Specification a) -> Specification a
-fromGESpec ge = case ge of
-  Result s -> s
-  GenError xs -> ErrorSpec (catMessageList xs)
-  FatalError es -> error $ catMessages es
diff --git a/libs/constrained-generators/src/Constrained/Generic.hs b/libs/constrained-generators/src/Constrained/Generic.hs
deleted file mode 100644
index f5dfabe9164..00000000000
--- a/libs/constrained-generators/src/Constrained/Generic.hs
+++ /dev/null
@@ -1,392 +0,0 @@
-{-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DefaultSignatures #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE UndecidableInstances #-}
-
--- | How we automatically inject normal Haskell types into the logic, using
--- `GHC.Generics`
-module Constrained.Generic (
-  -- * Generic representation
-
-  -- `HasSimpleRep` is the reason we have this module. It's going to allow us
-  -- to define `Constrained.Base.HasSpec` instances generically via instances
-  -- for the underlying `Sum` and t`Prod` types.
-  HasSimpleRep (..),
-
-  -- * Underlying representation
-  Prod (..),
-  Sum (..),
-  (:::),
-  SOP,
-  ProdOver,
-  ConstrOf,
-  inject,
-  algebra,
-  SumOver,
-) where
-
-import Constrained.List
-import Data.Functor.Const
-import Data.Functor.Identity
-import Data.Kind
-import Data.Typeable
-import GHC.Generics
-import GHC.TypeLits
-
-------------------------------------------------------------------------
--- Pairs
-------------------------------------------------------------------------
-
--- | Pairs; this is a separate type from `(,)` to avoid confusion between internal
--- representation of generic types and user-facing use of `(,)`
-data Prod a b = Prod {prodFst :: a, prodSnd :: b}
-  deriving (Eq, Ord)
-
-instance (Show a, Show b) => Show (Prod a b) where
-  show (Prod x y) = "(Prod " ++ show x ++ " " ++ show y ++ ")"
-
--- | Turn a type-level list into either, t`()`, a singleton type, or
--- nested uses of t`Prod`
-type family ProdOver (as :: [Type]) where
-  ProdOver '[] = ()
-  ProdOver '[a] = a
-  ProdOver (a : as) = Prod a (ProdOver as)
-
-listToProd :: (ProdOver as -> r) -> List Identity as -> r
-listToProd k Nil = k ()
-listToProd k (Identity a :> Nil) = k a
-listToProd k (Identity a :> b :> as) = k (Prod a (listToProd id (b :> as)))
-
-prodToList :: forall as. TypeList as => ProdOver as -> List Identity as
-prodToList = go (listShape @as)
-  where
-    go ::
-      forall ts.
-      List (Const ()) ts ->
-      ProdOver ts ->
-      List Identity ts
-    go Nil _ = Nil
-    go (_ :> Nil) a = Identity a :> Nil
-    go (_ :> ix :> ixs) (Prod a as) = Identity a :> go (ix :> ixs) as
-
-appendProd ::
-  forall xs ys.
-  (TypeList xs, TypeList ys) =>
-  ProdOver xs ->
-  ProdOver ys ->
-  ProdOver (Append xs ys)
-appendProd xs ys = listToProd id (appendList @Identity @xs @ys (prodToList xs) (prodToList ys))
-
-splitProd ::
-  forall xs ys.
-  (TypeList xs, TypeList ys) =>
-  ProdOver (Append xs ys) ->
-  Prod (ProdOver xs) (ProdOver ys)
-splitProd = go (listShape @xs) (listShape @ys)
-  where
-    go ::
-      List (Const ()) as ->
-      List (Const ()) bs ->
-      ProdOver (Append as bs) ->
-      Prod (ProdOver as) (ProdOver bs)
-    go Nil _ p = Prod () p
-    go (_ :> Nil) Nil p = Prod p ()
-    go (_ :> Nil) (_ :> _) p = p
-    go (_ :> a :> as) bs (Prod x xs) = Prod (Prod x p0) p1
-      where
-        Prod p0 p1 = go (a :> as) bs xs
-
-------------------------------------------------------------------------
--- Sums
-------------------------------------------------------------------------
-
--- | Sum types; different from `Either` for the same reason t`Prod` is different
--- from `(,)`
-data Sum a b
-  = SumLeft a
-  | SumRight b
-  deriving (Ord, Eq, Show)
-
--- | Convert a list of types to a nested `Sum`
-type family SumOver as where
-  SumOver '[a] = a
-  SumOver (a : as) = Sum a (SumOver as)
-
--- | The idea is for each type, we define a type family `HasSimpleRep` the maps
--- that type to another type we already know how to deal with. The methods
--- `toSimpleRep` and `fromSimpleRep` cature that knowledge. The strategy we
--- want to use most of the time, is to use `GHC.Generics`, to construct the
--- `SimpleRep` out of `Sum` and t`Prod`, and to write the `toSimpleRep` and
--- `fromSimpleRep` methods automatically. If we can do that, then every thing
--- else will come for free. Note that it is not REQUIRED to make the
--- @`SimpleRep` t@ out of `Sum` and t`Prod`, but it helps and it is the default.
-class Typeable (SimpleRep a) => HasSimpleRep a where
-  type SimpleRep a
-  type TheSop a :: [Type]
-  toSimpleRep :: a -> SimpleRep a
-  fromSimpleRep :: SimpleRep a -> a
-
-  type TheSop a = SOPOf (Rep a)
-  type SimpleRep a = SOP (TheSop a)
-
-  default toSimpleRep ::
-    ( Generic a
-    , SimpleGeneric (Rep a)
-    , SimpleRep a ~ SimplifyRep (Rep a)
-    ) =>
-    a ->
-    SimpleRep a
-  toSimpleRep = toSimpleRep' . from
-
-  default fromSimpleRep ::
-    ( Generic a
-    , SimpleGeneric (Rep a)
-    , SimpleRep a ~ SimplifyRep (Rep a)
-    ) =>
-    SimpleRep a ->
-    a
-  fromSimpleRep = to . fromSimpleRep'
-
-type family SimplifyRep f where
-  SimplifyRep f = SOP (SOPOf f)
-
-instance HasSimpleRep () where
-  type SimpleRep () = ()
-  toSimpleRep x = x
-  fromSimpleRep x = x
-
--- ===============================================================
--- How to move back and forth from (SimpleRep a) to 'a' in a
--- generic way, derived by the Generics machinery is captured
--- by the SimpleGeneric class
--- ===============================================================
-
-class SimpleGeneric rep where
-  toSimpleRep' :: rep p -> SimplifyRep rep
-  fromSimpleRep' :: SimplifyRep rep -> rep p
-
-instance SimpleGeneric f => SimpleGeneric (D1 d f) where
-  toSimpleRep' (M1 f) = toSimpleRep' f
-  fromSimpleRep' a = M1 (fromSimpleRep' a)
-
-instance
-  ( SimpleGeneric f
-  , SimpleGeneric g
-  , SopList (SOPOf f) (SOPOf g)
-  ) =>
-  SimpleGeneric (f :+: g)
-  where
-  toSimpleRep' (L1 f) = injectSOPLeft @(SOPOf f) @(SOPOf g) $ toSimpleRep' f
-  toSimpleRep' (R1 g) = injectSOPRight @(SOPOf f) @(SOPOf g) $ toSimpleRep' g
-  fromSimpleRep' sop =
-    case caseSOP @(SOPOf f) @(SOPOf g) sop of
-      SumLeft l -> L1 (fromSimpleRep' l)
-      SumRight r -> R1 (fromSimpleRep' r)
-
-instance SimpleConstructor f => SimpleGeneric (C1 ('MetaCons c a b) f) where
-  toSimpleRep' (M1 f) = toSimpleCon' f
-  fromSimpleRep' a = M1 (fromSimpleCon' a)
-
--- ================================================================================
---    This part of the code base is responsible for implementing the conversion
---    from a `Generic` type to a `Sum` over `Prod` representation that automatically
---    gives you an instance of `HasSpec`. The user has three options for building their
---    own instances of `HasSpec`, either they hand-roll an instance, they go with the
---    entirely `Generic` instance, or they provide their own `SimpleRep` for their type.
---
---    The latter may be appropriate when the type is an optimized representation:
---
---    ```
---    newtype Foo = Foo { unFoo :: MemoBytes ActualFoo }
---
---    instance HasSimpleRep Foo where
---      type SimpleRep Foo = ActualFoo
---      toSimpleRep = unMemoBytes . unFoo
---      fromSimpleRep = Foo . memoBytes
---    ```
---
---    This would then allow for `Foo` to be treated as a simple `newtype` over `ActualFoo`
---    in constraints:
---
---    ```
---    fooSpec :: Specification Foo
---    fooSpec = constrained $ \ foo ->
---      match foo $ \ actualFoo -> ...
---    ```
--- =========================================================================================
-
--- Building a SOP type (Sum Of Prod) --------------------------------------
-
--- | A constructor name with the types of its arguments
-data (c :: Symbol) ::: (ts :: [Type])
-
--- | Turn a `Rep` into a list that flattens the sum
--- structre and gives the constructors names:
--- > Maybe Int -> '["Nothing" ::: '[()], "Just" ::: '[Int]]
--- > Either Int Bool -> '["Left" ::: '[Int], "Right" ::: '[Bool]]
--- > data Foo = Foo Int Bool | Bar Double -> '["Foo" ::: '[Int, Bool], "Bar" ::: '[Double]]
-type family SOPOf f where
-  SOPOf (D1 _ f) = SOPOf f
-  SOPOf (f :+: g) = Append (SOPOf f) (SOPOf g)
-  SOPOf (C1 ('MetaCons constr _ _) f) = '[constr ::: Constr f]
-
--- | Flatten a single constructor
-type family Constr f where
-  -- TODO: Here we should put in the selector names
-  -- so that they can be re-used to create selectors more
-  -- easily than the current disgusting `Fst . Snd . Snd . Snd ...`
-  -- method.
-  Constr (S1 _ f) = Constr f
-  Constr (K1 _ k) = '[k]
-  Constr U1 = '[()]
-  Constr (f :*: g) = Append (Constr f) (Constr g)
-
--- | Turn a list from `SOPOf` into a `Sum` over
--- t`Prod` representation.
-type family SOP constrs where
-  SOP '[c ::: prod] = ProdOver prod
-  SOP ((c ::: prod) : constrs) = Sum (ProdOver prod) (SOP constrs)
-
--- Constructing an SOP ----------------------------------------------------
-
--- | Get the type of a specific constructor in an `SOP`
-type family ConstrOf c sop where
-  ConstrOf c (c ::: constr : sop) = constr
-  ConstrOf c (_ : sop) = ConstrOf c sop
-
-class Inject c constrs r where
-  inject' :: (SOP constrs -> r) -> FunTy (ConstrOf c constrs) r
-
-instance TypeList prod => Inject c '[c ::: prod] r where
-  inject' k = curryList_ @prod Identity (listToProd k)
-
-instance TypeList prod => Inject c ((c ::: prod) : prod' : constrs) r where
-  inject' k = curryList_ @prod Identity (listToProd (k . SumLeft @_ @(SOP (prod' : constrs))))
-
-instance
-  {-# OVERLAPPABLE #-}
-  ( FunTy (ConstrOf c ((c' ::: prod) : con : constrs)) r ~ FunTy (ConstrOf c (con : constrs)) r
-  , -- \^ An unfortunately roundabout way of saying `c !~ c'`
-    Inject c (con : constrs) r
-  ) =>
-  Inject c ((c' ::: prod) : con : constrs) r
-  where
-  inject' k = inject' @c @(con : constrs) (k . SumRight)
-
--- | Inject a single constructor into an SOP
-inject ::
-  forall c constrs. Inject c constrs (SOP constrs) => FunTy (ConstrOf c constrs) (SOP constrs)
-inject = inject' @c @constrs id
-
--- Deconstructing an SOP --------------------------------------------------
-
--- | An `ALG constrs r` is a function that takes a way to turn every
--- constructor into an @r@:
--- ```
--- ALG (SOPOf (Rep (Either Int Bool))) r = (Int -> r) -> (Bool -> r) -> r
--- ```
-type family ALG constrs r where
-  ALG '[c ::: prod] r = FunTy prod r -> r
-  ALG ((c ::: prod) : constrs) r = FunTy prod r -> ALG constrs r
-
-class SOPLike constrs r where
-  -- | Run a `SOP`
-  algebra :: SOP constrs -> ALG constrs r
-
-  -- | Ignore everything in the `SOP`
-  consts :: r -> ALG constrs r
-
-instance TypeList prod => SOPLike '[c ::: prod] r where
-  algebra prod f = uncurryList_ @_ @prod runIdentity f $ prodToList prod
-  consts r _ = r
-
-instance (TypeList prod, SOPLike (con : cases) r) => SOPLike ((c ::: prod) : con : cases) r where
-  algebra (SumLeft prod) f = consts @(con : cases) @r (algebra @'[c ::: prod] prod f)
-  algebra (SumRight rest) _ = algebra @(con : cases) @r rest
-
-  consts r _ = consts @(con : cases) r
-
--- ========================================================
--- The individual constructor level -----------------------
-
-class SimpleConstructor rep where
-  toSimpleCon' :: rep p -> ProdOver (Constr rep)
-  fromSimpleCon' :: ProdOver (Constr rep) -> rep p
-
-instance
-  ( SimpleConstructor f
-  , SimpleConstructor g
-  , TypeList (Constr f)
-  , TypeList (Constr g)
-  ) =>
-  SimpleConstructor (f :*: g)
-  where
-  toSimpleCon' (a :*: b) = appendProd @(Constr f) @(Constr g) (toSimpleCon' a) (toSimpleCon' b)
-  fromSimpleCon' constr =
-    let Prod a b = splitProd @(Constr f) @(Constr g) constr
-     in (fromSimpleCon' a :*: fromSimpleCon' b)
-
-instance SimpleConstructor f => SimpleConstructor (S1 s f) where
-  toSimpleCon' (M1 f) = toSimpleCon' f
-  fromSimpleCon' a = M1 (fromSimpleCon' a)
-
-instance SimpleConstructor (K1 i k) where
-  toSimpleCon' (K1 k) = k
-  fromSimpleCon' k = K1 k
-
-instance SimpleConstructor U1 where
-  toSimpleCon' U1 = ()
-  fromSimpleCon' _ = U1
-
--- ===================================================
--- The sum type level --------------------------------
-
--- | Construct and deconstruct cases in a `SOP`
-class SopList xs ys where
-  injectSOPLeft :: SOP xs -> SOP (Append xs ys)
-  injectSOPRight :: SOP ys -> SOP (Append xs ys)
-  caseSOP :: SOP (Append xs ys) -> Sum (SOP xs) (SOP ys)
-
-instance SopList '[c ::: x] (y : ys) where
-  injectSOPLeft = SumLeft
-  injectSOPRight = SumRight
-  caseSOP = id
-
-instance SopList (x' : xs) (y : ys) => SopList (c ::: x : x' : xs) (y : ys) where
-  injectSOPLeft (SumLeft a) = SumLeft a
-  injectSOPLeft (SumRight b) = SumRight (injectSOPLeft @(x' : xs) @(y : ys) b)
-
-  injectSOPRight a = SumRight (injectSOPRight @(x' : xs) @(y : ys) a)
-
-  caseSOP (SumLeft a) = SumLeft (SumLeft a)
-  caseSOP (SumRight b) = case caseSOP @(x' : xs) @(y : ys) b of
-    SumLeft b' -> SumLeft (SumRight b')
-    SumRight b' -> SumRight b'
-
--- ===========================================================
--- How it works
--- If the TypeSpec method of the HasSpec class has a SimpleRep instance, Like this
--- type TypeSpec = a
--- where 'a' has a Sum Product representation then all of the other methods
--- can use the default implementation. This saves lots of trouble for mundane types.
---
--- `HasSimpleRep` and `GenericsFn` are meant to allow you to express that a
--- type is isomorphic to some other type 't' that has a (HasSpec t) instance.
---
--- The trick is that the default instance of `HasSpec a` assumes
--- `HasSimpleRep a` and defines `TypeSpec a = TypeSpec (SimpleRep a)`.
---
--- From this it's possible to work with things of type `a` in constraints by
--- treating them like things of type `SimpleRep a`. This allows us to do case
--- matching etc. on `a` when `SimpleRep a` is a `Sum` type, for example.
---
--- Or alternatively it allows us to treat `a` as a newtype over `SimpleRep a`
--- when using `match`.
--- ====================================================================
diff --git a/libs/constrained-generators/src/Constrained/Graph.hs b/libs/constrained-generators/src/Constrained/Graph.hs
deleted file mode 100644
index 402ff9381ad..00000000000
--- a/libs/constrained-generators/src/Constrained/Graph.hs
+++ /dev/null
@@ -1,155 +0,0 @@
-{-# LANGUAGE ImportQualifiedPost #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TupleSections #-}
-
--- | This module provides a dependency graph implementation.
-module Constrained.Graph (
-  Graph,
-  opGraph,
-  nodes,
-  deleteNode,
-  subtractGraph,
-  dependency,
-  findCycle,
-  dependsOn,
-  dependencies,
-  noDependencies,
-  topsort,
-  transitiveClosure,
-  transitiveDependencies,
-  irreflexiveDependencyOn,
-) where
-
-import Control.Monad
-import Data.Foldable
-import Data.List (sortOn)
-import Data.Map (Map)
-import Data.Map qualified as Map
-import Data.Maybe
-import Data.Set (Set)
-import Data.Set qualified as Set
-import Prettyprinter
-
--- | A graph with unlabeled edges for keeping track of dependencies
-data Graph node = Graph
-  { edges :: !(Map node (Set node))
-  , opEdges :: !(Map node (Set node))
-  }
-  deriving (Show)
-
-instance Ord node => Semigroup (Graph node) where
-  Graph e o <> Graph e' o' =
-    Graph
-      (Map.unionWith (<>) e e')
-      (Map.unionWith (<>) o o')
-
-instance Ord node => Monoid (Graph node) where
-  mempty = Graph mempty mempty
-
-instance Pretty n => Pretty (Graph n) where
-  pretty gr =
-    fold $
-      punctuate
-        hardline
-        [ nest 4 $ pretty n <> " <- " <> brackets (fillSep (map pretty (Set.toList ns)))
-        | (n, ns) <- Map.toList (edges gr)
-        ]
-
--- | Get all the nodes of a graph
-nodes :: Graph node -> Set node
-nodes (Graph e _) = Map.keysSet e
-
--- | Delete a node from a graph
-deleteNode :: Ord node => node -> Graph node -> Graph node
-deleteNode x (Graph e o) = Graph (clean e) (clean o)
-  where
-    clean = Map.delete x . fmap (Set.delete x)
-
--- | Invert the graph
-opGraph :: Graph node -> Graph node
-opGraph (Graph e o) = Graph o e
-
--- | @subtractGraph g g'@ is the graph @g@ without the dependencies in @g'@
-subtractGraph :: Ord node => Graph node -> Graph node -> Graph node
-subtractGraph (Graph e o) (Graph e' o') =
-  Graph
-    (Map.differenceWith del e e')
-    (Map.differenceWith del o o')
-  where
-    del x y = Just $ Set.difference x y
-
--- | @dependency x xs@ is the graph where @x@ depends on every node in @xs@
--- and there are no other dependencies.
-dependency :: Ord node => node -> Set node -> Graph node
-dependency x xs =
-  Graph
-    (Map.singleton x xs)
-    ( Map.unionWith
-        (<>)
-        (Map.singleton x mempty)
-        (Map.fromList [(y, Set.singleton x) | y <- Set.toList xs])
-    )
-
--- | Every node in the first set depends on every node in the second set except themselves
-irreflexiveDependencyOn :: Ord node => Set node -> Set node -> Graph node
-irreflexiveDependencyOn xs ys =
-  deps <> noDependencies ys
-  where
-    deps =
-      Graph
-        (Map.fromDistinctAscList [(x, Set.delete x ys) | x <- Set.toList xs])
-        (Map.fromDistinctAscList [(a, Set.delete a xs) | a <- Set.toList ys])
-
--- | Get all down-stream dependencies of a node
-transitiveDependencies :: Ord node => node -> Graph node -> Set node
-transitiveDependencies x (Graph e _) = go (Set.singleton x) x
-  where
-    go seen y = ys <> foldMap (go $ Set.insert y seen) (Set.difference ys seen)
-      where
-        ys = fromMaybe mempty (Map.lookup y e)
-
--- | Take the transitive closure of the graph
-transitiveClosure :: Ord node => Graph node -> Graph node
-transitiveClosure g = foldMap (\x -> dependency x (transitiveDependencies x g)) (nodes g)
-
--- | The discrete graph containing all the input nodes without any dependencies
-noDependencies :: Ord node => Set node -> Graph node
-noDependencies ns = Graph nodeMap nodeMap
-  where
-    nodeMap = Map.fromList ((,mempty) <$> Set.toList ns)
-
--- | Topsort the graph, returning either @Right order@ if the graph is a DAG or
--- @Left cycle@  if it is not
-topsort :: Ord node => Graph node -> Either [node] [node]
-topsort gr@(Graph e _) = go [] e
-  where
-    go order g
-      | null g = pure $ reverse order
-      | otherwise = do
-          let noDeps = Map.keysSet . Map.filter null $ g
-              removeNode n ds = Set.difference ds noDeps <$ guard (not $ n `Set.member` noDeps)
-          if not $ null noDeps
-            then go (Set.toList noDeps ++ order) (Map.mapMaybeWithKey removeNode g)
-            else Left . concat . take 1 . sortOn length . filter (not . null) . map (findCycle gr) $ Map.keys e
-
--- | Simple DFS cycle finding
--- TODO: tests for this, currently it can produce a stem with a cycle after it
-findCycle :: Ord node => Graph node -> node -> [node]
-findCycle (Graph e _) node = concat . take 1 $ go mempty node
-  where
-    go seen n
-      | n `Set.member` seen = [[]]
-      | otherwise = do
-          n' <- neighbours
-          (n :) <$> go (Set.insert n seen) n'
-      where
-        neighbours = maybe [] Set.toList $ Map.lookup n e
-
--- | Get the dependencies of a node in the graph, `mempty` if the node is not
--- in the graph
-dependencies :: Ord node => node -> Graph node -> Set node
-dependencies x (Graph e _) = fromMaybe mempty (Map.lookup x e)
-
--- | Check if a node depends on another in the graph
-dependsOn :: Ord node => node -> node -> Graph node -> Bool
-dependsOn x y g = y `Set.member` dependencies x g
diff --git a/libs/constrained-generators/src/Constrained/List.hs b/libs/constrained-generators/src/Constrained/List.hs
deleted file mode 100644
index 871a55013fd..00000000000
--- a/libs/constrained-generators/src/Constrained/List.hs
+++ /dev/null
@@ -1,250 +0,0 @@
-{-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE PatternSynonyms #-}
-{-# LANGUAGE PolyKinds #-}
-{-# LANGUAGE QuantifiedConstraints #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE ViewPatterns #-}
-
--- | A module for working with type-indexed heterogenous lists, sometimes
--- called inductive tuples.
-module Constrained.List (
-  -- * Lists
-  List (..),
-
-  -- ** Type families
-  Length,
-  (:!),
-  All,
-  MapList,
-  Append,
-  FunTy,
-
-  -- ** Common functions for working with `List`
-  TypeList (..),
-  toList,
-  toListC,
-  mapList,
-  mapListC,
-  mapMList,
-  mapMListC,
-  foldMapList,
-  foldMapListC,
-  appendList,
-  lengthList,
-  uncurryList,
-  uncurryList_,
-
-  -- * List contexts
-  ListCtx (..),
-  pattern NilCtx,
-  pattern ListCtx,
-  fillListCtx,
-  mapListCtx,
-  mapListCtxC,
-) where
-
-import Data.Foldable (fold)
-import Data.Functor.Const
-import Data.Kind
-import Data.Semigroup (Sum (..))
-import GHC.TypeLits
-
--- | A heterogeneous list / an inductive tuple. We use this heavily to
--- represent arguments to functions in terms
-data List (f :: k -> Type) (as :: [k]) where
-  Nil :: List f '[]
-  (:>) :: f a -> List f as -> List f (a : as)
-
-infixr 5 :>
-
-deriving instance (forall a. Show (f a)) => Show (List f as)
-
-deriving instance (forall a. Eq (f a)) => Eq (List f as)
-
--- | Type level `length`
-type family Length (as :: [k]) :: Nat where
-  Length '[] = 0
-  Length (_ : as) = 1 + Length as
-
--- | Get the @n@:th element of the type-level list @as@
-type family (as :: [k]) :! n :: k where
-  '[] :! n = TypeError ('Text "Indexing into empty type-level list")
-  (a : as) :! 0 = a
-  (a : as) :! n = as :! (n - 1)
-
--- | Convert a @`List` f@ to a normal list with an algebra for @f@
-toList :: (forall a. f a -> b) -> List f as -> [b]
-toList _ Nil = []
-toList f (x :> xs) = f x : toList f xs
-
--- | Like `toList` when you need a constraint on the elements of the index of the `List`
-toListC :: forall c f as b. All c as => (forall a. c a => f a -> b) -> List f as -> [b]
-toListC _ Nil = []
-toListC f (x :> xs) = f x : toListC @c f xs
-
--- | Map a natural transformation from @f@ to @g@ over a `List`
-mapList :: (forall a. f a -> g a) -> List f as -> List g as
-mapList _ Nil = Nil
-mapList f (x :> xs) = f x :> mapList f xs
-
--- | Like `mapList` where the natural transformation is constrained
-mapListC :: forall c as f g. All c as => (forall a. c a => f a -> g a) -> List f as -> List g as
-mapListC _ Nil = Nil
-mapListC f (x :> xs) = f x :> mapListC @c f xs
-
--- | Monadic (actually applicative) `mapList`
-mapMList :: Applicative m => (forall a. f a -> m (g a)) -> List f as -> m (List g as)
-mapMList _ Nil = pure Nil
-mapMList f (x :> xs) = (:>) <$> f x <*> mapMList f xs
-
--- | Monadic (actually applicative) `mapListC`
-mapMListC ::
-  forall c as f g m.
-  (Applicative m, All c as) =>
-  (forall a. c a => f a -> m (g a)) ->
-  List f as ->
-  m (List g as)
-mapMListC _ Nil = pure Nil
-mapMListC f (x :> xs) = (:>) <$> f x <*> mapMListC @c f xs
-
--- | Like `foldMap` for t`List`
-foldMapList :: Monoid b => (forall a. f a -> b) -> List f as -> b
-foldMapList f = fold . toList f
-
--- | Like `foldMapList` where the mapped function has a constraint
-foldMapListC ::
-  forall c as b f. (All c as, Monoid b) => (forall a. c a => f a -> b) -> List f as -> b
-foldMapListC f = fold . toListC @c f
-
--- | Append two t`List`s
-appendList :: List f as -> List f bs -> List f (Append as bs)
-appendList Nil bs = bs
-appendList (a :> as) bs = a :> appendList as bs
-
--- | Like `length` for `List`
-lengthList :: List f as -> Int
-lengthList = getSum . foldMapList (const $ Sum 1)
-
--- | Append two type-level lists
-type family Append as as' where
-  Append '[] as' = as'
-  Append (a : as) as' = a : Append as as'
-
--- | Map a type functor over a list
-type family MapList (f :: k -> j) as where
-  MapList f '[] = '[]
-  MapList f (a : as) = f a : MapList f as
-
--- | A function type from @ts@ to @res@:
---  @FunTy '[Int, Bool] Double = Int -> Bool -> Double@
-type family FunTy ts res where
-  FunTy '[] a = a
-  FunTy (a : as) r = a -> FunTy as r
-
--- | Apply a function that takes @`MapList` f ts@ to a @`List` f ts@
-uncurryList :: FunTy (MapList f ts) r -> List f ts -> r
-uncurryList r Nil = r
-uncurryList f (a :> as) = uncurryList (f a) as
-
--- | Like `uncurryList` but first apply an algebra to get rid of the @f@ type
--- wrapper
-uncurryList_ :: (forall a. f a -> a) -> FunTy ts r -> List f ts -> r
-uncurryList_ _ a Nil = a
-uncurryList_ k f (a :> as) = uncurryList_ k (f $ k a) as
-
--- | Higher-order functions for working on `List`s
-class TypeList ts where
-  curryList :: (List f ts -> r) -> FunTy (MapList f ts) r
-  curryList_ :: (forall a. a -> f a) -> (List f ts -> r) -> FunTy ts r
-
-  -- | Materialize the shape of the type list @as@, this is very useful
-  -- for avoiding having to write type classes that recurse over @as@.
-  listShape :: List (Const ()) ts
-
--- | NOTE: the two instances for `TypeList` are @`TypeList` []@ and
--- @`TypeList` (a : as)@. That way its basically just a structurally
--- recursive function on type-level lists that computes the `TypeList`
--- dictionary (mostly) statically.
-instance TypeList '[] where
-  curryList f = f Nil
-  curryList_ _ f = f Nil
-  listShape = Nil
-
-instance TypeList as => TypeList (a : as) where
-  curryList f a = curryList (\xs -> f (a :> xs))
-  curryList_ p f a = curryList_ p (\xs -> f (p a :> xs))
-  listShape = Const () :> listShape
-
--- | Every element @a@ of @as@ obeys constraint @c a@
-type family All (c :: k -> Constraint) (as :: [k]) :: Constraint where
-  All c '[] = ()
-  All c (a : as) = (c a, All c as)
-
--- | A List with a hole in it, can be seen as a zipper
--- over type-level lists.
---
--- We use this to represent arguments to functions in
--- evaluation contexts (terms with a single hole).
-data ListCtx f (as :: [Type]) c where
-  (:?) :: c a -> List f as -> ListCtx f (a : as) c
-  (:!) :: f a -> ListCtx f as c -> ListCtx f (a : as) c
-
-infixr 5 :?, :!
-
--- | A Convenient pattern for singleton contexts
-pattern NilCtx :: c a -> ListCtx f '[a] c
-pattern NilCtx c = ListCtx Nil c Nil
-
-{-# COMPLETE NilCtx #-}
-
--- | A view of a t`ListCtx` where you see the whole context at the same time.
-pattern ListCtx ::
-  () => as'' ~ Append as (a : as') => List f as -> c a -> List f as' -> ListCtx f as'' c
-pattern ListCtx as c as' <- (toWholeCtx -> ListCtxWhole as c as')
-  where
-    ListCtx as c as' = fromWholeCtx $ ListCtxWhole as c as'
-
-{-# COMPLETE ListCtx #-}
-
--- | Internals for the t`ListCtx` pattern
-data ListCtxWhole f as c where
-  ListCtxWhole ::
-    List f as ->
-    c a ->
-    List f as' ->
-    ListCtxWhole f (Append as (a : as')) c
-
-toWholeCtx :: ListCtx f as c -> ListCtxWhole f as c
-toWholeCtx (hole :? suf) = ListCtxWhole Nil hole suf
-toWholeCtx (x :! xs)
-  | ListCtxWhole pre hole suf <- toWholeCtx xs =
-      ListCtxWhole (x :> pre) hole suf
-
-fromWholeCtx :: ListCtxWhole f as c -> ListCtx f as c
-fromWholeCtx (ListCtxWhole Nil hole suf) = hole :? suf
-fromWholeCtx (ListCtxWhole (x :> pre) hole suf) = x :! fromWholeCtx (ListCtxWhole pre hole suf)
-
--- | Instantiate the hole in a t`ListCtx` to obtain a t`List`
-fillListCtx :: ListCtx f as c -> (forall a. c a -> f a) -> List f as
-fillListCtx (ListCtx pre c post) f = appendList pre (f c :> post)
-
--- | Transform a @t`ListCtx` f c@ to a @t`ListCtx` g` c@ via a natural transformation
-mapListCtx :: (forall a. f a -> g a) -> ListCtx f as c -> ListCtx g as c
-mapListCtx nt (ListCtx pre c post) = ListCtx (mapList nt pre) c (mapList nt post)
-
--- | Like `mapListCtx` but the natural transformation may have a constraint
-mapListCtxC ::
-  forall c as f g h. All c as => (forall a. c a => f a -> g a) -> ListCtx f as h -> ListCtx g as h
-mapListCtxC nt (h :? as) = h :? mapListC @c nt as
-mapListCtxC nt (a :! ctx) = nt a :! mapListCtxC @c nt ctx
diff --git a/libs/constrained-generators/src/Constrained/NumOrd.hs b/libs/constrained-generators/src/Constrained/NumOrd.hs
deleted file mode 100644
index 95705e9cd26..00000000000
--- a/libs/constrained-generators/src/Constrained/NumOrd.hs
+++ /dev/null
@@ -1,1032 +0,0 @@
-{-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DefaultSignatures #-}
-{-# LANGUAGE DerivingVia #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE PatternSynonyms #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE UndecidableSuperClasses #-}
-{-# LANGUAGE ViewPatterns #-}
--- Random Natural, Arbitrary Natural, Uniform Natural
-{-# OPTIONS_GHC -Wno-orphans #-}
-
--- | Everything we need to deal with numbers and comparisons between them
-module Constrained.NumOrd (
-  NumSpec (..),
-  (>.),
-  (<.),
-  (-.),
-  (>=.),
-  (<=.),
-  (+.),
-  negate_,
-  cardinality,
-  caseBoolSpec,
-  addSpecInt,
-  emptyNumSpec,
-  cardinalNumSpec,
-  combineNumSpec,
-  genFromNumSpec,
-  shrinkWithNumSpec,
-  conformsToNumSpec,
-  toPredsNumSpec,
-  OrdLike (..),
-  MaybeBounded (..),
-  NumLike (..),
-  Numeric,
-  nubOrd,
-  IntW (..),
-  OrdW (..),
-) where
-
-import Constrained.AbstractSyntax
-import Constrained.Base
-import Constrained.Conformance
-import Constrained.Conformance ()
-import Constrained.Core (Value (..), unionWithMaybe)
-import Constrained.FunctionSymbol
-import Constrained.GenT
-import Constrained.Generic
-import Constrained.List
-import Constrained.PrettyUtils
-import Control.Applicative ((<|>))
-import Control.Arrow (first)
-import Data.Foldable
-import Data.Kind
-import Data.List (nub)
-import Data.List.NonEmpty (NonEmpty ((:|)))
-import qualified Data.List.NonEmpty as NE
-import Data.Maybe
-import qualified Data.Set as Set
-import Data.Typeable (typeOf)
-import Data.Word
-import GHC.Int
-import GHC.Natural
-import GHC.Real
-import System.Random.Stateful (Random (..), Uniform (..))
-import Test.QuickCheck (Arbitrary (arbitrary, shrink), choose, frequency)
-
--- | Witnesses for comparison operations (<=. and <. and <=. and >=.) on numbers
--- The other operations are defined in terms of these.
-data OrdW (dom :: [Type]) (rng :: Type) where
-  LessOrEqualW :: OrdLike a => OrdW '[a, a] Bool
-  LessW :: OrdLike a => OrdW '[a, a] Bool
-  GreaterOrEqualW :: OrdLike a => OrdW '[a, a] Bool
-  GreaterW :: OrdLike a => OrdW '[a, a] Bool
-
-deriving instance Eq (OrdW ds r)
-
-instance Show (OrdW ds r) where
-  show LessOrEqualW = "<=."
-  show LessW = "<."
-  show GreaterOrEqualW = ">=."
-  show GreaterW = ">."
-
-instance Semantics OrdW where
-  semantics LessOrEqualW = (<=)
-  semantics LessW = (<)
-  semantics GreaterW = (>)
-  semantics GreaterOrEqualW = (>=)
-
-instance Syntax OrdW where
-  isInfix _ = True
-
--- =============================================
--- OrdLike. Ord for Numbers in the Logic
--- =============================================
-
--- | Ancillary things we need to be able to implement `Logic` instances for
--- `OrdW` that make sense for a given type we are comparing things on.
-class (Ord a, HasSpec a) => OrdLike a where
-  leqSpec :: a -> Specification a
-  default leqSpec ::
-    ( GenericRequires a
-    , OrdLike (SimpleRep a)
-    ) =>
-    a ->
-    Specification a
-  leqSpec = fromSimpleRepSpec . leqSpec . toSimpleRep
-
-  ltSpec :: a -> Specification a
-  default ltSpec ::
-    ( OrdLike (SimpleRep a)
-    , GenericRequires a
-    ) =>
-    a ->
-    Specification a
-  ltSpec = fromSimpleRepSpec . ltSpec . toSimpleRep
-
-  geqSpec :: a -> Specification a
-  default geqSpec ::
-    ( OrdLike (SimpleRep a)
-    , GenericRequires a
-    ) =>
-    a ->
-    Specification a
-  geqSpec = fromSimpleRepSpec . geqSpec . toSimpleRep
-
-  gtSpec :: a -> Specification a
-  default gtSpec ::
-    ( OrdLike (SimpleRep a)
-    , GenericRequires a
-    ) =>
-    a ->
-    Specification a
-  gtSpec = fromSimpleRepSpec . gtSpec . toSimpleRep
-
--- | This instance should be general enough for every type of Number that has a NumSpec as its TypeSpec
-instance {-# OVERLAPPABLE #-} (Ord a, HasSpec a, MaybeBounded a, Num a, TypeSpec a ~ NumSpec a) => OrdLike a where
-  leqSpec l = typeSpec $ NumSpecInterval Nothing (Just l)
-  ltSpec l
-    | Just b <- lowerBound
-    , l == b =
-        ErrorSpec (pure ("ltSpec @" ++ show (typeOf l) ++ " " ++ show l))
-    | otherwise = typeSpec $ NumSpecInterval Nothing (Just (l - 1))
-  geqSpec l = typeSpec $ NumSpecInterval (Just l) Nothing
-  gtSpec l
-    | Just b <- upperBound
-    , l == b =
-        ErrorSpec (pure ("gtSpec @" ++ show (typeOf l) ++ " " ++ show l))
-    | otherwise = typeSpec $ NumSpecInterval (Just (l + 1)) Nothing
-
--- ========================================================================
--- helper functions for the TypeSpec for Numbers
--- ========================================================================
-
--- | Helper class for talking about things that _might_ be `Bounded`
-class MaybeBounded a where
-  lowerBound :: Maybe a
-  upperBound :: Maybe a
-
-  default lowerBound :: Bounded a => Maybe a
-  lowerBound = Just minBound
-
-  default upperBound :: Bounded a => Maybe a
-  upperBound = Just maxBound
-
-newtype Unbounded a = Unbounded a
-
-instance MaybeBounded (Unbounded a) where
-  lowerBound = Nothing
-  upperBound = Nothing
-
-instance MaybeBounded Int
-
-instance MaybeBounded Int64
-
-instance MaybeBounded Int32
-
-instance MaybeBounded Int16
-
-instance MaybeBounded Int8
-
-instance MaybeBounded Word64
-
-instance MaybeBounded Word32
-
-instance MaybeBounded Word16
-
-instance MaybeBounded Word8
-
-deriving via Unbounded Integer instance MaybeBounded Integer
-
-deriving via Unbounded (Ratio Integer) instance MaybeBounded (Ratio Integer)
-
-deriving via Unbounded Float instance MaybeBounded Float
-
-instance MaybeBounded Natural where
-  lowerBound = Just 0
-  upperBound = Nothing
-
--- ===================================================================
--- The TypeSpec for numbers
--- ===================================================================
-
--- | t`TypeSpec` for numbers - represented as a single interval
-data NumSpec n = NumSpecInterval (Maybe n) (Maybe n)
-
-instance Ord n => Eq (NumSpec n) where
-  NumSpecInterval ml mh == NumSpecInterval ml' mh'
-    | isEmpty ml mh = isEmpty ml' mh'
-    | isEmpty ml' mh' = isEmpty ml mh
-    | otherwise = ml == ml' && mh == mh'
-    where
-      isEmpty (Just a) (Just b) = a > b
-      isEmpty _ _ = False
-
-instance Show n => Show (NumSpec n) where
-  show (NumSpecInterval ml mu) = lb ++ ".." ++ ub
-    where
-      lb = "[" ++ maybe "" show ml
-      ub = maybe "" show mu ++ "]"
-
-instance Ord n => Semigroup (NumSpec n) where
-  NumSpecInterval ml mu <> NumSpecInterval ml' mu' =
-    NumSpecInterval
-      (unionWithMaybe max ml ml')
-      (unionWithMaybe min mu mu')
-
-instance Ord n => Monoid (NumSpec n) where
-  mempty = NumSpecInterval Nothing Nothing
-
--- ===========================================
--- Arbitrary for Num like things
--- ===========================================
-
-instance (Arbitrary a, Ord a) => Arbitrary (NumSpec a) where
-  arbitrary = do
-    m <- arbitrary
-    m' <- arbitrary
-    frequency [(10, pure $ mkLoHiInterval m m'), (1, pure $ NumSpecInterval m m')]
-    where
-      mkLoHiInterval (Just a) (Just b) = NumSpecInterval (Just $ min a b) (Just $ max a b)
-      mkLoHiInterval m m' = NumSpecInterval m m'
-  shrink (NumSpecInterval m m') =
-    uncurry NumSpecInterval <$> shrink (m, m')
-
-instance Arbitrary Natural where
-  arbitrary = wordToNatural . abs <$> arbitrary
-  shrink n = [wordToNatural w | w <- shrink (naturalToWord n)]
-
-instance Uniform Natural where
-  uniformM g = wordToNatural . abs <$> uniformM g
-
-instance Random Natural where
-  randomR (lo, hi) g = first fromIntegral $ randomR (toInteger lo, toInteger hi) g
-
-instance Random (Ratio Integer) where
-  randomR (lo, hi) g =
-    let (r, g') = random g
-     in (lo + (hi - lo) * r, g')
-  random g =
-    let (d, g') = first ((+ 1) . abs) $ random g
-        (n, g'') = randomR (0, d) g'
-     in (n % d, g'')
-
--- ==============================================================================
--- Operations on NumSpec, that give it the required properties of a TypeSpec
--- ==============================================================================
-
--- | Admits anything
-emptyNumSpec :: Ord a => NumSpec a
-emptyNumSpec = mempty
-
-guardNumSpec ::
-  (Ord n, HasSpec n, TypeSpec n ~ NumSpec n) =>
-  [String] ->
-  NumSpec n ->
-  Specification n
-guardNumSpec msg s@(NumSpecInterval (Just a) (Just b))
-  | a > b = ErrorSpec ("NumSpec has low bound greater than hi bound" :| (("   " ++ show s) : msg))
-  | a == b = equalSpec a
-guardNumSpec _ s = typeSpec s
-
--- | Conjunction
-combineNumSpec ::
-  (HasSpec n, Ord n, TypeSpec n ~ NumSpec n) =>
-  NumSpec n ->
-  NumSpec n ->
-  Specification n
-combineNumSpec s s' = guardNumSpec ["when combining two NumSpecs", "   " ++ show s, "   " ++ show s'] (s <> s')
-
--- | Generate a value that satisfies the spec
-genFromNumSpec ::
-  (MonadGenError m, Show n, Random n, Ord n, Num n, MaybeBounded n) =>
-  NumSpec n ->
-  GenT m n
-genFromNumSpec (NumSpecInterval ml mu) = do
-  n <- sizeT
-  pureGen . choose =<< constrainInterval (ml <|> lowerBound) (mu <|> upperBound) (fromIntegral n)
-
--- TODO: fixme
-
--- | Try to shrink using a `NumSpec`
-shrinkWithNumSpec :: Arbitrary n => NumSpec n -> n -> [n]
-shrinkWithNumSpec _ = shrink
-
-constrainInterval ::
-  (MonadGenError m, Ord a, Num a, Show a) => Maybe a -> Maybe a -> Integer -> m (a, a)
-constrainInterval ml mu r =
-  case (ml, mu) of
-    (Nothing, Nothing) -> pure (-r', r')
-    (Just l, Nothing)
-      | l < 0 -> pure (max l (negate r'), r')
-      | otherwise -> pure (l, l + 2 * r')
-    (Nothing, Just u)
-      | u > 0 -> pure (negate r', min u r')
-      | otherwise -> pure (u - r' - r', u)
-    (Just l, Just u)
-      | l > u -> genError ("bad interval: " ++ show l ++ " " ++ show u)
-      | u < 0 -> pure (safeSub l (safeSub l u r') r', u)
-      | l >= 0 -> pure (l, safeAdd u (safeAdd u l r') r')
-      -- TODO: this is a bit suspect if the bounds are lopsided
-      | otherwise -> pure (max l (-r'), min u r')
-  where
-    r' = abs $ fromInteger r
-    safeSub l a b
-      | a - b > a = l
-      | otherwise = max l (a - b)
-    safeAdd u a b
-      | a + b < a = u
-      | otherwise = min u (a + b)
-
--- | Check that a value is in the spec
-conformsToNumSpec :: Ord n => n -> NumSpec n -> Bool
-conformsToNumSpec i (NumSpecInterval ml mu) = maybe True (<= i) ml && maybe True (i <=) mu
-
--- =======================================================================
--- Several of the methods of HasSpec that have default implementations
--- could benefit from type specific implementations for numbers. Those
--- implementations are found here
--- =====================================================================
-
--- | Strip out duplicates (in n-log(n) time, by building an intermediate Set)
-nubOrd :: Ord a => [a] -> [a]
-nubOrd =
-  loop mempty
-  where
-    loop _ [] = []
-    loop s (a : as)
-      | a `Set.member` s = loop s as
-      | otherwise =
-          let s' = Set.insert a s in s' `seq` a : loop s' as
-
--- | Builds a MemberSpec, but returns an Error spec if the list is empty
-nubOrdMemberSpec :: Ord a => String -> [a] -> Specification a
-nubOrdMemberSpec message xs =
-  memberSpec
-    (nubOrd xs)
-    ( NE.fromList
-        [ "In call to nubOrdMemberSpec"
-        , "Called from context"
-        , message
-        , "The input is the empty list."
-        ]
-    )
-
-lowBound :: Bounded n => Maybe n -> n
-lowBound Nothing = minBound
-lowBound (Just n) = n
-
-highBound :: Bounded n => Maybe n -> n
-highBound Nothing = maxBound
-highBound (Just n) = n
-
--- | The exact count of the number elements in a Bounded NumSpec
-countSpec :: forall n. (Bounded n, Integral n) => NumSpec n -> Integer
-countSpec (NumSpecInterval lo hi) = if lo > hi then 0 else toInteger high - toInteger low + 1
-  where
-    high = highBound hi
-    low = lowBound lo
-
--- | The exact number of elements in a Bounded Integral type.
-finiteSize :: forall n. (Integral n, Bounded n) => Integer
-finiteSize = toInteger (maxBound @n) - toInteger (minBound @n) + 1
-
--- | This is an optimizing version of  TypeSpec :: TypeSpec n -> [n] -> Specification n
---   for Bounded NumSpecs.
---                    notInNumSpec :: Bounded n => TypeSpec n -> [n] -> Specification n
---   We use this function to specialize the (HasSpec t) method 'typeSpecOpt' for Bounded n.
---   So given (TypeSpec interval badlist) we might want to transform it to (MemberSpec goodlist)
---   There are 2 opportunities where this can payoff big time.
---   1) Suppose the total count of the elements in the interval is < length badlist
---      we can then return (MemberSpec (filter elements (`notElem` badlist)))
---      this must be smaller than (TypeSpec interval badlist) because the filtered list must be smaller than badlist
---   2) Suppose the type 't' is finite with size N. If the length of the badlist > (N/2), then the number of possible
---      good things must be smaller than (length badlist), because (possible good + bad == N), so regardless of the
---      count of the interval (MemberSpec (filter elements (`notElem` badlist))) is better. Sometimes much better.
---      Example, let 'n' be the finite set {0,1,2,3,4,5,6,7,8,9} and the bad list be [0,1,3,4,5,6,8,9]
---      (TypeSpec [0..9]  [0,1,3,4,5,6,8,9]) = filter  {0,1,2,3,4,5,6,7,8,9} (`notElem` [0,1,3,4,5,6,8,9]) = [2,7]
---      So (MemberSpec [2,7]) is better than  (TypeSpec [0..9]  [0,1,3,4,5,6,8,9]). This works no matter what
---      the count of interval is. We only need the (length badlist > (N/2)).
-notInNumSpec ::
-  forall n.
-  ( HasSpec n
-  , TypeSpec n ~ NumSpec n
-  , Bounded n
-  , Integral n
-  ) =>
-  NumSpec n ->
-  [n] ->
-  Specification n
-notInNumSpec ns@(NumSpecInterval a b) bad
-  | toInteger (length bad) > (finiteSize @n `div` 2) || countSpec ns < toInteger (length bad) =
-      nubOrdMemberSpec
-        ("call to: (notInNumSpec " ++ show ns ++ " " ++ show bad ++ ")")
-        [x | x <- [lowBound a .. highBound b], notElem x bad]
-  | otherwise = TypeSpec @n ns bad
-
--- ==========================================================================
--- Num n => (NumSpec n) can support operation of Num as interval arithmetic.
--- So we will make a (Num (NumSpec Integer)) instance. We won't make other
--- instances, because  they would be subject to overflow.
--- Given operator ☉, then (a,b) ☉ (c,d) = (minimum s, maximum s) where s = [a ☉ c, a ☉ d, b ☉ c, b ☉ d]
--- There are simpler rules for (+) and (-), but for (*) we need to use the general rule.
--- ==========================================================================
-
-guardEmpty :: (Ord n, Num n) => Maybe n -> Maybe n -> NumSpec n -> NumSpec n
-guardEmpty (Just a) (Just b) s
-  | a <= b = s
-  | otherwise = NumSpecInterval (Just 1) (Just 0)
-guardEmpty _ _ s = s
-
-addNumSpec :: (Ord n, Num n) => NumSpec n -> NumSpec n -> NumSpec n
-addNumSpec (NumSpecInterval x y) (NumSpecInterval a b) =
-  guardEmpty x y $
-    guardEmpty a b $
-      NumSpecInterval ((+) <$> x <*> a) ((+) <$> y <*> b)
-
-subNumSpec :: (Ord n, Num n) => NumSpec n -> NumSpec n -> NumSpec n
-subNumSpec (NumSpecInterval x y) (NumSpecInterval a b) =
-  guardEmpty x y $
-    guardEmpty a b $
-      NumSpecInterval ((-) <$> x <*> b) ((-) <$> y <*> a)
-
-multNumSpec :: (Ord n, Num n) => NumSpec n -> NumSpec n -> NumSpec n
-multNumSpec (NumSpecInterval a b) (NumSpecInterval c d) =
-  guardEmpty a b $
-    guardEmpty c d $
-      NumSpecInterval (unT (minimum s)) (unT (maximum s))
-  where
-    s = [multT (neg a) (neg c), multT (neg a) (pos d), multT (pos b) (neg c), multT (pos b) (pos d)]
-
-negNumSpec :: Num n => NumSpec n -> NumSpec n
-negNumSpec (NumSpecInterval lo hi) = NumSpecInterval (negate <$> hi) (negate <$> lo)
-
-instance Num (NumSpec Integer) where
-  (+) = addNumSpec
-  (-) = subNumSpec
-  (*) = multNumSpec
-  negate = negNumSpec
-  fromInteger n = NumSpecInterval (Just (fromInteger n)) (Just (fromInteger n))
-  abs = error "No abs in the Num (NumSpec  Integer) instance"
-  signum = error "No signum in the Num (NumSpec  Integer) instance"
-
--- ========================================================================
--- Helper functions for interval multiplication
---  (a,b) * (c,d) = (minimum s, maximum s) where s = [a * c, a * d, b * c, b * d]
-
--- | T is a sort of special version of Maybe, with two Nothings.
---   Given:: NumSpecInterval (Maybe n) (Maybe n) -> Numspec
---   We can't distinguish between the two Nothings in (NumSpecInterval Nothing Nothing)
---   But using (NumSpecInterval NegInf PosInf) we can, In fact we can make a total ordering on 'T'
---   So an ascending Sorted [T x] would all the NegInf on the left and all the PosInf on the right, with
---   the Ok's sorted in between. I.e. [NegInf, NegInf, Ok 3, Ok 6, Ok 12, Pos Inf]
-data T x = NegInf | Ok x | PosInf
-  deriving (Show, Eq, Ord)
-
--- \| Conversion between (T x) and (Maybe x)
-unT :: T x -> Maybe x
-unT (Ok x) = Just x
-unT _ = Nothing
-
--- | Use this on the lower bound. I.e. lo from pair (lo,hi)
-neg :: Maybe x -> T x
-neg Nothing = NegInf
-neg (Just x) = Ok x
-
--- | Use this on the upper bound. I.e. hi from pair (lo,hi)
-pos :: Maybe x -> T x
-pos Nothing = PosInf
-pos (Just x) = Ok x
-
--- | multiply two (T x), correctly handling the infinities NegInf and PosInf
-multT :: Num x => T x -> T x -> T x
-multT NegInf NegInf = PosInf
-multT NegInf PosInf = NegInf
-multT NegInf (Ok _) = NegInf
-multT (Ok _) NegInf = NegInf
-multT (Ok x) (Ok y) = Ok (x * y)
-multT (Ok _) PosInf = PosInf
-multT PosInf PosInf = PosInf
-multT PosInf NegInf = NegInf
-multT PosInf (Ok _) = PosInf
-
--- ========================================================================
--- We have
--- (1) Num Integer
--- (2) Num (NumSpec Integer)   And we need
--- (3) Num (Specification Integer)
--- We need this to implement the method cardinalTypeSpec of (HasSpec t).
--- cardinalTypeSpec :: HasSpec a => TypeSpec a -> Specification Integer
--- Basically for defining these two cases
--- cardinalTypeSpec (Cartesian x y) = (cardinality x) * (cardinality y)
--- cardinalTypeSpec (SumSpec leftspec rightspec) = (cardinality leftspec) + (cardinality rightspec)
--- So we define addSpecInt for (+)   and  multSpecInt for (*)
-
--- | What constraints we need to make HasSpec instance for a Haskell numeric type.
---   By abstracting over this, we can avoid making actual HasSpec instances until
---   all the requirements (HasSpec Bool, HasSpec(Sum a b)) have been met in
---   Constrained.TheKnot.
-type Number n = (Num n, Enum n, TypeSpec n ~ NumSpec n, Num (NumSpec n), HasSpec n, Ord n)
-
--- | Addition on `Specification` for `Number`
-addSpecInt ::
-  Number n =>
-  Specification n ->
-  Specification n ->
-  Specification n
-addSpecInt x y = operateSpec " + " (+) (+) x y
-
-subSpecInt ::
-  Number n =>
-  Specification n ->
-  Specification n ->
-  Specification n
-subSpecInt x y = operateSpec " - " (-) (-) x y
-
-multSpecInt ::
-  Number n =>
-  Specification n ->
-  Specification n ->
-  Specification n
-multSpecInt x y = operateSpec " * " (*) (*) x y
-
--- | let 'n' be some numeric type, and 'f' and 'ft' be operations on 'n' and (TypeSpec n)
---   Then lift these operations from (TypeSpec n) to (Specification n)
---   Normally 'f' will be a (Num n) instance method (+,-,*) on n,
---   and 'ft' will be a a (Num (TypeSpec n)) instance method (+,-,*) on (TypeSpec n)
---   But this will work for any operations 'f' and 'ft' with the right types
-operateSpec ::
-  Number n =>
-  String ->
-  (n -> n -> n) ->
-  (TypeSpec n -> TypeSpec n -> TypeSpec n) ->
-  Specification n ->
-  Specification n ->
-  Specification n
-operateSpec operator f ft (ExplainSpec es x) y = explainSpec es $ operateSpec operator f ft x y
-operateSpec operator f ft x (ExplainSpec es y) = explainSpec es $ operateSpec operator f ft x y
-operateSpec operator f ft x y = case (x, y) of
-  (ErrorSpec xs, ErrorSpec ys) -> ErrorSpec (xs <> ys)
-  (ErrorSpec xs, _) -> ErrorSpec xs
-  (_, ErrorSpec ys) -> ErrorSpec ys
-  (TrueSpec, _) -> TrueSpec
-  (_, TrueSpec) -> TrueSpec
-  (_, SuspendedSpec _ _) -> TrueSpec
-  (SuspendedSpec _ _, _) -> TrueSpec
-  (TypeSpec a bad1, TypeSpec b bad2) -> TypeSpec (ft a b) [f b1 b2 | b1 <- bad1, b2 <- bad2]
-  (MemberSpec xs, MemberSpec ys) ->
-    nubOrdMemberSpec
-      (show x ++ operator ++ show y)
-      [f x1 y1 | x1 <- NE.toList xs, y1 <- NE.toList ys]
-  -- This block is all (MemberSpec{}, TypeSpec{}) with MemberSpec on the left
-  (MemberSpec ys, TypeSpec (NumSpecInterval (Just i) (Just j)) bad) ->
-    let xs = NE.toList ys
-     in nubOrdMemberSpec
-          (show x ++ operator ++ show y)
-          [f x1 y1 | x1 <- xs, y1 <- [i .. j], not (elem y1 bad)]
-  -- Somewhat loose spec here, but more accurate then TrueSpec, it is exact if 'xs' has one element (i.e. 'xs' = [i])
-  (MemberSpec ys, TypeSpec (NumSpecInterval lo hi) bads) ->
-    -- We use the specialized version of 'TypeSpec' 'typeSpecOpt'
-    let xs = NE.toList ys
-     in typeSpecOpt
-          (NumSpecInterval (f (minimum xs) <$> lo) (f (maximum xs) <$> hi))
-          [f x1 b | x1 <- xs, b <- bads]
-  -- we flip the arguments, so we need to flip the functions as well
-  (sleft, sright) -> operateSpec operator (\a b -> f b a) (\u v -> ft v u) sright sleft
-
--- | This is very liberal, since in lots of cases it returns TrueSpec.
---  for example all operations on SuspendedSpec, and certain
---  operations between TypeSpec and MemberSpec. Perhaps we should
---  remove it. Only the addSpec (+) and multSpec (*) methods are used.
---  But, it is kind of cool ...
---  In Fact we can use this to make Num(Specification n) instance for any 'n'.
---  But, only Integer is safe, because in all other types (+) and especially
---  (-) can lead to overflow or underflow failures.
-instance Number Integer => Num (Specification Integer) where
-  (+) = addSpecInt
-  (-) = subSpecInt
-  (*) = multSpecInt
-  fromInteger n = TypeSpec (NumSpecInterval (Just n) (Just n)) []
-  abs _ = TrueSpec
-  signum _ = TrueSpec
-
--- ===========================================================================
-
--- | Put some (admittedly loose bounds) on the number of solutions that
---   'genFromTypeSpec' might return. For lots of types, there is no way to be very accurate.
---   Here we lift the HasSpec methods 'cardinalTrueSpec' and 'cardinalTypeSpec'
---   from (TypeSpec Integer) to (Specification Integer)
-cardinality ::
-  forall a. (Number Integer, HasSpec a) => Specification a -> Specification Integer
-cardinality (ExplainSpec es s) = explainSpec es (cardinality s)
-cardinality TrueSpec = cardinalTrueSpec @a
-cardinality (MemberSpec es) = equalSpec (toInteger $ length (nub (NE.toList es)))
-cardinality ErrorSpec {} = equalSpec 0
-cardinality (TypeSpec s cant) =
-  subSpecInt
-    (cardinalTypeSpec @a s)
-    (equalSpec (toInteger $ length (nub $ filter (\c -> conformsTo @a c s) cant)))
-cardinality SuspendedSpec {} = cardinalTrueSpec @a
-
--- | A generic function to use as an instance for the HasSpec method
---   cardinalTypeSpec :: HasSpec a => TypeSpec a -> Specification Integer
---   for types 'n' such that (TypeSpec n ~ NumSpec n)
-cardinalNumSpec ::
-  forall n. (Integral n, MaybeBounded n, HasSpec n) => NumSpec n -> Specification Integer
-cardinalNumSpec (NumSpecInterval (Just lo) (Just hi)) =
-  if hi >= lo
-    then equalSpec (toInteger hi - toInteger lo + 1)
-    else equalSpec 0
-cardinalNumSpec (NumSpecInterval Nothing (Just hi)) =
-  case lowerBound @n of
-    Just lo -> equalSpec (toInteger hi - toInteger lo)
-    Nothing -> TrueSpec
-cardinalNumSpec (NumSpecInterval (Just lo) Nothing) =
-  case upperBound @n of
-    Just hi -> equalSpec (toInteger hi - toInteger lo)
-    Nothing -> TrueSpec
-cardinalNumSpec (NumSpecInterval Nothing Nothing) = cardinalTrueSpec @n
-
--- ====================================================================
--- Now the operations on Numbers
-
--- | Everything we need to make the number operations make sense on a given type
-class (Num a, HasSpec a) => NumLike a where
-  subtractSpec :: a -> TypeSpec a -> Specification a
-  default subtractSpec ::
-    ( NumLike (SimpleRep a)
-    , GenericRequires a
-    ) =>
-    a ->
-    TypeSpec a ->
-    Specification a
-  subtractSpec a ts = fromSimpleRepSpec $ subtractSpec (toSimpleRep a) ts
-
-  negateSpec :: TypeSpec a -> Specification a
-  default negateSpec ::
-    ( NumLike (SimpleRep a)
-    , GenericRequires a
-    ) =>
-    TypeSpec a ->
-    Specification a
-  negateSpec = fromSimpleRepSpec . negateSpec @(SimpleRep a)
-
-  safeSubtract :: a -> a -> Maybe a
-  default safeSubtract ::
-    (HasSimpleRep a, NumLike (SimpleRep a)) =>
-    a ->
-    a ->
-    Maybe a
-  safeSubtract a b = fromSimpleRep <$> safeSubtract @(SimpleRep a) (toSimpleRep a) (toSimpleRep b)
-
--- | Operations on numbers
-data IntW (as :: [Type]) b where
-  AddW :: NumLike a => IntW '[a, a] a
-  NegateW :: NumLike a => IntW '[a] a
-
-deriving instance Eq (IntW dom rng)
-
-instance Show (IntW d r) where
-  show AddW = "+"
-  show NegateW = "negate_"
-
-instance Semantics IntW where
-  semantics AddW = (+)
-  semantics NegateW = negate
-
-instance Syntax IntW where
-  isInfix AddW = True
-  isInfix NegateW = False
-
--- | A type that we can reason numerically about in constraints
-type Numeric a = (HasSpec a, Ord a, Num a, TypeSpec a ~ NumSpec a, MaybeBounded a)
-
-instance {-# OVERLAPPABLE #-} Numeric a => NumLike a where
-  subtractSpec a ts@(NumSpecInterval ml mu)
-    | Just u <- mu
-    , a > 0
-    , Nothing <- safeSubtract a u =
-        ErrorSpec $
-          NE.fromList
-            [ "Underflow in subtractSpec (" ++ showType @a ++ "):"
-            , "  a = " ++ show a
-            , "  ts = " ++ show ts
-            ]
-    | Just l <- ml
-    , a < 0
-    , Nothing <- safeSubtract a l =
-        ErrorSpec $
-          NE.fromList
-            [ "Overflow in subtractSpec (" ++ showType @a ++ "):"
-            , "  a = " ++ show a
-            , "  ts = " ++ show ts
-            ]
-    | otherwise = typeSpec $ NumSpecInterval (safeSub a <$> ml) (safeSub a <$> mu)
-    where
-      safeSub :: a -> a -> a
-      safeSub a1 x
-        | Just r <- safeSubtract a1 x = r
-        | a1 < 0 = fromJust upperBound
-        | otherwise = fromJust lowerBound
-  negateSpec (NumSpecInterval ml mu) = typeSpec $ NumSpecInterval (negate <$> mu) (negate <$> ml)
-
-  safeSubtract a x
-    | a > 0
-    , Just lb <- lowerBound
-    , lb + a > x =
-        Nothing
-    | a < 0
-    , Just ub <- upperBound
-    , ub + a < x =
-        Nothing
-    | otherwise = Just $ x - a
-
-instance NumLike a => Num (Term a) where
-  (+) = addFn
-  negate = negateFn
-  fromInteger = Lit . fromInteger
-  (*) = error "(*) not implemented for Term Fn Int"
-  abs = error "abs not implemented for Term Fn Int"
-  signum = error "signum not implemented for Term Fn Int"
-
--- | Just a note that these instances won't work until we are in a context where
---   there is a HasSpec instance of 'a', which (NumLike a) demands.
---   This happens in Constrained.Experiment.TheKnot
-instance Logic IntW where
-  propagateTypeSpec AddW (HOLE :<: i) ts cant = subtractSpec i ts <> notMemberSpec (mapMaybe (safeSubtract i) cant)
-  propagateTypeSpec AddW ctx ts cant = propagateTypeSpec AddW (flipCtx ctx) ts cant
-  propagateTypeSpec NegateW (Unary HOLE) ts cant = negateSpec ts <> notMemberSpec (map negate cant)
-
-  propagateMemberSpec AddW (HOLE :<: i) es =
-    memberSpec
-      (nub $ mapMaybe (safeSubtract i) (NE.toList es))
-      ( NE.fromList
-          [ "propagateSpecFn on (" ++ show i ++ " +. HOLE)"
-          , "The Spec is a MemberSpec = " ++ show es -- show (MemberSpec @HasSpec @TS es)
-          , "We can't safely subtract " ++ show i ++ " from any choice in the MemberSpec."
-          ]
-      )
-  propagateMemberSpec AddW ctx es = propagateMemberSpec AddW (flipCtx ctx) es
-  propagateMemberSpec NegateW (Unary HOLE) es = MemberSpec $ NE.nub $ fmap negate es
-
-addFn :: forall a. NumLike a => Term a -> Term a -> Term a
-addFn = appTerm AddW
-
-negateFn :: forall a. NumLike a => Term a -> Term a
-negateFn = appTerm NegateW
-
-infix 4 +.
-
--- | `Term`-level `(+)`
-(+.) :: NumLike a => Term a -> Term a -> Term a
-(+.) = addFn
-
--- | `Term`-level `negate`
-negate_ :: NumLike a => Term a -> Term a
-negate_ = negateFn
-
-infix 4 -.
-
--- | `Term`-level `(-)`
-(-.) :: Numeric n => Term n -> Term n -> Term n
-(-.) x y = addFn x (negateFn y)
-
-infixr 4 <=.
-
--- | `Term`-level `(<=)`
-(<=.) :: forall a. OrdLike a => Term a -> Term a -> Term Bool
-(<=.) = appTerm LessOrEqualW
-
-infixr 4 <.
-
--- | `Term`-level `(<)`
-(<.) :: forall a. OrdLike a => Term a -> Term a -> Term Bool
-(<.) = appTerm LessW
-
-infixr 4 >=.
-
--- | `Term`-level `(>=)`
-(>=.) :: forall a. OrdLike a => Term a -> Term a -> Term Bool
-(>=.) = appTerm GreaterOrEqualW
-
-infixr 4 >.
-
--- | `Term`-level `(>)`
-(>.) :: forall a. OrdLike a => Term a -> Term a -> Term Bool
-(>.) = appTerm GreaterW
-
--- | t`TypeSpec`-level `satisfies` to implement `toPreds` in
--- `HasSpec` instance
-toPredsNumSpec ::
-  OrdLike n =>
-  Term n ->
-  NumSpec n ->
-  Pred
-toPredsNumSpec v (NumSpecInterval ml mu) =
-  fold $
-    [Assert $ Lit l <=. v | l <- maybeToList ml]
-      ++ [Assert $ v <=. Lit u | u <- maybeToList mu]
-
-instance Logic OrdW where
-  propagate f ctxt (ExplainSpec [] s) = propagate f ctxt s
-  propagate f ctxt (ExplainSpec es s) = ExplainSpec es $ propagate f ctxt s
-  propagate _ _ TrueSpec = TrueSpec
-  propagate _ _ (ErrorSpec msgs) = ErrorSpec msgs
-  propagate GreaterW (HOLE :? x :> Nil) spec =
-    propagate LessW (x :! Unary HOLE) spec
-  propagate GreaterW (x :! Unary HOLE) spec =
-    propagate LessW (HOLE :? x :> Nil) spec
-  propagate LessOrEqualW (HOLE :? Value x :> Nil) (SuspendedSpec v ps) =
-    constrained $ \v' -> Let (App LessOrEqualW (v' :> Lit x :> Nil)) (v :-> ps)
-  propagate LessOrEqualW (Value x :! Unary HOLE) (SuspendedSpec v ps) =
-    constrained $ \v' -> Let (App LessOrEqualW (Lit x :> v' :> Nil)) (v :-> ps)
-  propagate LessOrEqualW (HOLE :? Value l :> Nil) spec =
-    caseBoolSpec spec $ \case True -> leqSpec l; False -> gtSpec l
-  propagate LessOrEqualW (Value l :! Unary HOLE) spec =
-    caseBoolSpec spec $ \case True -> geqSpec l; False -> ltSpec l
-  propagate GreaterOrEqualW (HOLE :? Value x :> Nil) spec =
-    propagate LessOrEqualW (Value x :! Unary HOLE) spec
-  propagate GreaterOrEqualW (x :! Unary HOLE) spec =
-    propagate LessOrEqualW (HOLE :? x :> Nil) spec
-  propagate LessW (HOLE :? Value x :> Nil) (SuspendedSpec v ps) =
-    constrained $ \v' -> Let (App LessW (v' :> Lit x :> Nil)) (v :-> ps)
-  propagate LessW (Value x :! Unary HOLE) (SuspendedSpec v ps) =
-    constrained $ \v' -> Let (App LessW (Lit x :> v' :> Nil)) (v :-> ps)
-  propagate LessW (HOLE :? Value l :> Nil) spec =
-    caseBoolSpec spec $ \case True -> ltSpec l; False -> geqSpec l
-  propagate LessW (Value l :! Unary HOLE) spec =
-    caseBoolSpec spec $ \case True -> gtSpec l; False -> leqSpec l
-
--- | @if-then-else@ on a specification, useful for writing `propagate` implementations
--- of predicates, e.g.:
--- > propagate LessW (Value l :! Unary HOLE) spec =
--- >   caseBoolSpec spec $ \case True -> gtSpec l; False -> leqSpec l
-caseBoolSpec ::
-  HasSpec a => Specification Bool -> (Bool -> Specification a) -> Specification a
-caseBoolSpec spec cont = case possibleValues spec of
-  [] -> ErrorSpec (NE.fromList ["No possible values in caseBoolSpec"])
-  [b] -> cont b
-  _ -> mempty
-  where
-    -- where possibleValues s = filter (flip conformsToSpec (simplifySpec s)) [True, False]
-    -- This will always get the same result, and probably faster since running 2
-    -- conformsToSpec on True and False takes less time than simplifying the spec.
-    -- Since we are in TheKnot, we could keep the simplifySpec. Is there a good reason to?
-    possibleValues s = filter (flip conformsToSpec s) [True, False]
-
-------------------------------------------------------------------------
--- Instances of HasSpec for numeric types
-------------------------------------------------------------------------
-
-instance HasSpec Integer where
-  type TypeSpec Integer = NumSpec Integer
-  emptySpec = emptyNumSpec
-  combineSpec = combineNumSpec
-  genFromTypeSpec = genFromNumSpec
-  shrinkWithTypeSpec = shrinkWithNumSpec
-  conformsTo = conformsToNumSpec
-  toPreds = toPredsNumSpec
-  cardinalTypeSpec = cardinalNumSpec
-  guardTypeSpec = guardNumSpec
-
-instance HasSpec Int where
-  type TypeSpec Int = NumSpec Int
-  emptySpec = emptyNumSpec
-  combineSpec = combineNumSpec
-  genFromTypeSpec = genFromNumSpec
-  shrinkWithTypeSpec = shrinkWithNumSpec
-  conformsTo = conformsToNumSpec
-  toPreds = toPredsNumSpec
-  cardinalTypeSpec = cardinalNumSpec
-  guardTypeSpec = guardNumSpec
-
-instance HasSpec (Ratio Integer) where
-  type TypeSpec (Ratio Integer) = NumSpec (Ratio Integer)
-  emptySpec = emptyNumSpec
-  combineSpec = combineNumSpec
-  genFromTypeSpec = genFromNumSpec
-  shrinkWithTypeSpec = shrinkWithNumSpec
-  conformsTo = conformsToNumSpec
-  toPreds = toPredsNumSpec
-  cardinalTypeSpec _ = TrueSpec
-  guardTypeSpec = guardNumSpec
-
-instance HasSpec Natural where
-  type TypeSpec Natural = NumSpec Natural
-  emptySpec = emptyNumSpec
-  combineSpec = combineNumSpec
-  genFromTypeSpec = genFromNumSpec
-  shrinkWithTypeSpec = shrinkWithNumSpec
-  conformsTo = conformsToNumSpec
-  toPreds = toPredsNumSpec
-  cardinalTypeSpec (NumSpecInterval (fromMaybe 0 -> lo) (Just hi)) =
-    if lo < hi
-      then equalSpec (fromIntegral $ hi - lo + 1)
-      else equalSpec 0
-  cardinalTypeSpec _ = TrueSpec
-  guardTypeSpec = guardNumSpec
-
-instance HasSpec Word8 where
-  type TypeSpec Word8 = NumSpec Word8
-  emptySpec = emptyNumSpec
-  combineSpec = combineNumSpec
-  genFromTypeSpec = genFromNumSpec
-  shrinkWithTypeSpec = shrinkWithNumSpec
-  conformsTo = conformsToNumSpec
-  toPreds = toPredsNumSpec
-  cardinalTypeSpec = cardinalNumSpec
-  cardinalTrueSpec = equalSpec 256
-  typeSpecOpt = notInNumSpec
-  guardTypeSpec = guardNumSpec
-
-instance HasSpec Word16 where
-  type TypeSpec Word16 = NumSpec Word16
-  emptySpec = emptyNumSpec
-  combineSpec = combineNumSpec
-  genFromTypeSpec = genFromNumSpec
-  shrinkWithTypeSpec = shrinkWithNumSpec
-  conformsTo = conformsToNumSpec
-  toPreds = toPredsNumSpec
-  cardinalTypeSpec = cardinalNumSpec
-  cardinalTrueSpec = equalSpec 65536
-  guardTypeSpec = guardNumSpec
-
-instance HasSpec Word32 where
-  type TypeSpec Word32 = NumSpec Word32
-  emptySpec = emptyNumSpec
-  combineSpec = combineNumSpec
-  genFromTypeSpec = genFromNumSpec
-  shrinkWithTypeSpec = shrinkWithNumSpec
-  conformsTo = conformsToNumSpec
-  toPreds = toPredsNumSpec
-  cardinalTypeSpec = cardinalNumSpec
-  guardTypeSpec = guardNumSpec
-
-instance HasSpec Word64 where
-  type TypeSpec Word64 = NumSpec Word64
-  emptySpec = emptyNumSpec
-  combineSpec = combineNumSpec
-  genFromTypeSpec = genFromNumSpec
-  shrinkWithTypeSpec = shrinkWithNumSpec
-  conformsTo = conformsToNumSpec
-  toPreds = toPredsNumSpec
-  cardinalTypeSpec = cardinalNumSpec
-  guardTypeSpec = guardNumSpec
-
-instance HasSpec Int8 where
-  type TypeSpec Int8 = NumSpec Int8
-  emptySpec = emptyNumSpec
-  combineSpec = combineNumSpec
-  genFromTypeSpec = genFromNumSpec
-  shrinkWithTypeSpec = shrinkWithNumSpec
-  conformsTo = conformsToNumSpec
-  toPreds = toPredsNumSpec
-  cardinalTrueSpec = equalSpec 256
-  cardinalTypeSpec = cardinalNumSpec
-  guardTypeSpec = guardNumSpec
-
-instance HasSpec Int16 where
-  type TypeSpec Int16 = NumSpec Int16
-  emptySpec = emptyNumSpec
-  combineSpec = combineNumSpec
-  genFromTypeSpec = genFromNumSpec
-  shrinkWithTypeSpec = shrinkWithNumSpec
-  conformsTo = conformsToNumSpec
-  toPreds = toPredsNumSpec
-  cardinalTypeSpec = cardinalNumSpec
-  cardinalTrueSpec = equalSpec 65536
-  guardTypeSpec = guardNumSpec
-
-instance HasSpec Int32 where
-  type TypeSpec Int32 = NumSpec Int32
-  emptySpec = emptyNumSpec
-  combineSpec = combineNumSpec
-  genFromTypeSpec = genFromNumSpec
-  shrinkWithTypeSpec = shrinkWithNumSpec
-  conformsTo = conformsToNumSpec
-  toPreds = toPredsNumSpec
-  cardinalTypeSpec = cardinalNumSpec
-  guardTypeSpec = guardNumSpec
-
-instance HasSpec Int64 where
-  type TypeSpec Int64 = NumSpec Int64
-  emptySpec = emptyNumSpec
-  combineSpec = combineNumSpec
-  genFromTypeSpec = genFromNumSpec
-  shrinkWithTypeSpec = shrinkWithNumSpec
-  conformsTo = conformsToNumSpec
-  toPreds = toPredsNumSpec
-  cardinalTypeSpec = cardinalNumSpec
-  guardTypeSpec = guardNumSpec
-
-instance HasSpec Float where
-  type TypeSpec Float = NumSpec Float
-  emptySpec = emptyNumSpec
-  combineSpec = combineNumSpec
-  genFromTypeSpec = genFromNumSpec
-  shrinkWithTypeSpec = shrinkWithNumSpec
-  conformsTo = conformsToNumSpec
-  toPreds = toPredsNumSpec
-  cardinalTypeSpec _ = TrueSpec
-  guardTypeSpec = guardNumSpec
diff --git a/libs/constrained-generators/src/Constrained/PrettyUtils.hs b/libs/constrained-generators/src/Constrained/PrettyUtils.hs
deleted file mode 100644
index d8462e21fd4..00000000000
--- a/libs/constrained-generators/src/Constrained/PrettyUtils.hs
+++ /dev/null
@@ -1,91 +0,0 @@
-{-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE ExistentialQuantification #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE PolyKinds #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}
-
--- | Utility functions for writing pretty-printers
-module Constrained.PrettyUtils (
-  -- * Precedence
-  WithPrec (..),
-  parensIf,
-  prettyPrec,
-
-  -- * Lists
-  ppList,
-  ppListC,
-
-  -- * General helpers
-  prettyType,
-  vsep',
-  (/>),
-  showType,
-  short,
-) where
-
-import Constrained.List
-import Data.String (fromString)
-import Data.Typeable
-import Prettyprinter
-
--- | Wrapper for pretty-printing with precendence. To get precedence
--- pretty-printing implement an instance of @`Pretty` (t`WithPrec` YourType)@ so
--- that you can use `prettyPrec`.
-data WithPrec a = WithPrec Int a
-
--- | Pretty-print with precedence
-prettyPrec :: Pretty (WithPrec a) => Int -> a -> Doc ann
-prettyPrec p = pretty . WithPrec p
-
--- | Wrap a term in @( .. )@ if the first argument is `True`. Useful
--- in combination with t`WithPrec`
-parensIf :: Bool -> Doc ann -> Doc ann
-parensIf True = parens
-parensIf False = id
-
--- | Map a pretty-printer for elements over a `List`
-ppList :: forall f as ann. (forall a. f a -> Doc ann) -> List f as -> [Doc ann]
-ppList _ Nil = []
-ppList pp (a :> as) = pp a : ppList pp as
-
--- | Like `ppList` for a constrained pretty-printer
-ppListC ::
-  forall c f as ann. All c as => (forall a. c a => f a -> Doc ann) -> List f as -> [Doc ann]
-ppListC _ Nil = []
-ppListC pp (a :> as) = pp a : ppListC @c pp as
-
--- | Pretty-print a type
-prettyType :: forall t x. Typeable t => Doc x
-prettyType = fromString $ show (typeRep (Proxy @t))
-
--- | Separate documents by a hardline and align them
-vsep' :: [Doc ann] -> Doc ann
-vsep' = align . mconcat . punctuate hardline
-
--- | Lay the header (first argument) out before the body
--- and if it overflows the line indent the body by 2
-(/>) :: Doc ann -> Doc ann -> Doc ann
-h /> cont = hang 2 $ sep [h, align cont]
-
-infixl 5 />
-
--- | Show a `Typeable` thing's type
-showType :: forall t. Typeable t => String
-showType = show (typeRep (Proxy @t))
-
--- | Pretty-print a short list in full and truncate longer lists
-short :: forall a x. (Show a, Typeable a) => [a] -> Doc x
-short [] = "[]"
-short [x] =
-  let raw = show x
-      refined = if length raw <= 20 then raw else take 20 raw ++ " ... "
-   in "[" <+> fromString refined <+> "]"
-short xs =
-  let raw = show xs
-   in if length raw <= 50
-        then fromString raw
-        else "([" <+> viaShow (length xs) <+> "elements ...] @" <> prettyType @a <> ")"
diff --git a/libs/constrained-generators/src/Constrained/Properties.hs b/libs/constrained-generators/src/Constrained/Properties.hs
deleted file mode 100644
index 6b44c38877f..00000000000
--- a/libs/constrained-generators/src/Constrained/Properties.hs
+++ /dev/null
@@ -1,47 +0,0 @@
-{-# LANGUAGE ExistentialQuantification #-}
-{-# LANGUAGE TypeApplications #-}
-
--- | Useful of helpers for writing properties with constrained generators
-module Constrained.Properties (
-  conformsToSpecProp,
-  forAllSpec,
-  forAllSpecShow,
-  forAllSpecDiscard,
-) where
-
-import Constrained.Base
-import Constrained.Conformance
-import Constrained.GenT
-import Constrained.Generation
-import qualified Data.List.NonEmpty as NE
-import qualified Test.QuickCheck as QC
-
--- | Like @Constrained.Conformance.conformsToSpec@ but in @Test.QuickCheck.Property@ form.
-conformsToSpecProp :: forall a. HasSpec a => a -> Specification a -> QC.Property
-conformsToSpecProp a s = case conformsToSpecE a (simplifySpec s) (pure "call to conformsToSpecProp") of
-  Nothing -> QC.property True
-  Just msgs -> QC.counterexample (unlines (NE.toList msgs)) False
-
--- | Quanitfy over a @Constrained.Base.Specification@.
-forAllSpec :: (HasSpec a, QC.Testable p) => Specification a -> (a -> p) -> QC.Property
-forAllSpec spec prop = forAllSpecShow spec show prop
-
--- | Like `forAllSpec` with a custom way of printing values
-forAllSpecShow ::
-  (HasSpec a, QC.Testable p) => Specification a -> (a -> String) -> (a -> p) -> QC.Property
-forAllSpecShow spec pp prop =
-  let sspec = simplifySpec spec
-   in QC.forAllShrinkShow (genFromSpec sspec) (shrinkWithSpec sspec) pp $ \a ->
-        monitorSpec spec a $ prop a
-
--- | Quanitfy over a @Constrained.Base.Specification@ and discard any test where generation fails.
-forAllSpecDiscard :: (HasSpec a, QC.Testable p) => Specification a -> (a -> p) -> QC.Property
-forAllSpecDiscard spec prop =
-  let sspec = simplifySpec spec
-   in QC.forAllShrinkBlind
-        (strictGen $ genFromSpecT @_ @GE sspec)
-        (map pure . shrinkWithSpec sspec . errorGE)
-        $ \ge ->
-          fromGEDiscard $ do
-            a <- ge
-            pure $ QC.counterexample (show a) $ prop a
diff --git a/libs/constrained-generators/src/Constrained/Spec/List.hs b/libs/constrained-generators/src/Constrained/Spec/List.hs
deleted file mode 100644
index 40253913203..00000000000
--- a/libs/constrained-generators/src/Constrained/Spec/List.hs
+++ /dev/null
@@ -1,643 +0,0 @@
-{-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DefaultSignatures #-}
-{-# LANGUAGE ExistentialQuantification #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE KindSignatures #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE PatternSynonyms #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE UndecidableSuperClasses #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# OPTIONS_GHC -Wno-orphans #-}
-
--- | `TypeSpec` definition for `[]` and functions for writing constraints over
--- lists
-module Constrained.Spec.List (
-  ListSpec (..),
-  ListW (..),
-  ElemW (..),
-  pattern Elem,
-
-  -- * Functions for writing constraints on lists
-  append_,
-  singletonList_,
-  elem_,
-  sum_,
-  foldMap_,
-
-  -- * FoldSpec and Foldy definitions and helper functions
-  Foldy (..),
-  FoldSpec (..),
-  preMapFoldSpec,
-  toPredsFoldSpec,
-  adds,
-  conformsToFoldSpec,
-  combineFoldSpec,
-) where
-
-import Constrained.AbstractSyntax
-import Constrained.Base
-import Constrained.Conformance
-import Constrained.Core
-import Constrained.FunctionSymbol
-import Constrained.GenT
-import Constrained.Generation
-import Constrained.Generic
-import Constrained.List
-import Constrained.NumOrd
-import Constrained.PrettyUtils
-import Constrained.SumList
-import Constrained.Syntax
-import Constrained.TheKnot
-import Control.Applicative
-import Control.Monad
-import Data.Foldable
-import Data.Int
-import Data.Kind
-import Data.List (isPrefixOf, isSuffixOf, nub, (\\))
-import qualified Data.List.NonEmpty as NE
-import Data.Maybe
-import Data.String
-import Data.Typeable
-import Data.Word
-import GHC.Natural
-import GHC.Stack
-import Prettyprinter hiding (cat)
-import Test.QuickCheck hiding (Args, Fun, Witness, forAll, witness)
-import Prelude hiding (cycle, pred)
-
--- | `TypeSpec` for `[]`
-data ListSpec a = ListSpec
-  { listSpecHint :: Maybe Integer
-  -- ^ Hint for the length of the list
-  , listSpecMust :: [a]
-  -- ^ Things that must be in the list
-  , listSpecSize :: Specification Integer
-  -- ^ Spec for the size of the list
-  , listSpecElem :: Specification a
-  -- ^ Spec for every element
-  , listSpecFold :: FoldSpec a
-  -- ^ Spec for the sum (or fold) of the list
-  }
-
-instance HasSpec a => Show (FoldSpec a) where
-  showsPrec d = shows . prettyPrec d
-
-instance HasSpec a => Pretty (WithPrec (FoldSpec a)) where
-  pretty (WithPrec _ NoFold) = "NoFold"
-  pretty (WithPrec d (FoldSpec fun s)) =
-    parensIf (d > 10) $
-      "FoldSpec"
-        /> vsep'
-          [ "fn   =" <+> viaShow fun
-          , "spec =" <+> pretty s
-          ]
-
-instance HasSpec a => Pretty (FoldSpec a) where
-  pretty = prettyPrec 0
-
-instance HasSpec a => Show (ListSpec a) where
-  showsPrec d = shows . prettyPrec d
-
-instance
-  HasSpec a =>
-  Pretty (WithPrec (ListSpec a))
-  where
-  pretty (WithPrec d s) =
-    parensIf (d > 10) $
-      "ListSpec"
-        /> vsep'
-          [ "hint =" <+> viaShow (listSpecHint s)
-          , "must =" <+> viaShow (listSpecMust s)
-          , "size =" <+> pretty (listSpecSize s)
-          , "elem =" <+> pretty (listSpecElem s)
-          , "fold =" <+> pretty (listSpecFold s)
-          ]
-
-instance HasSpec a => Pretty (ListSpec a) where
-  pretty = prettyPrec 0
-
-guardListSpec :: HasSpec a => [String] -> ListSpec a -> Specification [a]
-guardListSpec msg l@(ListSpec _hint must size elemS _fold)
-  | ErrorSpec es <- size = ErrorSpec $ (NE.fromList ("Error in size of ListSpec" : msg)) <> es
-  | Just u <- knownUpperBound size
-  , u < 0 =
-      ErrorSpec $ NE.fromList (["Negative size in guardListSpec", show size] ++ msg)
-  | not (all (`conformsToSpec` elemS) must) =
-      ErrorSpec $
-        ( NE.fromList
-            (["Some items in the must list do not conform to 'element' spec.", "   " ++ show elemS] ++ msg)
-        )
-  | otherwise = (typeSpec l)
-
--- | Witness type for `elem_`
-data ElemW :: [Type] -> Type -> Type where
-  ElemW :: HasSpec a => ElemW '[a, [a]] Bool
-
-deriving instance Eq (ElemW dom rng)
-
-instance Show (ElemW dom rng) where
-  show ElemW = "elem_"
-
-instance Syntax ElemW
-
-instance Semantics ElemW where
-  semantics ElemW = elem
-
-instance Logic ElemW where
-  propagate f ctxt (ExplainSpec es s) = explainSpec es $ propagate f ctxt s
-  propagate _ _ TrueSpec = TrueSpec
-  propagate _ _ (ErrorSpec msgs) = ErrorSpec msgs
-  propagate ElemW (HOLE :<: (x :: [w])) (SuspendedSpec v ps) =
-    constrained $ \v' -> Let (App ElemW ((v' :: Term w) :> Lit x :> Nil)) (v :-> ps)
-  propagate ElemW (x :>: HOLE) (SuspendedSpec v ps) =
-    constrained $ \v' -> Let (App ElemW (Lit x :> v' :> Nil)) (v :-> ps)
-  propagate ElemW (HOLE :<: es) spec =
-    caseBoolSpec spec $ \case
-      True -> memberSpec (nub es) (pure "propagate on (elem_ x []), The empty list, [], has no solution")
-      False -> notMemberSpec es
-  propagate ElemW (e :>: HOLE) spec =
-    caseBoolSpec spec $ \case
-      True -> typeSpec (ListSpec Nothing [e] mempty mempty NoFold)
-      False -> typeSpec (ListSpec Nothing mempty mempty (notEqualSpec e) NoFold)
-
-  rewriteRules ElemW (_ :> Lit [] :> Nil) Evidence = Just $ Lit False
-  rewriteRules ElemW (t :> Lit [a] :> Nil) Evidence = Just $ t ==. (Lit a)
-  rewriteRules _ _ _ = Nothing
-
-  saturate ElemW ((FromGeneric (Product (x :: Term a) (y :: Term b)) :: Term c) :> Lit zs :> Nil)
-    | Just Refl <- eqT @c @(a, b) = case zs of
-        (w : ws) -> [ElemPred True x (fmap fst (w :| ws))]
-        [] -> [FalsePred (pure $ "empty list, zs , in elem_ " ++ show (x, y) ++ " zs")]
-    | otherwise = []
-  saturate ElemW (x :> Lit (y : ys) :> Nil) = [satisfies x (MemberSpec (y :| ys))]
-  saturate _ _ = []
-
-infix 4 `elem_`
-
--- | Check if a term is an element of the list
-elem_ :: HasSpec a => Term a -> Term [a] -> Term Bool
-elem_ = appTerm ElemW
-
--- | Pattern for extracting the v`ElemW` symbol, useful for writing custom
--- rewrite rules for functions that deal with lists
-pattern Elem ::
-  forall b.
-  () =>
-  forall a.
-  (b ~ Bool, Eq a, HasSpec a) =>
-  Term a ->
-  Term [a] ->
-  Term b
-pattern Elem x y <-
-  ( App
-      (getWitness -> Just ElemW)
-      (x :> y :> Nil)
-    )
-
-instance HasSpec a => HasSpec [a] where
-  type TypeSpec [a] = ListSpec a
-  type Prerequisites [a] = HasSpec a
-  emptySpec = ListSpec Nothing [] mempty mempty NoFold
-  combineSpec l1@(ListSpec msz must size elemS foldS) l2@(ListSpec msz' must' size' elemS' foldS') =
-    let must'' = nub $ must <> must'
-        elemS'' = elemS <> elemS'
-        size'' = size <> size'
-        foldeither = combineFoldSpec foldS foldS'
-        msg = ["Error in combineSpec for ListSpec", "1) " ++ show l1, "2) " ++ show l2]
-     in case foldeither of
-          Left foldmsg -> ErrorSpec (NE.fromList (msg ++ foldmsg))
-          Right fold'' -> guardListSpec msg $ ListSpec (unionWithMaybe min msz msz') must'' size'' elemS'' fold''
-
-  genFromTypeSpec (ListSpec _ must _ elemS _)
-    | any (not . (`conformsToSpec` elemS)) must =
-        genError "genTypeSpecSpec @ListSpec: some elements of mustSet do not conform to elemS"
-  genFromTypeSpec (ListSpec msz must TrueSpec elemS NoFold) = do
-    lst <- case msz of
-      Nothing -> listOfT $ genFromSpecT elemS
-      Just szHint -> do
-        sz <- genFromSizeSpec (leqSpec szHint)
-        listOfUntilLenT (genFromSpecT elemS) (fromIntegral sz) (const True)
-    pureGen $ shuffle (must ++ lst)
-  genFromTypeSpec (ListSpec msz must szSpec elemS NoFold) = do
-    sz0 <- genFromSizeSpec (szSpec <> geqSpec (sizeOf must) <> maybe TrueSpec (leqSpec . max 0) msz)
-    let sz = fromIntegral (sz0 - sizeOf must)
-    lst <-
-      listOfUntilLenT
-        (genFromSpecT elemS)
-        sz
-        ((`conformsToSpec` szSpec) . (+ sizeOf must) . fromIntegral)
-    pureGen $ shuffle (must ++ lst)
-  genFromTypeSpec (ListSpec msz must szSpec elemS (FoldSpec f foldS)) = do
-    let szSpec' = szSpec <> maybe TrueSpec (leqSpec . max 0) msz
-    genFromFold must szSpec' elemS f foldS
-
-  shrinkWithTypeSpec (ListSpec _ _ _ es _) as =
-    shrinkList (shrinkWithSpec es) as
-
-  cardinalTypeSpec _ = TrueSpec
-
-  guardTypeSpec = guardListSpec
-
-  conformsTo xs (ListSpec _ must size elemS foldS) =
-    sizeOf xs
-      `conformsToSpec` size
-      && all (`elem` xs) must
-      && all (`conformsToSpec` elemS) xs
-      && xs
-        `conformsToFoldSpec` foldS
-
-  toPreds x (ListSpec msz must size elemS foldS) =
-    (forAll x $ \x' -> satisfies x' elemS)
-      <> (forAll (Lit must) $ \x' -> Assert (elem_ x' x))
-      <> toPredsFoldSpec x foldS
-      <> satisfies (sizeOf_ x) size
-      <> maybe TruePred (flip genHint x) msz
-
-instance HasSpec a => HasGenHint [a] where
-  type Hint [a] = Integer
-  giveHint szHint = typeSpec $ ListSpec (Just szHint) [] mempty mempty NoFold
-
-instance Forallable [a] a where
-  fromForAllSpec es = typeSpec (ListSpec Nothing [] mempty es NoFold)
-  forAllToList = id
-
-instance Logic ListW where
-  propagateTypeSpec (FoldMapW f) (Unary HOLE) ts cant =
-    typeSpec (ListSpec Nothing [] TrueSpec TrueSpec $ FoldSpec f (TypeSpec ts cant))
-  propagateTypeSpec SingletonListW (Unary HOLE) (ListSpec _ m sz e f) cant
-    | length m > 1 =
-        ErrorSpec $
-          NE.fromList
-            [ "Too many required elements for SingletonListW : "
-            , "  " ++ show m
-            ]
-    | not $ 1 `conformsToSpec` sz =
-        ErrorSpec $ pure $ "Size spec requires too many elements for SingletonListW : " ++ show sz
-    | bad@(_ : _) <- filter (not . (`conformsToSpec` e)) m =
-        ErrorSpec $
-          NE.fromList
-            [ "The following elements of the must spec do not conforms to the elem spec:"
-            , show bad
-            ]
-    -- There is precisely one required element in the final list, so the argument to singletonList_ has to
-    -- be that element and we have to respect the cant and fold specs
-    | [a] <- m = equalSpec a <> notMemberSpec [z | [z] <- cant] <> reverseFoldSpec f
-    -- We have to respect the elem-spec, the can't spec, and the fold spec.
-    | otherwise = e <> notMemberSpec [a | [a] <- cant] <> reverseFoldSpec f
-  propagateTypeSpec AppendW ctx (ts@ListSpec {listSpecElem = e}) cant
-    | (HOLE :? Value (ys :: [a]) :> Nil) <- ctx
-    , Evidence <- prerequisites @[a]
-    , all (`conformsToSpec` e) ys =
-        TypeSpec (alreadyHave ys ts) (suffixedBy ys cant)
-    | (Value (ys :: [a]) :! Unary HOLE) <- ctx
-    , Evidence <- prerequisites @[a]
-    , all (`conformsToSpec` e) ys =
-        TypeSpec (alreadyHave ys ts) (prefixedBy ys cant)
-    | otherwise = ErrorSpec $ pure "The spec given to propagate for AppendW is inconsistent!"
-
-  propagateMemberSpec (FoldMapW f) (Unary HOLE) es =
-    typeSpec (ListSpec Nothing [] TrueSpec TrueSpec $ FoldSpec f (MemberSpec es))
-  propagateMemberSpec SingletonListW (Unary HOLE) xss =
-    case [a | [a] <- NE.toList xss] of
-      [] ->
-        ErrorSpec $ (pure "PropagateSpec SingletonListW  with MemberSpec which has no lists of length 1")
-      (x : xs) -> MemberSpec (x :| xs)
-  propagateMemberSpec AppendW ctx xss
-    | (HOLE :<: (ys :: [a])) <- ctx
-    , Evidence <- prerequisites @[a] =
-        -- Only keep the prefixes of the elements of xss that can
-        -- give you the correct resulting list
-        case suffixedBy ys (NE.toList xss) of
-          [] ->
-            ErrorSpec
-              ( NE.fromList
-                  [ "propagateSpecFun (append HOLE ys) with (MemberSpec xss)"
-                  , "there are no elements in xss with suffix ys"
-                  ]
-              )
-          (x : xs) -> MemberSpec (x :| xs)
-    | ((ys :: [a]) :>: HOLE) <- ctx
-    , Evidence <- prerequisites @[a] =
-        -- Only keep the suffixes of the elements of xss that can
-        -- give you the correct resulting list
-        case prefixedBy ys (NE.toList xss) of
-          [] ->
-            ErrorSpec
-              ( NE.fromList
-                  [ "propagateSpecFun (append ys HOLE) with (MemberSpec xss)"
-                  , "there are no elements in xss with prefix ys"
-                  ]
-              )
-          (x : xs) -> MemberSpec (x :| xs)
-
-  mapTypeSpec SingletonListW ts = typeSpec (ListSpec Nothing [] (equalSpec 1) (typeSpec ts) NoFold)
-  mapTypeSpec (FoldMapW g) ts =
-    constrained $ \x ->
-      unsafeExists $ \x' ->
-        Assert (x ==. appFun (foldMapFn g) x') <> toPreds x' ts
-
--- | Function symbols for talking about lists
-data ListW (args :: [Type]) (res :: Type) where
-  FoldMapW :: forall a b. (Foldy b, HasSpec a) => Fun '[a] b -> ListW '[[a]] b
-  SingletonListW :: HasSpec a => ListW '[a] [a]
-  AppendW :: (HasSpec a, Typeable a, Show a) => ListW '[[a], [a]] [a]
-
-instance Semantics ListW where
-  semantics (FoldMapW (Fun f)) = adds . map (semantics f)
-  semantics SingletonListW = (: [])
-  semantics AppendW = (++)
-
-instance Syntax ListW where
-  prettySymbol AppendW (Lit n :> y :> Nil) p = Just $ parensIf (p > 10) $ "append_" <+> short n <+> prettyPrec 10 y
-  prettySymbol AppendW (y :> Lit n :> Nil) p = Just $ parensIf (p > 10) $ "append_" <+> prettyPrec 10 y <+> short n
-  prettySymbol _ _ _ = Nothing
-
-instance Show (ListW d r) where
-  show AppendW = "append_"
-  show SingletonListW = "singletonList_"
-  show (FoldMapW n) = "(FoldMapW  " ++ show n ++ ")"
-
-deriving instance (Eq (ListW d r))
-
-------------------------------------------------------------------------
--- Functions for writing constraints on lists
-------------------------------------------------------------------------
-
--- | Sum over a `Foldy` list
-sum_ ::
-  Foldy a =>
-  Term [a] ->
-  Term a
-sum_ = foldMap_ id
-
--- | Like @[a]@
-singletonList_ :: HasSpec a => Term a -> Term [a]
-singletonList_ = appTerm SingletonListW
-
--- | Append two lists, like `(++)`
-append_ :: HasSpec a => Term [a] -> Term [a] -> Term [a]
-append_ = appTerm AppendW
-
--- | Map a function over a list and fold the results via the `Foldy` instance
-foldMap_ :: forall a b. (Foldy b, HasSpec a) => (Term a -> Term b) -> Term [a] -> Term b
-foldMap_ f = appFun $ foldMapFn $ toFn $ f (V v)
-  where
-    v = Var (-1) "v" :: Var a
-    -- Turn `f (V v) = fn (gn (hn v))` into `composeFn fn (composeFn gn hn)`
-    -- Note: composeFn :: HasSpec b => Fun '[b] c -> Fun '[a] b -> Fun '[a] c
-    toFn :: forall x. HasCallStack => Term x -> Fun '[a] x
-    toFn (App fn (V v' :> Nil)) | Just Refl <- eqVar v v' = Fun fn
-    toFn (App fn (t :> Nil)) = composeFn (Fun fn) (toFn t)
-    toFn (V v') | Just Refl <- eqVar v v' = idFn
-    toFn _ = error "foldMap_ has not been given a function of the form \\ x -> f (g ... (h x))"
-
--- Fun types for lists and their helper functions
-
-foldMapFn :: forall a b. (HasSpec a, Foldy b) => Fun '[a] b -> Fun '[[a]] b
-foldMapFn f = Fun (FoldMapW f)
-
-reverseFoldSpec :: FoldSpec a -> Specification a
-reverseFoldSpec NoFold = TrueSpec
--- The single element list has to sum to something that obeys spec, i.e. `conformsToSpec (f a) spec`
-reverseFoldSpec (FoldSpec (Fun fn) spec) = propagate fn (HOLE :? Nil) spec
-
-prefixedBy :: Eq a => [a] -> [[a]] -> [[a]]
-prefixedBy ys xss = [drop (length ys) xs | xs <- xss, ys `isPrefixOf` xs]
-
-suffixedBy :: Eq a => [a] -> [[a]] -> [[a]]
-suffixedBy ys xss = [take (length xs - length ys) xs | xs <- xss, ys `isSuffixOf` xs]
-
-alreadyHave :: Eq a => [a] -> ListSpec a -> ListSpec a
-alreadyHave ys (ListSpec h m sz e f) =
-  ListSpec
-    -- Reduce the hint
-    (fmap (subtract (sizeOf ys)) h)
-    -- The things in `ys` have already been added to the list, no need to
-    -- require them too
-    (m \\ ys)
-    -- Reduce the required size
-    (constrained $ \x -> (x + Lit (sizeOf ys)) `satisfies` sz)
-    -- Nothing changes about what's a correct element
-    e
-    -- we have fewer things to sum now
-    (alreadyHaveFold ys f)
-
-alreadyHaveFold :: [a] -> FoldSpec a -> FoldSpec a
-alreadyHaveFold _ NoFold = NoFold
-alreadyHaveFold ys (FoldSpec fn spec) =
-  FoldSpec
-    fn
-    (constrained $ \s -> appTerm theAddFn s (foldMap_ (appFun fn) (Lit ys)) `satisfies` spec)
-
--- | Used in the HasSpec [a] instance
-toPredsFoldSpec :: HasSpec a => Term [a] -> FoldSpec a -> Pred
-toPredsFoldSpec _ NoFold = TruePred
-toPredsFoldSpec x (FoldSpec funAB sspec) =
-  satisfies (appFun (foldMapFn funAB) x) sspec
-
--- =======================================================
--- FoldSpec is a Spec that appears inside of ListSpec
-
--- | Specification for how a thing sums together, used to represent `foldMap_`-related constraints
-data FoldSpec a where
-  NoFold :: FoldSpec a
-  FoldSpec ::
-    forall b a.
-    ( HasSpec a
-    , HasSpec b
-    , Foldy b
-    ) =>
-    Fun '[a] b ->
-    Specification b ->
-    FoldSpec a
-
--- | Take a `FoldSpec` and turn it into a `FoldSpec` for a function applied
--- before the original spec
-preMapFoldSpec :: HasSpec a => Fun '[a] b -> FoldSpec b -> FoldSpec a
-preMapFoldSpec _ NoFold = NoFold
-preMapFoldSpec f (FoldSpec g s) = FoldSpec (composeFn g f) s
-
-composeFn :: (HasSpec b, HasSpec c) => Fun '[b] c -> Fun '[a] b -> Fun '[a] c
-composeFn (Fun f) (Fun g) = (Fun (ComposeW f g))
-
-idFn :: HasSpec a => Fun '[a] a
-idFn = Fun IdW
-
--- | Possibly failing conjuction of `FoldSpec`s
-combineFoldSpec :: FoldSpec a -> FoldSpec a -> Either [String] (FoldSpec a)
-combineFoldSpec NoFold s = pure s
-combineFoldSpec s NoFold = pure s
-combineFoldSpec (FoldSpec (Fun f) s) (FoldSpec (Fun g) s') =
-  case sameFunSym f g of
-    Just (_, _, Refl) -> pure $ FoldSpec (Fun f) (s <> s')
-    Nothing -> Left ["Can't combine fold specs on different functions", "  " ++ show f, "  " ++ show g]
-
--- | Check if a list sums like what's required by a `FoldSpec`
-conformsToFoldSpec :: forall a. [a] -> FoldSpec a -> Bool
-conformsToFoldSpec _ NoFold = True
-conformsToFoldSpec xs (FoldSpec (Fun f) s) = adds (map (semantics f) xs) `conformsToSpec` s
-
--- | Talk about how to add together values and generate lists of values that
--- conform to `FoldSpec`s
-class (HasSpec a, NumLike a) => Foldy a where
-  genList ::
-    MonadGenError m => Specification a -> Specification a -> GenT m [a]
-  default genList ::
-    (MonadGenError m, GenericallyInstantiated a, Foldy (SimpleRep a)) =>
-    Specification a -> Specification a -> GenT m [a]
-  genList s s' = map fromSimpleRep <$> genList (toSimpleRepSpec s) (toSimpleRepSpec s')
-
-  theAddFn :: IntW '[a, a] a
-  theAddFn = AddW
-
-  theZero :: a
-  theZero = 0
-
-  genSizedList ::
-    MonadGenError m =>
-    Specification Integer ->
-    Specification a ->
-    Specification a ->
-    GenT m [a]
-  default genSizedList ::
-    (MonadGenError m, GenericallyInstantiated a, Foldy (SimpleRep a)) =>
-    Specification Integer ->
-    Specification a ->
-    Specification a ->
-    GenT m [a]
-  genSizedList sz elemSpec foldSpec =
-    map fromSimpleRep
-      <$> genSizedList sz (toSimpleRepSpec elemSpec) (toSimpleRepSpec foldSpec)
-
-  noNegativeValues :: Bool
-  noNegativeValues = False
-
--- | Semantics of `foldMap_`
-adds :: Foldy a => [a] -> a
-adds = foldr (semantics theAddFn) theZero
-
-------------------------------------------------------------------------
--- Foldy instances
-------------------------------------------------------------------------
-
-instance Foldy Integer where
-  genList = genNumList
-  genSizedList = genListWithSize
-
-instance Foldy Int where
-  genList = genNumList
-  genSizedList = genListWithSize
-
-instance Foldy Int8 where
-  genList = genNumList
-  genSizedList = genListWithSize
-
-instance Foldy Int16 where
-  genList = genNumList
-  genSizedList = genListWithSize
-
-instance Foldy Int32 where
-  genList = genNumList
-  genSizedList = genListWithSize
-
-instance Foldy Int64 where
-  genList = genNumList
-  genSizedList = genListWithSize
-
-instance Foldy Natural where
-  noNegativeValues = True
-  genList = genNumList
-  genSizedList = genListWithSize
-
-instance Foldy Word8 where
-  noNegativeValues = True
-  genList = genNumList
-  genSizedList = genListWithSize
-
-instance Foldy Word16 where
-  noNegativeValues = True
-  genList = genNumList
-  genSizedList = genListWithSize
-
-instance Foldy Word32 where
-  noNegativeValues = True
-  genList = genNumList
-  genSizedList = genListWithSize
-
-instance Foldy Word64 where
-  noNegativeValues = True
-  genList = genNumList
-  genSizedList = genListWithSize
-
-genFromFold ::
-  forall m a b.
-  ( MonadGenError m
-  , Foldy b
-  , HasSpec a
-  ) =>
-  [a] ->
-  Specification Integer ->
-  Specification a ->
-  Fun '[a] b ->
-  Specification b ->
-  GenT m [a]
-genFromFold must (simplifySpec -> size) elemS fun@(Fun fn) foldS
-  | isErrorLike size =
-      fatalErrorNE (NE.cons "genFromFold has ErrorLike sizeSpec" (errorLikeMessage size))
-  | isErrorLike elemS =
-      fatalErrorNE (NE.cons "genFromFold has ErrorLike elemSpec" (errorLikeMessage elemS))
-  | isErrorLike foldS =
-      fatalErrorNE (NE.cons "genFromFold has ErrorLike totalSpec" (errorLikeMessage foldS))
-  | otherwise = ( explainNE
-                    ( NE.fromList
-                        [ "while calling genFromFold"
-                        , "  must  = " ++ show must
-                        , "  size  = " ++ show size
-                        , "  elemS = " ++ show elemS
-                        , "  fun   = " ++ show fun
-                        , "  foldS = " ++ show foldS
-                        ]
-                    )
-                )
-      $ do
-        let elemS' :: Specification b
-            elemS' = mapSpec fn elemS
-            mustVal = adds (map (semantics fn) must)
-            foldS' :: Specification b
-            foldS' = propagate theAddFn (HOLE :? Value mustVal :> Nil) foldS
-            sizeSpec' :: Specification Integer
-            sizeSpec' = propagate AddW (HOLE :? Value (sizeOf must) :> Nil) size
-        when (isErrorLike sizeSpec') $ genError "Inconsistent size spec"
-        results0 <- case sizeSpec' of
-          TrueSpec -> genList (simplifySpec elemS') (simplifySpec foldS')
-          _ -> genSizedList sizeSpec' (simplifySpec elemS') (simplifySpec foldS')
-        results <-
-          explainNE
-            ( NE.fromList
-                [ "genInverse"
-                , "  fun = " ++ show fun
-                , "  results0 = " ++ show results0
-                , show $ "  elemS' =" <+> pretty elemS'
-                ]
-            )
-            $ mapM (genInverse fun elemS) results0
-        pureGen $ shuffle $ must ++ results
-
-instance Sized [a] where
-  sizeOf = toInteger . length
-  liftSizeSpec spec cant = typeSpec (ListSpec Nothing mempty (TypeSpec spec cant) TrueSpec NoFold)
-  liftMemberSpec xs = case NE.nonEmpty xs of
-    Nothing -> ErrorSpec (pure ("In liftMemberSpec for (Sized List) instance, xs is the empty list"))
-    Just zs -> typeSpec (ListSpec Nothing mempty (MemberSpec zs) TrueSpec NoFold)
-  sizeOfTypeSpec (ListSpec _ _ _ ErrorSpec {} _) = equalSpec 0
-  sizeOfTypeSpec (ListSpec _ must sizespec _ _) = sizespec <> geqSpec (sizeOf must)
diff --git a/libs/constrained-generators/src/Constrained/Spec/Map.hs b/libs/constrained-generators/src/Constrained/Spec/Map.hs
deleted file mode 100644
index 8d3a91cfff2..00000000000
--- a/libs/constrained-generators/src/Constrained/Spec/Map.hs
+++ /dev/null
@@ -1,411 +0,0 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# OPTIONS_GHC -Wno-orphans #-}
-
--- | `HasSpec` instance for `Map` and functions for working with `Map`s
-module Constrained.Spec.Map (
-  MapSpec (..),
-  defaultMapSpec,
-  MapW (..),
-  lookup_,
-  mapMember_,
-  dom_,
-  rng_,
-) where
-
-import Constrained.AbstractSyntax
-import Constrained.Base
-import Constrained.Conformance
-import Constrained.Core
-import Constrained.FunctionSymbol
-import Constrained.GenT
-import Constrained.Generation
-import Constrained.Generic (Prod (..))
-import Constrained.List
-import Constrained.NumOrd (cardinality, geqSpec, leqSpec, nubOrd)
-import Constrained.PrettyUtils
-import Constrained.Spec.List
-import Constrained.Spec.Set
-import Constrained.Spec.SumProd
-import Constrained.Syntax
-import Constrained.TheKnot
-import Control.Monad
-import Data.Foldable
-import Data.Kind
-import Data.List (nub)
-import qualified Data.List.NonEmpty as NE
-import Data.Map (Map)
-import qualified Data.Map as Map
-import Data.Set (Set)
-import qualified Data.Set as Set
-import GHC.Generics
-import Prettyprinter
-import Test.QuickCheck hiding (Fun, Witness, forAll)
-
-------------------------------------------------------------------------
--- HasSpec
-------------------------------------------------------------------------
-
-instance Ord a => Sized (Map.Map a b) where
-  sizeOf = toInteger . Map.size
-  liftSizeSpec sz cant = typeSpec $ defaultMapSpec {mapSpecSize = TypeSpec sz cant}
-  liftMemberSpec xs = case NE.nonEmpty (nubOrd xs) of
-    Nothing -> ErrorSpec (pure "In liftMemberSpec for the (Sized Map) instance, xs is the empty list")
-    Just ys -> typeSpec $ defaultMapSpec {mapSpecSize = MemberSpec ys}
-  sizeOfTypeSpec (MapSpec _ mustk mustv size _ _) =
-    geqSpec (sizeOf mustk)
-      <> geqSpec (sizeOf mustv)
-      <> size
-
--- | Custom `TypeSpec` for `Map`
-data MapSpec k v = MapSpec
-  { mapSpecHint :: Maybe Integer
-  , mapSpecMustKeys :: Set k
-  , mapSpecMustValues :: [v]
-  , mapSpecSize :: Specification Integer
-  , mapSpecElem :: Specification (k, v)
-  , mapSpecFold :: FoldSpec v
-  }
-  deriving (Generic)
-
--- | emptySpec without all the constraints
-defaultMapSpec :: Ord k => MapSpec k v
-defaultMapSpec = MapSpec Nothing mempty mempty TrueSpec TrueSpec NoFold
-
-instance
-  ( HasSpec (k, v)
-  , HasSpec k
-  , HasSpec v
-  , HasSpec [v]
-  ) =>
-  Pretty (WithPrec (MapSpec k v))
-  where
-  pretty (WithPrec d s) =
-    parensIf (d > 10) $
-      "MapSpec"
-        /> vsep
-          [ "hint       =" <+> viaShow (mapSpecHint s)
-          , "mustKeys   =" <+> viaShow (mapSpecMustKeys s)
-          , "mustValues =" <+> viaShow (mapSpecMustValues s)
-          , "size       =" <+> pretty (mapSpecSize s)
-          , "elem       =" <+> pretty (mapSpecElem s)
-          , "fold       =" <+> pretty (mapSpecFold s)
-          ]
-
-instance
-  ( HasSpec (k, v)
-  , HasSpec k
-  , HasSpec v
-  , HasSpec [v]
-  ) =>
-  Show (MapSpec k v)
-  where
-  showsPrec d = shows . prettyPrec d
-
-instance Ord k => Forallable (Map k v) (k, v) where
-  fromForAllSpec kvs = typeSpec $ defaultMapSpec {mapSpecElem = kvs}
-  forAllToList = Map.toList
-
--- ============================================================
--- We will need to take projections on (Specification (a,b))
-
-fstSpec :: forall k v. (HasSpec k, HasSpec v) => Specification (k, v) -> Specification k
-fstSpec s = mapSpec ProdFstW (mapSpec ToGenericW s)
-
-sndSpec :: forall k v. (HasSpec k, HasSpec v) => Specification (k, v) -> Specification v
-sndSpec s = mapSpec ProdSndW (mapSpec ToGenericW s)
-
--- ======================================================================
--- The HasSpec instance for Maps
-
-instance
-  (Ord k, HasSpec (Prod k v), HasSpec k, HasSpec v, HasSpec [v], IsNormalType k, IsNormalType v) =>
-  HasSpec (Map k v)
-  where
-  type TypeSpec (Map k v) = MapSpec k v
-  type Prerequisites (Map k v) = (HasSpec k, HasSpec v)
-
-  emptySpec = defaultMapSpec
-
-  combineSpec
-    (MapSpec mHint mustKeys mustVals size kvs foldSpec)
-    (MapSpec mHint' mustKeys' mustVals' size' kvs' foldSpec') = case combineFoldSpec foldSpec foldSpec' of
-      Left msgs ->
-        ErrorSpec $
-          NE.fromList $
-            [ "Error in combining FoldSpec in combineSpec for Map"
-            , "  " ++ show foldSpec
-            , "  " ++ show foldSpec'
-            ]
-              ++ msgs
-      Right foldSpec'' ->
-        typeSpec $
-          MapSpec
-            -- This is min because that allows more compositionality - if a spec specifies a
-            -- low upper bound because some part of the spec will be slow it doesn't make sense
-            -- to increase it somewhere else because that part isn't slow.
-            (unionWithMaybe min mHint mHint')
-            (mustKeys <> mustKeys')
-            (nub $ mustVals <> mustVals')
-            (size <> size')
-            (kvs <> kvs')
-            foldSpec''
-
-  conformsTo m (MapSpec _ mustKeys mustVals size kvs foldSpec) =
-    and
-      [ mustKeys `Set.isSubsetOf` Map.keysSet m
-      , all (`elem` Map.elems m) mustVals
-      , sizeOf m `conformsToSpec` size
-      , all (`conformsToSpec` kvs) (Map.toList m)
-      , Map.elems m `conformsToFoldSpec` foldSpec
-      ]
-
-  genFromTypeSpec (MapSpec mHint mustKeys mustVals size (simplifySpec -> kvs) NoFold)
-    | null mustKeys
-    , null mustVals = do
-        let size' =
-              fold
-                [ maybe TrueSpec (leqSpec . max 0) mHint
-                , size
-                , maxSpec (cardinality (fstSpec kvs)) -- (mapSpec FstW  (mapSpec ToGenericW kvs)))
-                , maxSpec (cardinalTrueSpec @k)
-                , geqSpec 0
-                ]
-        n <- genFromSpecT size'
-        let go 0 _ m = pure m
-            go n' kvs' m = do
-              mkv <- tryGenT $ genFromSpecT kvs'
-              case mkv of
-                Nothing
-                  | sizeOf m `conformsToSpec` size -> pure m
-                Just (k, v) ->
-                  go
-                    (n' - 1)
-                    (kvs' <> typeSpec (Cartesian (notEqualSpec k) mempty))
-                    (Map.insert k v m)
-                _ ->
-                  genErrorNE
-                    ( NE.fromList
-                        [ "Failed to generate enough elements for the map:"
-                        , "  m = " ++ show m
-                        , "  n' = " ++ show n'
-                        , show $ "  kvs' = " <> pretty kvs'
-                        , show $ "  simplifySpec kvs' = " <> pretty (simplifySpec kvs')
-                        ]
-                    )
-        explain ("  n = " ++ show n) $ go n kvs mempty
-  genFromTypeSpec (MapSpec mHint mustKeys mustVals size (simplifySpec -> kvs) foldSpec) = do
-    !mustMap <- explain "Make the mustMap" $ forM (Set.toList mustKeys) $ \k -> do
-      let vSpec = constrained $ \v -> satisfies (pair_ (Lit k) v) kvs
-      v <- explain (show $ "vSpec =" <+> pretty vSpec) $ genFromSpecT vSpec
-      pure (k, v)
-    let haveVals = map snd mustMap
-        mustVals' = filter (`notElem` haveVals) mustVals
-        size' = simplifySpec $ constrained $ \sz ->
-          -- TODO, we should make sure size' is greater than or equal to 0
-          satisfies
-            (sz + Lit (sizeOf mustMap))
-            ( maybe TrueSpec (leqSpec . max 0) mHint
-                <> size
-                <> maxSpec (cardinality (fstSpec kvs)) -- (mapSpec FstW $ mapSpec ToGenericW kvs))
-                <> maxSpec (cardinalTrueSpec @k)
-            )
-        !foldSpec' = case foldSpec of
-          NoFold -> NoFold
-          FoldSpec fn@(Fun symbol) sumSpec -> FoldSpec fn $ propagate theAddFn (HOLE :? Value mustSum :> Nil) sumSpec
-            where
-              mustSum = adds (map (semantics symbol) haveVals)
-    let !valsSpec =
-          ListSpec
-            Nothing
-            mustVals'
-            size'
-            (simplifySpec $ constrained $ \v -> unsafeExists $ \k -> pair_ k v `satisfies` kvs)
-            foldSpec'
-
-    !restVals <-
-      explainNE
-        ( NE.fromList
-            [ "Make the restVals"
-            , show $ "  valsSpec =" <+> pretty valsSpec
-            , show $ "  mustMap =" <+> viaShow mustMap
-            , show $ "  size' =" <+> pretty size'
-            ]
-        )
-        $ genFromTypeSpec
-        $ valsSpec
-    let go m [] = pure m
-        go m (v : restVals') = do
-          let keySpec = notMemberSpec (Map.keysSet m) <> constrained (\k -> pair_ k (Lit v) `satisfies` kvs)
-          k <-
-            explainNE
-              ( NE.fromList
-                  [ "Make a key"
-                  , show $ indent 4 $ "keySpec =" <+> pretty keySpec
-                  ]
-              )
-              $ genFromSpecT keySpec
-          go (Map.insert k v m) restVals'
-
-    go (Map.fromList mustMap) restVals
-
-  cardinalTypeSpec _ = TrueSpec
-
-  shrinkWithTypeSpec (MapSpec _ _ _ _ kvs _) m = map Map.fromList $ shrinkList (shrinkWithSpec kvs) (Map.toList m)
-
-  toPreds m (MapSpec mHint mustKeys mustVals size kvs foldSpec) =
-    toPred
-      [ Assert $ Lit mustKeys `subset_` dom_ m
-      , forAll (Lit mustVals) $ \val ->
-          val `elem_` rng_ m
-      , sizeOf_ (rng_ m) `satisfies` size
-      , forAll m $ \kv -> satisfies kv kvs
-      , toPredsFoldSpec (rng_ m) foldSpec
-      , maybe TruePred (`genHint` m) mHint
-      ]
-
-instance
-  (Ord k, HasSpec k, HasSpec v, HasSpec [v], IsNormalType k, IsNormalType v) =>
-  HasGenHint (Map k v)
-  where
-  type Hint (Map k v) = Integer
-  giveHint h = typeSpec $ defaultMapSpec {mapSpecHint = Just h}
-
-------------------------------------------------------------------------
--- Logic instances for
-------------------------------------------------------------------------
-
--- | Function symbols for talking about maps
-data MapW (dom :: [Type]) (rng :: Type) where
-  DomW :: (HasSpec k, HasSpec v, IsNormalType k, IsNormalType v, Ord k) => MapW '[Map k v] (Set k)
-  RngW :: (HasSpec k, HasSpec v, IsNormalType k, IsNormalType v, Ord k) => MapW '[Map k v] [v]
-  LookupW ::
-    (HasSpec k, HasSpec v, IsNormalType k, IsNormalType v, Ord k) => MapW '[k, Map k v] (Maybe v)
-
-deriving instance Eq (MapW dom rng)
-
-instance Semantics MapW where
-  semantics DomW = Map.keysSet
-  semantics RngW = Map.elems
-  semantics LookupW = Map.lookup
-
-instance Syntax MapW
-
-instance Show (MapW d r) where
-  show DomW = "dom_"
-  show RngW = "rng_"
-  show LookupW = "lookup_"
-
-instance Logic MapW where
-  propagate f ctxt (ExplainSpec es s) = explainSpec es $ propagate f ctxt s
-  propagate _ _ TrueSpec = TrueSpec
-  propagate _ _ (ErrorSpec msgs) = ErrorSpec msgs
-  propagate f ctx (SuspendedSpec v ps) = constrained $ \v' -> Let (App f (fromListCtx ctx v')) (v :-> ps)
-  propagate DomW (Unary HOLE) spec =
-    case spec of
-      MemberSpec (s :| []) ->
-        typeSpec $
-          MapSpec Nothing s [] (equalSpec $ sizeOf s) TrueSpec NoFold
-      TypeSpec (SetSpec must elemspec size) [] ->
-        typeSpec $
-          MapSpec
-            Nothing
-            must
-            []
-            size
-            (constrained $ \kv -> satisfies (fst_ kv) elemspec)
-            NoFold
-      _ -> ErrorSpec (NE.fromList ["Dom on bad map spec", show spec])
-  propagate RngW (Unary HOLE) spec =
-    case spec of
-      TypeSpec (ListSpec listHint must size elemspec foldspec) [] ->
-        typeSpec $
-          MapSpec
-            listHint
-            Set.empty
-            must
-            size
-            (constrained $ \kv -> satisfies (snd_ kv) elemspec)
-            foldspec
-      -- NOTE: you'd think `MemberSpec [r]` was a safe and easy case. However, that
-      -- requires not only that the elements of the map are fixed to what is in `r`,
-      -- but they appear in the order that they are in `r`. That's
-      -- very difficult to achieve!
-      _ -> ErrorSpec (NE.fromList ["Rng on bad map spec", show spec])
-  propagate LookupW (Value k :! Unary HOLE) spec =
-    constrained $ \m ->
-      [Assert $ Lit k `member_` dom_ m | not $ Nothing `conformsToSpec` spec]
-        ++ [ forAll m $ \kv ->
-               letBind (fst_ kv) $ \k' ->
-                 letBind (snd_ kv) $ \v ->
-                   whenTrue (Lit k ==. k') $
-                     -- TODO: What you want to write is `just_ v `satisfies` spec` but we can't
-                     -- do that because we don't have access to `IsNormalType v` here. When
-                     -- we refactor the `IsNormalType` machinery we will be able to make
-                     -- this nicer.
-                     case spec of
-                       MemberSpec as -> Assert $ v `elem_` Lit [a | Just a <- NE.toList as]
-                       TypeSpec (SumSpec _ _ vspec) cant ->
-                         v `satisfies` (vspec <> notMemberSpec [a | Just a <- cant])
-           ]
-  propagate LookupW (HOLE :? Value m :> Nil) spec =
-    if Nothing `conformsToSpec` spec
-      then notMemberSpec [k | (k, v) <- Map.toList m, not $ Just v `conformsToSpec` spec]
-      else
-        memberSpec
-          (Map.keys $ Map.filter ((`conformsToSpec` spec) . Just) m)
-          ( NE.fromList
-              [ "propagate (lookup HOLE ms) on (MemberSpec ms)"
-              , "forall pairs (d,r) in ms, no 'd' conforms to spec"
-              , "  " ++ show spec
-              ]
-          )
-
-  mapTypeSpec DomW (MapSpec _ mustSet _ sz kvSpec _) = typeSpec $ SetSpec mustSet (fstSpec kvSpec) sz
-  mapTypeSpec RngW (MapSpec _ _ mustList sz kvSpec foldSpec) = typeSpec $ ListSpec Nothing mustList sz (sndSpec kvSpec) foldSpec
-
-------------------------------------------------------------------------
--- Syntax
-------------------------------------------------------------------------
-
--- | Take the domain of a `Map` as a `Set`
-dom_ ::
-  (HasSpec (Map k v), HasSpec v, HasSpec k, Ord k, IsNormalType k, IsNormalType v) =>
-  Term (Map k v) ->
-  Term (Set k)
-dom_ = appTerm DomW
-
--- | Take the range of a `Map` as a list
-rng_ ::
-  (HasSpec k, HasSpec v, Ord k, IsNormalType k, IsNormalType v) =>
-  Term (Map k v) ->
-  Term [v]
-rng_ = appTerm RngW
-
--- | Lookup a key in the `Map`
-lookup_ ::
-  (HasSpec k, HasSpec v, Ord k, IsNormalType k, IsNormalType v) =>
-  Term k ->
-  Term (Map k v) ->
-  Term (Maybe v)
-lookup_ = appTerm LookupW
-
--- | Check if a key is a member of the map
-mapMember_ ::
-  (HasSpec k, HasSpec v, Ord k, IsNormalType k, IsNormalType v) =>
-  Term k ->
-  Term (Map k v) ->
-  Term Bool
-mapMember_ k m = not_ $ lookup_ k m ==. lit Nothing
diff --git a/libs/constrained-generators/src/Constrained/Spec/Set.hs b/libs/constrained-generators/src/Constrained/Spec/Set.hs
deleted file mode 100644
index 336a6067be6..00000000000
--- a/libs/constrained-generators/src/Constrained/Spec/Set.hs
+++ /dev/null
@@ -1,460 +0,0 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE PatternSynonyms #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# OPTIONS_GHC -Wno-orphans #-}
-
--- | `HasSpec` instance for `Set`s and functions for writing
--- constraints about sets
-module Constrained.Spec.Set (
-  SetSpec (..),
-  SetW (..),
-  singleton_,
-  subset_,
-  member_,
-  union_,
-  disjoint_,
-  fromList_,
-) where
-
-import Constrained.AbstractSyntax
-import Constrained.Base
-import Constrained.Conformance
-import Constrained.Core
-import Constrained.FunctionSymbol
-import Constrained.GenT
-import Constrained.Generation
-import Constrained.List
-import Constrained.NumOrd
-import Constrained.PrettyUtils
-import Constrained.Spec.List
-import Constrained.SumList
-import Constrained.Syntax
-import Constrained.TheKnot
-import Data.Foldable
-import Data.Kind
-import Data.List ((\\))
-import qualified Data.List.NonEmpty as NE
-import Data.Set (Set)
-import qualified Data.Set as Set
-import Prettyprinter hiding (cat)
-import Test.QuickCheck (shrinkList, shuffle)
-
-------------------------------------------------------------------------
--- HasSpec instance for Set
-------------------------------------------------------------------------
-
--- | `TypeSpec` for `Set`
-data SetSpec a
-  = SetSpec
-      -- | Required elements
-      (Set a)
-      -- | Specification for elements
-      (Specification a)
-      -- | Specification for size
-      (Specification Integer)
-
-instance Ord a => Sized (Set.Set a) where
-  sizeOf = toInteger . Set.size
-  liftSizeSpec spec cant = typeSpec (SetSpec mempty TrueSpec (TypeSpec spec cant))
-  liftMemberSpec xs = case NE.nonEmpty xs of
-    Nothing -> ErrorSpec (pure "In liftMemberSpec for the (Sized Set) instance, xs is the empty list")
-    Just zs -> typeSpec (SetSpec mempty TrueSpec (MemberSpec zs))
-  sizeOfTypeSpec (SetSpec must _ sz) = sz <> geqSpec (sizeOf must)
-
-instance (Ord a, HasSpec a) => Semigroup (SetSpec a) where
-  SetSpec must es size <> SetSpec must' es' size' =
-    SetSpec (must <> must') (es <> es') (size <> size')
-
-instance (Ord a, HasSpec a) => Monoid (SetSpec a) where
-  mempty = SetSpec mempty mempty TrueSpec
-
-instance Ord a => Forallable (Set a) a where
-  fromForAllSpec (e :: Specification a)
-    | Evidence <- prerequisites @(Set a) = typeSpec $ SetSpec mempty e TrueSpec
-  forAllToList = Set.toList
-
-prettySetSpec :: HasSpec a => SetSpec a -> Doc ann
-prettySetSpec (SetSpec must elemS size) =
-  parens
-    ( "SetSpec"
-        /> sep ["must=" <> short (Set.toList must), "elem=" <> pretty elemS, "size=" <> pretty size]
-    )
-
-instance HasSpec a => Show (SetSpec a) where
-  show x = show (prettySetSpec x)
-
-guardSetSpec :: (HasSpec a, Ord a) => [String] -> SetSpec a -> Specification (Set a)
-guardSetSpec es (SetSpec must elemS ((<> geqSpec 0) -> size))
-  | Just u <- knownUpperBound size
-  , u < 0 =
-      ErrorSpec (("guardSetSpec: negative size " ++ show u) :| es)
-  | not (all (`conformsToSpec` elemS) must) =
-      ErrorSpec (("Some 'must' items do not conform to 'element' spec: " ++ show elemS) :| es)
-  | isErrorLike size = ErrorSpec ("guardSetSpec: error in size" :| es)
-  | isErrorLike (geqSpec (sizeOf must) <> size) =
-      ErrorSpec $
-        ("Must set size " ++ show (sizeOf must) ++ ", is inconsistent with SetSpec size" ++ show size) :| es
-  | isErrorLike (maxSpec (cardinality elemS) <> size) =
-      ErrorSpec $
-        NE.fromList $
-          [ "Cardinality of SetSpec elemSpec (" ++ show elemS ++ ") = " ++ show (maxSpec (cardinality elemS))
-          , "   This is inconsistent with SetSpec size (" ++ show size ++ ")"
-          ]
-            ++ es
-  | otherwise = typeSpec (SetSpec must elemS size)
-
-instance (Ord a, HasSpec a) => HasSpec (Set a) where
-  type TypeSpec (Set a) = SetSpec a
-
-  type Prerequisites (Set a) = HasSpec a
-
-  emptySpec = mempty
-
-  combineSpec s s' = guardSetSpec ["While combining 2 SetSpecs", "  " ++ show s, "  " ++ show s'] (s <> s')
-
-  conformsTo s (SetSpec must es size) =
-    and
-      [ sizeOf s `conformsToSpec` size
-      , must `Set.isSubsetOf` s
-      , all (`conformsToSpec` es) s
-      ]
-
-  genFromTypeSpec (SetSpec must e _)
-    | any (not . (`conformsToSpec` e)) must =
-        genErrorNE
-          ( NE.fromList
-              [ "Failed to generate set"
-              , "Some element in the must set does not conform to the elem specification"
-              , "Unconforming elements from the must set:"
-              , unlines (map (\x -> "  " ++ show x) (filter (not . (`conformsToSpec` e)) (Set.toList must)))
-              , "Element Specifcation"
-              , "  " ++ show e
-              ]
-          )
-  -- Special case when elemS is a MemberSpec.
-  -- Just union 'must' with enough elements of 'xs' to meet  'szSpec'
-  genFromTypeSpec (SetSpec must (ExplainSpec [] elemspec) szSpec) =
-    genFromTypeSpec (SetSpec must elemspec szSpec)
-  genFromTypeSpec (SetSpec must (ExplainSpec (e : es) elemspec) szSpec) =
-    explainNE (e :| es) $ genFromTypeSpec (SetSpec must elemspec szSpec)
-  genFromTypeSpec (SetSpec must elemS@(MemberSpec xs) szSpec) = do
-    let szSpec' = szSpec <> geqSpec (sizeOf must) <> maxSpec (cardinality elemS)
-    choices <- pureGen $ shuffle (NE.toList xs \\ Set.toList must)
-    size <- fromInteger <$> genFromSpecT szSpec'
-    let additions = Set.fromList $ take (size - Set.size must) choices
-    pure (Set.union must additions)
-  genFromTypeSpec (SetSpec must elemS szSpec) = do
-    let szSpec' = szSpec <> geqSpec (sizeOf must) <> maxSpec (cardinality elemS)
-    chosenSize <-
-      explain "Choose a size for the Set to be generated" $
-        genFromSpecT szSpec'
-    let targetSize = chosenSize - sizeOf must
-    explainNE
-      ( NE.fromList
-          [ "Choose size = " ++ show chosenSize
-          , "szSpec' = " ++ show szSpec'
-          , "Picking items not in must = " ++ show (short (Set.toList must))
-          , "that also meet the element test: "
-          , "  " ++ show elemS
-          ]
-      )
-      $ case theMostWeCanExpect of
-        -- 0 means TrueSpec or SuspendedSpec so we can't rule anything out
-        0 -> go 100 targetSize must
-        n -> case compare n targetSize of
-          LT -> fatalError "The number of things that meet the element test is too small."
-          GT -> go 100 targetSize must
-          EQ -> go 100 targetSize must
-    where
-      theMostWeCanExpect = maxFromSpec 0 (cardinality (simplifySpec elemS))
-      go _ n s | n <= 0 = pure s
-      go tries n s = do
-        e <-
-          explainNE
-            ( NE.fromList
-                [ "Generate set member at type " ++ showType @a
-                , "  number of items starting with  = " ++ show (Set.size must)
-                , "  number of items left to pick   = " ++ show n
-                , "  number of items already picked = " ++ show (Set.size s)
-                , "  the most items we can expect is " ++ show theMostWeCanExpect ++ " (a SuspendedSpec)"
-                ]
-            )
-            $ withMode Strict
-            $ suchThatWithTryT tries (genFromSpecT elemS) (`Set.notMember` s)
-
-        go tries (n - 1) (Set.insert e s)
-
-  cardinalTypeSpec (SetSpec _ es _)
-    | Just ub <- knownUpperBound (cardinality es) = leqSpec (2 ^ ub)
-  cardinalTypeSpec _ = TrueSpec
-
-  cardinalTrueSpec
-    | Just ub <- knownUpperBound $ cardinalTrueSpec @a = leqSpec (2 ^ ub)
-    | otherwise = TrueSpec
-
-  shrinkWithTypeSpec (SetSpec _ es _) as = map Set.fromList $ shrinkList (shrinkWithSpec es) (Set.toList as)
-
-  toPreds s (SetSpec m es size) =
-    fold $
-      -- Don't include this if the must set is empty
-      [ Explain (pure (show m ++ " is a subset of the set.")) $ Assert $ subset_ (Lit m) s
-      | not $ Set.null m
-      ]
-        ++ [ forAll s (\e -> satisfies e es)
-           , satisfies (sizeOf_ s) size
-           ]
-
-  guardTypeSpec = guardSetSpec
-
-------------------------------------------------------------------------
--- Functions that deal with sets
-------------------------------------------------------------------------
-
--- | Symbols for working on sets
-data SetW (d :: [Type]) (r :: Type) where
-  SingletonW :: (HasSpec a, Ord a) => SetW '[a] (Set a)
-  UnionW :: (HasSpec a, Ord a) => SetW '[Set a, Set a] (Set a)
-  SubsetW :: (HasSpec a, Ord a, HasSpec a) => SetW '[Set a, Set a] Bool
-  MemberW :: (HasSpec a, Ord a) => SetW '[a, Set a] Bool
-  DisjointW :: (HasSpec a, Ord a) => SetW '[Set a, Set a] Bool
-  FromListW :: (HasSpec a, Ord a) => SetW '[[a]] (Set a)
-
-deriving instance Eq (SetW dom rng)
-
-instance Show (SetW ds r) where
-  show SingletonW = "singleton_"
-  show UnionW = "union_"
-  show SubsetW = "subset_"
-  show MemberW = "member_"
-  show DisjointW = "disjoint_"
-  show FromListW = "fromList_"
-
-setSem :: SetW ds r -> FunTy ds r
-setSem SingletonW = Set.singleton
-setSem UnionW = Set.union
-setSem SubsetW = Set.isSubsetOf
-setSem MemberW = Set.member
-setSem DisjointW = Set.disjoint
-setSem FromListW = Set.fromList
-
-instance Semantics SetW where
-  semantics = setSem
-
-instance Syntax SetW where
-  prettySymbol SubsetW (Lit n :> y :> Nil) p = Just $ parensIf (p > 10) $ "subset_" <+> short (Set.toList n) <+> prettyPrec 10 y
-  prettySymbol SubsetW (y :> Lit n :> Nil) p = Just $ parensIf (p > 10) $ "subset_" <+> prettyPrec 10 y <+> short (Set.toList n)
-  prettySymbol DisjointW (Lit n :> y :> Nil) p = Just $ parensIf (p > 10) $ "disjoint_" <+> short (Set.toList n) <+> prettyPrec 10 y
-  prettySymbol DisjointW (y :> Lit n :> Nil) p = Just $ parensIf (p > 10) $ "disjoint_" <+> prettyPrec 10 y <+> short (Set.toList n)
-  prettySymbol UnionW (Lit n :> y :> Nil) p = Just $ parensIf (p > 10) $ "union_" <+> short (Set.toList n) <+> prettyPrec 10 y
-  prettySymbol UnionW (y :> Lit n :> Nil) p = Just $ parensIf (p > 10) $ "union_" <+> prettyPrec 10 y <+> short (Set.toList n)
-  prettySymbol MemberW (y :> Lit n :> Nil) p = Just $ parensIf (p > 10) $ "member_" <+> prettyPrec 10 y <+> short (Set.toList n)
-  prettySymbol _ _ _ = Nothing
-
-instance (Ord a, HasSpec a, HasSpec (Set a)) => Semigroup (Term (Set a)) where
-  (<>) = union_
-
-instance (Ord a, HasSpec a, HasSpec (Set a)) => Monoid (Term (Set a)) where
-  mempty = Lit mempty
-
--- Logic instance for SetW ------------------------------------------------
-
-singletons :: [Set a] -> [Set a] -- Every Set in the filterd output has size 1 (if there are any)
-singletons = filter ((1 ==) . Set.size)
-
-instance Logic SetW where
-  propagate f ctxt (ExplainSpec es s) = explainSpec es $ propagate f ctxt s
-  propagate _ _ TrueSpec = TrueSpec
-  propagate _ _ (ErrorSpec msgs) = ErrorSpec msgs
-  propagate f ctx (SuspendedSpec v ps) = constrained $ \v' -> Let (App f (fromListCtx ctx v')) (v :-> ps)
-  propagate SingletonW (Unary HOLE) (TypeSpec (SetSpec must es size) cant)
-    | not $ 1 `conformsToSpec` size =
-        ErrorSpec (pure "propagateSpecFun Singleton with spec that doesn't accept 1 size set")
-    | [a] <- Set.toList must
-    , a `conformsToSpec` es
-    , Set.singleton a `notElem` cant =
-        equalSpec a
-    | null must = es <> notMemberSpec (Set.toList $ fold $ singletons cant)
-    | otherwise = ErrorSpec (pure "propagateSpecFun Singleton with `must` of size > 1")
-  propagate SingletonW (Unary HOLE) (MemberSpec es) =
-    case Set.toList $ fold $ singletons (NE.toList es) of
-      [] -> ErrorSpec $ pure "In propagateSpecFun Singleton, the sets of size 1, in MemberSpec is empty"
-      (x : xs) -> MemberSpec (x :| xs)
-  propagate UnionW ctx spec
-    | (Value s :! Unary HOLE) <- ctx =
-        propagate UnionW (HOLE :? Value s :> Nil) spec
-    | (HOLE :? Value (s :: Set a) :> Nil) <- ctx
-    , Evidence <- prerequisites @(Set a) =
-        case spec of
-          _ | null s -> spec
-          TypeSpec (SetSpec must es size) cant
-            | not $ all (`conformsToSpec` es) s ->
-                ErrorSpec $
-                  NE.fromList
-                    [ "Elements in union argument does not conform to elem spec"
-                    , "  spec: " ++ show es
-                    , "  elems: " ++ show (filter (not . (`conformsToSpec` es)) (Set.toList s))
-                    ]
-            | not $ null cant -> ErrorSpec (pure "propagateSpecFun Union TypeSpec, not (null cant)")
-            | TrueSpec <- size -> typeSpec $ SetSpec (Set.difference must s) es TrueSpec
-            | TypeSpec (NumSpecInterval mlb Nothing) [] <- size
-            , maybe True (<= sizeOf s) mlb ->
-                typeSpec $ SetSpec (Set.difference must s) es TrueSpec
-            | otherwise -> constrained $ \x ->
-                exists (\eval -> pure $ Set.intersection (eval x) s) $ \overlap ->
-                  exists (\eval -> pure $ Set.difference (eval x) s) $ \disjoint ->
-                    [ Assert $ overlap `subset_` Lit s
-                    , Assert $ disjoint `disjoint_` Lit s
-                    , satisfies (sizeOf_ disjoint + Lit (sizeOf s)) size
-                    , Assert $ x ==. (overlap <> disjoint) -- depends on Semigroup (Term (Set a))
-                    , forAll disjoint $ \e -> e `satisfies` es
-                    , Assert $ Lit (must Set.\\ s) `subset_` disjoint
-                    ]
-          -- We only do singleton MemberSpec to avoid really bad blowup
-          MemberSpec (e :| [])
-            | s `Set.isSubsetOf` e ->
-                typeSpec
-                  ( SetSpec
-                      (Set.difference e s)
-                      ( memberSpec
-                          (Set.toList e)
-                          (pure "propagateSpec (union_ s HOLE) on (MemberSpec [e]) where e is the empty set")
-                      )
-                      mempty
-                  )
-          -- TODO: improve this error message
-          _ ->
-            ErrorSpec
-              ( NE.fromList
-                  [ "propagateSpecFun (union_ s HOLE) with spec"
-                  , "s = " ++ show s
-                  , "spec = " ++ show spec
-                  ]
-              )
-  propagate SubsetW ctx spec
-    | (HOLE :? Value (s :: Set a) :> Nil) <- ctx
-    , Evidence <- prerequisites @(Set a) = caseBoolSpec spec $ \case
-        True ->
-          case NE.nonEmpty (Set.toList s) of
-            Nothing -> MemberSpec (pure Set.empty)
-            Just slist -> typeSpec $ SetSpec mempty (MemberSpec slist) mempty
-        False -> constrained $ \set ->
-          exists (\eval -> headGE $ Set.difference (eval set) s) $ \e ->
-            [ set `DependsOn` e
-            , Assert $ not_ $ member_ e (Lit s)
-            , Assert $ member_ e set
-            ]
-    | (Value (s :: Set a) :! Unary HOLE) <- ctx
-    , Evidence <- prerequisites @(Set a) = caseBoolSpec spec $ \case
-        True -> typeSpec $ SetSpec s TrueSpec mempty
-        False -> constrained $ \set ->
-          exists (\eval -> headGE $ Set.difference (eval set) s) $ \e ->
-            [ set `DependsOn` e
-            , Assert $ member_ e (Lit s)
-            , Assert $ not_ $ member_ e set
-            ]
-  propagate MemberW ctx spec
-    | (HOLE :? Value s :> Nil) <- ctx = caseBoolSpec spec $ \case
-        True -> memberSpec (Set.toList s) (pure "propagateSpecFun on (Member x s) where s is Set.empty")
-        False -> notMemberSpec s
-    | (Value e :! Unary HOLE) <- ctx = caseBoolSpec spec $ \case
-        True -> typeSpec $ SetSpec (Set.singleton e) mempty mempty
-        False -> typeSpec $ SetSpec mempty (notEqualSpec e) mempty
-  propagate DisjointW ctx spec
-    | (HOLE :? Value (s :: Set a) :> Nil) <- ctx =
-        propagate DisjointW (Value s :! Unary HOLE) spec
-    | (Value (s :: Set a) :! Unary HOLE) <- ctx
-    , Evidence <- prerequisites @(Set a) = caseBoolSpec spec $ \case
-        True -> typeSpec $ SetSpec mempty (notMemberSpec s) mempty
-        False -> constrained $ \set ->
-          exists (\eval -> headGE (Set.intersection (eval set) s)) $ \e ->
-            [ set `DependsOn` e
-            , Assert $ member_ e (Lit s)
-            , Assert $ member_ e set
-            ]
-  propagate FromListW (Unary HOLE) spec =
-    case spec of
-      MemberSpec (xs :| []) ->
-        typeSpec $
-          ListSpec
-            Nothing
-            (Set.toList xs)
-            TrueSpec
-            ( memberSpec
-                (Set.toList xs)
-                (pure "propagateSpec (fromList_ HOLE) on (MemberSpec xs) where the set 'xs' is empty")
-            )
-            NoFold
-      TypeSpec (SetSpec must elemSpec sizeSpec) []
-        | TrueSpec <- sizeSpec -> typeSpec $ ListSpec Nothing (Set.toList must) TrueSpec elemSpec NoFold
-        | TypeSpec (NumSpecInterval (Just l) Nothing) cantSize <- sizeSpec
-        , l <= sizeOf must
-        , all (< sizeOf must) cantSize ->
-            typeSpec $ ListSpec Nothing (Set.toList must) TrueSpec elemSpec NoFold
-      _ ->
-        -- Here we simply defer to basically generating the universe that we can
-        -- draw from according to `spec` first and then fold that into the spec for the list.
-        -- The tricky thing about this is that it may not play super nicely with other constraints
-        -- on the list. For this reason it's important to try to find as many possible work-arounds
-        -- in the above cases as possible.
-        constrained $ \xs ->
-          exists (\eval -> pure $ Set.fromList (eval xs)) $ \s ->
-            [ s `satisfies` spec
-            , xs `DependsOn` s
-            , forAll xs $ \e -> e `member_` s
-            , forAll s $ \e -> e `elem_` xs
-            ]
-
-  mapTypeSpec FromListW ts =
-    constrained $ \x ->
-      unsafeExists $ \x' -> Assert (x ==. fromList_ x') <> toPreds x' ts
-  mapTypeSpec SingletonW ts =
-    constrained $ \x ->
-      unsafeExists $ \x' ->
-        Assert (x ==. singleton_ x') <> toPreds x' ts
-
-  rewriteRules SubsetW (Lit s :> _ :> Nil) Evidence | null s = Just $ Lit True
-  rewriteRules SubsetW (x :> Lit s :> Nil) Evidence | null s = Just $ x ==. Lit Set.empty
-  rewriteRules UnionW (x :> Lit s :> Nil) Evidence | null s = Just x
-  rewriteRules UnionW (Lit s :> x :> Nil) Evidence | null s = Just x
-  rewriteRules MemberW (t :> Lit s :> Nil) Evidence
-    | null s = Just $ Lit False
-    | [a] <- Set.toList s = Just $ t ==. Lit a
-  rewriteRules DisjointW (Lit s :> _ :> Nil) Evidence | null s = Just $ Lit True
-  rewriteRules DisjointW (_ :> Lit s :> Nil) Evidence | null s = Just $ Lit True
-  rewriteRules _ _ _ = Nothing
-
--- Functions for writing constraints on sets ------------------------------
-
--- | Create a set with a single element
-singleton_ :: (Ord a, HasSpec a) => Term a -> Term (Set a)
-singleton_ = appTerm SingletonW
-
--- | Check if the first argument is a subset of the second
-subset_ :: (Ord a, HasSpec a) => Term (Set a) -> Term (Set a) -> Term Bool
-subset_ = appTerm SubsetW
-
--- | Check if an element is a member of the set
-member_ :: (Ord a, HasSpec a) => Term a -> Term (Set a) -> Term Bool
-member_ = appTerm MemberW
-
--- | Take the union of two sets
-union_ :: (Ord a, HasSpec a) => Term (Set a) -> Term (Set a) -> Term (Set a)
-union_ = appTerm UnionW
-
--- | Check if two sets have no elements in common
-disjoint_ :: (Ord a, HasSpec a) => Term (Set a) -> Term (Set a) -> Term Bool
-disjoint_ = appTerm DisjointW
-
--- | Convert a list to a set
-fromList_ :: forall a. (Ord a, HasSpec a) => Term [a] -> Term (Set a)
-fromList_ = appTerm FromListW
diff --git a/libs/constrained-generators/src/Constrained/Spec/SumProd.hs b/libs/constrained-generators/src/Constrained/Spec/SumProd.hs
deleted file mode 100644
index 647d03ecaf6..00000000000
--- a/libs/constrained-generators/src/Constrained/Spec/SumProd.hs
+++ /dev/null
@@ -1,689 +0,0 @@
-{-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE UndecidableSuperClasses #-}
-{-# OPTIONS_GHC -Wno-orphans #-}
-{-# OPTIONS_GHC -Wno-redundant-constraints #-}
-
--- | A lot of the surface-syntax related to generics
-module Constrained.Spec.SumProd (
-  IsNormalType,
-  ProdAsListComputes,
-  IsProductType,
-  caseOn,
-  branch,
-  branchW,
-  forAll',
-  constrained',
-  reify',
-  con,
-  onCon,
-  isCon,
-  sel,
-  match,
-  onJust,
-  isJust,
-  chooseSpec,
-  left_,
-  right_,
-  just_,
-  nothing_,
-  fst_,
-  snd_,
-  pair_,
-  prodFst_,
-  prodSnd_,
-  prod_,
-) where
-
-import Constrained.AbstractSyntax
-import Constrained.Base
-import Constrained.Conformance
-import Constrained.Core
-import Constrained.Generation
-import Constrained.Generic
-import Constrained.List
-import Constrained.Spec.List
-import Constrained.Syntax
-import Constrained.TheKnot
-import Constrained.TypeErrors
-import Data.Typeable (Typeable)
-import GHC.Generics
-import GHC.TypeLits (Symbol)
-import GHC.TypeNats
-import Test.QuickCheck (Arbitrary (..), oneof)
-
-------------------------------------------------------------------------
--- Syntax for `(,)` and `Either`
-------------------------------------------------------------------------
-
--- | `fst` in `Term` form
-fst_ :: (HasSpec x, HasSpec y) => Term (x, y) -> Term x
-fst_ = prodFst_ . toGeneric_
-
--- | `snd` in `Term` form
-snd_ :: (HasSpec x, HasSpec y) => Term (x, y) -> Term y
-snd_ = prodSnd_ . toGeneric_
-
--- | `(,)` in `Term` form
-pair_ ::
-  ( HasSpec a
-  , HasSpec b
-  , IsNormalType a
-  , IsNormalType b
-  ) =>
-  Term a ->
-  Term b ->
-  Term (a, b)
-pair_ x y = fromGeneric_ $ prod_ x y
-
--- | `Left` in `Term` form
-left_ ::
-  ( HasSpec a
-  , HasSpec b
-  , IsNormalType a
-  , IsNormalType b
-  ) =>
-  Term a ->
-  Term (Either a b)
-left_ = fromGeneric_ . injLeft_
-
--- | `Right` in `Term` form
-right_ ::
-  ( HasSpec a
-  , HasSpec b
-  , IsNormalType a
-  , IsNormalType b
-  ) =>
-  Term b ->
-  Term (Either a b)
-right_ = fromGeneric_ . injRight_
-
--- | @case .. of@ for `Term` and `Pred`. Note that the arguments
--- here are @`Weighted` `Binder`@ over all the `Cases` of the
--- `SimpleRep` of the scrutinee. The `Binder`s can be constructed with
--- `branch` and `branchW`.
-caseOn ::
-  forall a.
-  ( GenericRequires a
-  , SimpleRep a ~ SumOver (Cases (SimpleRep a))
-  , TypeList (Cases (SimpleRep a))
-  ) =>
-  Term a ->
-  FunTy (MapList (Weighted Binder) (Cases (SimpleRep a))) Pred
-caseOn tm = curryList @(Cases (SimpleRep a)) (mkCase (toGeneric_ tm))
-
--- | Build a branch in a `caseOn`
-branch ::
-  forall p a.
-  ( HasSpec a
-  , All HasSpec (Args a)
-  , IsPred p
-  , IsProd a
-  ) =>
-  FunTy (MapList Term (Args a)) p ->
-  Weighted Binder a
-branch body =
-  -- NOTE: It's not sufficient to simply apply `body` to all the arguments
-  -- with `uncurryList` because that will mean that `var` is repeated in the
-  -- body. For example, consider `branch $ \ i j -> i <=. j`. If we don't
-  -- build the lets this will boil down to `p :-> fst p <=. snd p` which
-  -- will blow up at generation time. If we instead do: `p :-> Let x (fst p) (Let y (snd p) (x <=. y))`
-  -- the solver will solve `x` and `y` separately (`y` before `x` in this case) and things
-  -- will work just fine.
-  Weighted Nothing (bind (buildBranch @p body . toArgs @a))
-
--- | Build a branch in a `caseOn` with a weight attached.
-branchW ::
-  forall p a.
-  ( HasSpec a
-  , All HasSpec (Args a)
-  , IsPred p
-  , IsProd a
-  ) =>
-  Int ->
-  FunTy (MapList Term (Args a)) p ->
-  Weighted Binder a
-branchW w body =
-  Weighted (Just w) (bind (buildBranch @p body . toArgs @a))
-
--- ====================================================
--- All the magic for things like 'caseOn', 'match', forAll' etc. lives here.
--- Classes and type families about Sum, Prod, construtors, selectors
--- These let us express the types of things like 'match' and 'caseOn'
-
-class IsProd p where
-  toArgs ::
-    HasSpec p => Term p -> List Term (Args p)
-
-instance {-# OVERLAPPABLE #-} Args a ~ '[a] => IsProd a where
-  toArgs = (:> Nil)
-
-instance IsProd b => IsProd (Prod a b) where
-  toArgs (p :: Term (Prod a b))
-    | Evidence <- prerequisites @(Prod a b) = prodFst_ p :> toArgs (prodSnd_ p)
-
-type family Args t where
-  Args (Prod a b) = a : Args b
-  Args a = '[a]
-
-type family ResultType t where
-  ResultType (a -> b) = ResultType b
-  ResultType a = a
-
--- | A normal type, not an underlying generic representation using `Sum` and t`Prod`
-type IsNormalType a =
-  ( AssertComputes
-      (Cases a)
-      ( Text "Failed to compute Cases in a use of IsNormalType for "
-          :$$: ShowType a
-          :<>: Text ", are you missing an IsNormalType constraint?"
-      )
-  , Cases a ~ '[a]
-  , AssertComputes
-      (Args a)
-      ( Text "Failed to compute Args in a use of IsNormalType for "
-          :<>: ShowType a
-          :<>: Text ", are you missing an IsNormalType constraint?"
-      )
-  , Args a ~ '[a]
-  , IsProd a
-  , CountCases a ~ 1
-  )
-
-type family Cases t where
-  Cases (Sum a b) = a : Cases b
-  Cases a = '[a]
-
--- | A single-constructor type like t`(,)`
-type IsProductType a =
-  ( HasSimpleRep a
-  , AssertComputes
-      (Cases (SimpleRep a))
-      ( Text "Failed to compute Cases in a use of IsProductType for "
-          :$$: ShowType a
-          :<>: Text ", are you missing an IsProductType constraint?"
-      )
-  , Cases (SimpleRep a) ~ '[SimpleRep a]
-  , SimpleRep a ~ SumOver (Cases (SimpleRep a))
-  , IsProd (SimpleRep a)
-  , HasSpec (SimpleRep a)
-  , TypeSpec a ~ TypeSpec (SimpleRep a)
-  , All HasSpec (Args (SimpleRep a))
-  )
-
-type ProductAsList a = Args (SimpleRep a)
-
-class HasSpec (SOP sop) => SOPTerm c sop where
-  inj_ :: Term (ProdOver (ConstrOf c sop)) -> Term (SOP sop)
-
-instance HasSpec (ProdOver constr) => SOPTerm c (c ::: constr : '[]) where
-  inj_ = id
-
-instance
-  ( HasSpec (SOP (con : sop))
-  , HasSpec (ProdOver constr)
-  , KnownNat (CountCases (SOP (con : sop)))
-  ) =>
-  SOPTerm c (c ::: constr : con : sop)
-  where
-  inj_ = injLeft_
-
-instance
-  {-# OVERLAPPABLE #-}
-  ( HasSpec (ProdOver con)
-  , SOPTerm c (con' : sop)
-  , ConstrOf c (con' : sop) ~ ConstrOf c ((c' ::: con) : con' : sop)
-  , KnownNat (CountCases (SOP (con' : sop)))
-  ) =>
-  SOPTerm c ((c' ::: con) : con' : sop)
-  where
-  inj_ = injRight_ . inj_ @c @(con' : sop)
-
-class HasSpec (ProdOver constr) => ConstrTerm constr where
-  prodOver_ :: List Term constr -> Term (ProdOver constr)
-
-instance HasSpec a => ConstrTerm '[a] where
-  prodOver_ (a :> Nil) = a
-
-type family At n as where
-  At 0 (a : as) = a
-  At n (a : as) = At (n - 1) as
-
-class Select n as where
-  select_ :: Term (ProdOver as) -> Term (At n as)
-
-instance Select 0 (a : '[]) where
-  select_ = id
-
-instance (HasSpec a, HasSpec (ProdOver (a' : as))) => Select 0 (a : a' : as) where
-  select_ = prodFst_
-
-instance
-  {-# OVERLAPPABLE #-}
-  ( HasSpec a
-  , HasSpec (ProdOver (a' : as))
-  , At (n - 1) (a' : as) ~ At n (a : a' : as)
-  , Select (n - 1) (a' : as)
-  ) =>
-  Select n (a : a' : as)
-  where
-  select_ = select_ @(n - 1) @(a' : as) . prodSnd_
-
-class IsConstrOf (c :: Symbol) b sop where
-  mkCases ::
-    (HasSpec b, All HasSpec (Cases (SOP sop))) =>
-    (forall a. Term a -> Pred) ->
-    (Term b -> Pred) ->
-    List (Weighted Binder) (Cases (SOP sop))
-
-instance
-  ( b ~ ProdOver as
-  , TypeList (Cases (SOP (con : sop)))
-  ) =>
-  IsConstrOf c b ((c ::: as) : con : sop)
-  where
-  mkCases r (k :: Term b -> Pred) =
-    Weighted Nothing (bind k)
-      :> mapListC @HasSpec (\_ -> Weighted Nothing (bind r)) (listShape @(Cases (SOP (con : sop))))
-
-instance
-  ( b ~ ProdOver as
-  , IsNormalType b
-  ) =>
-  IsConstrOf c b '[c ::: as]
-  where
-  mkCases _ (k :: Term b -> Pred) = Weighted Nothing (bind k) :> Nil
-
-instance
-  {-# OVERLAPPABLE #-}
-  ( Cases (SOP ((c' ::: as) : cs)) ~ (ProdOver as : Cases (SOP cs))
-  , IsConstrOf c b cs
-  ) =>
-  IsConstrOf c b ((c' ::: as) : cs)
-  where
-  mkCases r k = Weighted Nothing (bind (r @(ProdOver as))) :> mkCases @c @_ @cs r k
-
--- Instances --------------------------------------------------------------
-
-fstW :: (HasSpec a, HasSpec b) => FunW '[(a, b)] a
-fstW = ComposeW ProdFstW ToGenericW
-
-sndW :: (HasSpec a, HasSpec b) => FunW '[(a, b)] b
-sndW = ComposeW ProdSndW ToGenericW
-
-instance
-  (HasSpec a, HasSpec b, Arbitrary (FoldSpec a), Arbitrary (FoldSpec b)) =>
-  Arbitrary (FoldSpec (a, b))
-  where
-  arbitrary =
-    oneof
-      [ preMapFoldSpec (Fun fstW) <$> arbitrary
-      , preMapFoldSpec (Fun sndW) <$> arbitrary
-      , pure NoFold
-      ]
-  shrink NoFold = []
-  shrink FoldSpec {} = [NoFold]
-
-buildBranch ::
-  forall p as.
-  ( All HasSpec as
-  , IsPred p
-  ) =>
-  FunTy (MapList Term as) p ->
-  List Term as ->
-  Pred
-buildBranch bd Nil = toPred bd
-buildBranch bd (t :> args) =
-  letBind t $ \x -> buildBranch @p (bd x) args
-
--- | ProdAsListComputes is here to make sure that in situations like this:
---
--- > type family Foobar k
--- >
--- > ex :: HasSpec (Foobar k) => Specification (Int, Foobar k)
--- > ex = constrained $ \ p -> match p $ \ i _ -> (i ==. 10)
---
--- Where you're trying to work with an unevaluated type family in constraints.
--- You get reasonable type errors prompting you to add the @IsNormalType (Foobar k)@ constraint
--- like this:
---
--- >     • Type list computation is stuck on
--- >         Args (Foobar k)
--- >       Have you considered adding an IsNormalType or ProdAsListComputes constraint?
--- >     • In the first argument of ‘($)’, namely ‘match p’
--- >       In the expression: match p $ \ i _ -> (i ==. 10)
--- >       In the second argument of ‘($)’, namely
--- >         ‘\ p -> match p $ \ i _ -> (i ==. 10)’
--- >     |
--- > 503 | ex = constrained $ \ p -> match p $ \ i _ -> (i ==. 10)
--- >     |                           ^^^^^
---
--- Which should help you come to the conclusion that you need to do something
--- like this for everything to compile:
---
--- > ex :: (HasSpec (Foobar k), IsNormalType (Foobar k)) => Specification (Int, Foobar k)
-type ProdAsListComputes a =
-  AssertSpineComputes
-    (Text "Have you considered adding an IsNormalType or ProdAsListComputes constraint?")
-    (ProductAsList a)
-
--- | Pattern-match on a product type and build constraints with the constituents:
-match ::
-  forall p a.
-  ( IsProductType a
-  , IsPred p
-  , GenericRequires a
-  , ProdAsListComputes a
-  ) =>
-  Term a -> FunTy (MapList Term (ProductAsList a)) p -> Pred
-match p m = caseOn p (branch @p m)
-
--- NOTE: `ResultType r ~ Term a` is NOT a redundant constraint,
--- removing it causes type inference to break elsewhere
-
--- | Create a constructor @c@:
--- > just_ :: (HasSpec a, IsNormalType a) => Term a -> Term (Maybe a)
--- > just_ = con @"Just"
-con ::
-  forall c a r.
-  ( SimpleRep a ~ SOP (TheSop a)
-  , TypeSpec a ~ TypeSpec (SOP (TheSop a))
-  , TypeList (ConstrOf c (TheSop a))
-  , r ~ FunTy (MapList Term (ConstrOf c (TheSop a))) (Term a)
-  , ResultType r ~ Term a
-  , SOPTerm c (TheSop a)
-  , ConstrTerm (ConstrOf c (TheSop a))
-  , GenericRequires a
-  ) =>
-  r
-con =
-  curryList @(ConstrOf c (TheSop a)) @Term
-    (fromGeneric_ @a . inj_ @c @(TheSop a) . prodOver_)
-
--- | `Term`-level `Just`
-just_ :: (HasSpec a, IsNormalType a) => Term a -> Term (Maybe a)
-just_ = con @"Just"
-
--- | `Term`-level `Nothing`
-nothing_ :: (HasSpec a, IsNormalType a) => Term (Maybe a)
-nothing_ = con @"Nothing" (Lit ())
-
--- | Select a specific field from a single-constructor type:
--- > data Record = Record { foo :: Int, bar :: Bool }
--- > foo_ :: Term Record -> Term Int
--- > foo_ = sel @0
--- > bar_ :: Term Record -> Term Bool
--- > bar_ = sel @1
-sel ::
-  forall n a c as.
-  ( SimpleRep a ~ ProdOver as
-  , -- TODO: possibly investigate deriving this from the actual SOP of SimpleRep, as currently it's buggy if you define
-    -- your own custom SOP-like SimpleRep by defining SimpleRep rather than TheSop (it's stupid I know)
-    TheSop a ~ '[c ::: as]
-  , TypeSpec a ~ TypeSpec (ProdOver as)
-  , Select n as
-  , HasSpec a
-  , HasSpec (ProdOver as)
-  , HasSimpleRep a
-  , GenericRequires a
-  ) =>
-  Term a ->
-  Term (At n as)
-sel = select_ @n @as . toGeneric_
-
--- | Like `forAll` but pattern matches on the `Term a`
-forAll' ::
-  forall t a p.
-  ( Forallable t a
-  , Cases (SimpleRep a) ~ '[SimpleRep a]
-  , TypeSpec a ~ TypeSpec (SimpleRep a)
-  , HasSpec t
-  , HasSpec (SimpleRep a)
-  , HasSimpleRep a
-  , All HasSpec (Args (SimpleRep a))
-  , IsPred p
-  , IsProd (SimpleRep a)
-  , IsProductType a
-  , HasSpec a
-  , GenericRequires a
-  , ProdAsListComputes a
-  ) =>
-  Term t ->
-  FunTy (MapList Term (ProductAsList a)) p ->
-  Pred
-forAll' xs f = forAll xs $ \x -> match @p x f
-
--- | Like `constrained` but pattern matches on the bound `Term a`
-constrained' ::
-  forall a p.
-  ( Cases (SimpleRep a) ~ '[SimpleRep a]
-  , TypeSpec a ~ TypeSpec (SimpleRep a)
-  , HasSpec (SimpleRep a)
-  , HasSimpleRep a
-  , All HasSpec (Args (SimpleRep a))
-  , IsProd (SimpleRep a)
-  , HasSpec a
-  , IsProductType a
-  , IsPred p
-  , GenericRequires a
-  , ProdAsListComputes a
-  ) =>
-  FunTy (MapList Term (ProductAsList a)) p ->
-  Specification a
-constrained' f = constrained $ \x -> match @p x f
-
--- | Like `reify` but pattern matches on the bound `Term b`
-reify' ::
-  forall a b p.
-  ( Cases (SimpleRep b) ~ '[SimpleRep b]
-  , TypeSpec b ~ TypeSpec (SimpleRep b)
-  , HasSpec (SimpleRep b)
-  , HasSimpleRep b
-  , All HasSpec (Args (SimpleRep b))
-  , IsProd (SimpleRep b)
-  , HasSpec a
-  , HasSpec b
-  , IsProductType b
-  , IsProd a
-  , IsPred p
-  , GenericRequires b
-  , ProdAsListComputes b
-  ) =>
-  Term a ->
-  (a -> b) ->
-  FunTy (MapList Term (ProductAsList b)) p ->
-  Pred
-reify' a r f = reify a r $ \x -> match @p x f
-
-instance
-  ( HasSpec a
-  , HasSpec (ProdOver (a : b : as))
-  , ConstrTerm (b : as)
-  ) =>
-  ConstrTerm (a : b : as)
-  where
-  prodOver_ (a :> as) = prod_ a (prodOver_ as)
-
--- TODO: the constraints around this are horrible!! We should figure out a way to make these things nicer.
-
--- | `caseOn` a _single_ constructor only
-onCon ::
-  forall c a p.
-  ( IsConstrOf c (ProdOver (ConstrOf c (TheSop a))) (TheSop a)
-  , GenericRequires a
-  , SumOver (Cases (SOP (TheSop a))) ~ SimpleRep a
-  , All HasSpec (Cases (SOP (TheSop a)))
-  , HasSpec (ProdOver (ConstrOf c (TheSop a)))
-  , IsPred p
-  , Args (ProdOver (ConstrOf c (TheSop a))) ~ ConstrOf c (TheSop a)
-  , All HasSpec (ConstrOf c (TheSop a))
-  , IsProd (ProdOver (ConstrOf c (TheSop a)))
-  ) =>
-  Term a ->
-  FunTy (MapList Term (ConstrOf c (TheSop a))) p ->
-  Pred
-onCon tm p =
-  Case
-    (toGeneric_ tm)
-    ( mkCases @c @(ProdOver (ConstrOf c (TheSop a))) @(TheSop a)
-        (const $ Assert (Lit True))
-        (buildBranch @p p . toArgs)
-    )
-
--- | Check if a value is an instance of a specific constructor:
--- > isJustConstraint :: HasSpec a => Term (Maybe a) -> Pred
--- > isJustConstraint t = isCon @"Just" t
-isCon ::
-  forall c a.
-  ( IsConstrOf c (ProdOver (ConstrOf c (TheSop a))) (TheSop a)
-  , SumOver (Cases (SOP (TheSop a))) ~ SimpleRep a
-  , All HasSpec (Cases (SOP (TheSop a)))
-  , HasSpec (ProdOver (ConstrOf c (TheSop a)))
-  , GenericRequires a
-  ) =>
-  Term a ->
-  Pred
-isCon tm =
-  Case
-    (toGeneric_ tm)
-    ( mkCases @c @(ProdOver (ConstrOf c (TheSop a))) @(TheSop a)
-        (const $ Assert (Lit False))
-        (const $ Assert (Lit True))
-    )
-
--- | `onCon` specialized to `Just`
-onJust ::
-  forall a p.
-  (HasSpec a, IsNormalType a, IsPred p) =>
-  Term (Maybe a) ->
-  (Term a -> p) ->
-  Pred
-onJust = onCon @"Just"
-
--- | `isCon` specialized to `Just`
-isJust ::
-  forall a.
-  (HasSpec a, IsNormalType a) =>
-  Term (Maybe a) ->
-  Pred
-isJust = isCon @"Just"
-
--- |  ChooseSpec is one of the ways we can 'Or' two Specs together
---    This works for any kind of type that has a HasSpec instance.
---    If your type is a Sum type. One can use CaseOn which is much easier.
-chooseSpec ::
-  HasSpec a =>
-  (Int, Specification a) ->
-  (Int, Specification a) ->
-  Specification a
-chooseSpec (w, s) (w', s') =
-  constrained $ \x ->
-    exists (\eval -> pure $ if eval x `conformsToSpec` s then PickFirst else PickSecond) $ \p ->
-      caseOn
-        p
-        (branchW w' $ \_ -> (x `satisfies` s))
-        (branchW w $ \_ -> (x `satisfies` s'))
-
-data Picky = PickFirst | PickSecond deriving (Ord, Eq, Show, Generic)
-
-instance HasSimpleRep Picky
-
-instance HasSpec Picky
-
-------------------------------------------------------------------------
--- Some generic instances of HasSpec and HasSimpleRep
-------------------------------------------------------------------------
-
-instance (Typeable a, Typeable b) => HasSimpleRep (a, b)
-
-instance (Typeable a, Typeable b, Typeable c) => HasSimpleRep (a, b, c)
-
-instance (Typeable a, Typeable b, Typeable c, Typeable d) => HasSimpleRep (a, b, c, d)
-
-instance (Typeable a, Typeable b, Typeable c, Typeable d, Typeable e) => HasSimpleRep (a, b, c, d, e)
-
-instance
-  (Typeable a, Typeable b, Typeable c, Typeable d, Typeable e, Typeable g) =>
-  HasSimpleRep (a, b, c, d, e, g)
-
-instance
-  (Typeable a, Typeable b, Typeable c, Typeable d, Typeable e, Typeable g, Typeable h) =>
-  HasSimpleRep (a, b, c, d, e, g, h)
-
-instance Typeable a => HasSimpleRep (Maybe a)
-
-instance (Typeable a, Typeable b) => HasSimpleRep (Either a b)
-
-instance
-  ( HasSpec a
-  , HasSpec b
-  ) =>
-  HasSpec (a, b)
-
-instance
-  ( HasSpec a
-  , HasSpec b
-  , HasSpec c
-  ) =>
-  HasSpec (a, b, c)
-
-instance
-  ( HasSpec a
-  , HasSpec b
-  , HasSpec c
-  , HasSpec d
-  ) =>
-  HasSpec (a, b, c, d)
-
-instance
-  ( HasSpec a
-  , HasSpec b
-  , HasSpec c
-  , HasSpec d
-  , HasSpec e
-  ) =>
-  HasSpec (a, b, c, d, e)
-
-instance
-  ( HasSpec a
-  , HasSpec b
-  , HasSpec c
-  , HasSpec d
-  , HasSpec e
-  , HasSpec g
-  ) =>
-  HasSpec (a, b, c, d, e, g)
-
-instance
-  ( HasSpec a
-  , HasSpec b
-  , HasSpec c
-  , HasSpec d
-  , HasSpec e
-  , HasSpec g
-  , HasSpec h
-  ) =>
-  HasSpec (a, b, c, d, e, g, h)
-
-instance
-  (IsNormalType a, HasSpec a) =>
-  HasSpec (Maybe a)
-
-instance
-  ( HasSpec a
-  , IsNormalType a
-  , HasSpec b
-  , IsNormalType b
-  ) =>
-  HasSpec (Either a b)
diff --git a/libs/constrained-generators/src/Constrained/Spec/Tree.hs b/libs/constrained-generators/src/Constrained/Spec/Tree.hs
deleted file mode 100644
index 09edd1a486f..00000000000
--- a/libs/constrained-generators/src/Constrained/Spec/Tree.hs
+++ /dev/null
@@ -1,153 +0,0 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE PatternSynonyms #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-
--- | `HasSpec` instance for `Tree`
-module Constrained.Spec.Tree (
-  TreeSpec (..),
-  rootLabel_,
-  TreeW (..),
-) where
-
-import Constrained.AbstractSyntax
-import Constrained.Base
-import Constrained.Conformance
-import Constrained.Core
-import Constrained.FunctionSymbol
-import Constrained.Generation
-import Constrained.List
-import Constrained.Spec.List
-import Constrained.Spec.SumProd ()
-import Constrained.Syntax
-import Constrained.TheKnot
-import Data.Kind
-import Data.Tree
-import Test.QuickCheck (shrinkList)
-
-------------------------------------------------------------------------
--- HasSpec for Tree
-------------------------------------------------------------------------
-
--- | t`TypeSpec` for `Tree`
-data TreeSpec a = TreeSpec
-  { roseTreeAvgLength :: Maybe Integer
-  , roseTreeMaxSize :: Maybe Integer
-  , roseTreeRootSpec :: Specification a
-  , roseTreeCtxSpec :: Specification (a, [Tree a])
-  }
-
-deriving instance HasSpec a => Show (TreeSpec a)
-
-instance Forallable (Tree a) (a, [Tree a]) where
-  fromForAllSpec = guardRoseSpec . TreeSpec Nothing Nothing TrueSpec
-  forAllToList (Node a children) = (a, children) : concatMap forAllToList children
-
--- TODO: get rid of this when we implement `cardinality`
--- in `HasSpec`
-guardRoseSpec :: HasSpec (Tree a) => TreeSpec a -> Specification (Tree a)
-guardRoseSpec spec@(TreeSpec _ _ rs s)
-  | isErrorLike rs = ErrorSpec (pure "guardRoseSpec: rootSpec is error")
-  | isErrorLike s = ErrorSpec (pure "guardRoseSpec: ctxSpec is error")
-  | otherwise = TypeSpec spec []
-
-instance HasSpec a => HasSpec (Tree a) where
-  type TypeSpec (Tree a) = TreeSpec a
-
-  emptySpec = TreeSpec Nothing Nothing TrueSpec TrueSpec
-
-  combineSpec (TreeSpec mal sz rs s) (TreeSpec mal' sz' rs' s')
-    | isErrorLike alteredspec = ErrorSpec (errorLikeMessage alteredspec)
-    | otherwise =
-        guardRoseSpec $
-          TreeSpec
-            (unionWithMaybe max mal mal')
-            (unionWithMaybe min sz sz')
-            rs''
-            s''
-    where
-      alteredspec = (typeSpec (Cartesian rs'' TrueSpec) <> s'')
-      rs'' = rs <> rs'
-      s'' = s <> s'
-
-  conformsTo (Node a children) (TreeSpec _ _ rs s) =
-    and
-      [ (a, children) `conformsToSpec` s
-      , all (\(Node a' children') -> (a', children') `conformsToSpec` s) children
-      , a `conformsToSpec` rs
-      ]
-
-  genFromTypeSpec (TreeSpec mal msz rs s) = do
-    let sz = maybe 20 id msz
-        sz' = maybe (sz `div` 4) (sz `div`) mal
-        childrenSpec =
-          typeSpec $
-            ListSpec
-              (Just sz')
-              []
-              TrueSpec
-              (typeSpec $ TreeSpec mal (Just sz') TrueSpec s)
-              NoFold
-        innerSpec = s <> typeSpec (Cartesian rs childrenSpec)
-    fmap (uncurry Node) $
-      genFromSpecT @(a, [Tree a]) innerSpec
-
-  shrinkWithTypeSpec (TreeSpec _ _ rs ctxSpec) (Node a ts) =
-    [Node a [] | not $ null ts]
-      ++ ts
-      ++ [Node a' ts | a' <- shrinkWithSpec rs a]
-      ++ [Node a [t] | t <- ts]
-      ++ [ Node a ts'
-         | ts' <- shrinkList (shrinkWithTypeSpec (TreeSpec Nothing Nothing TrueSpec ctxSpec)) ts
-         ]
-
-  cardinalTypeSpec _ = mempty
-
-  toPreds t (TreeSpec mal msz rs s) =
-    (forAll t $ \n -> n `satisfies` s)
-      <> rootLabel_ t
-        `satisfies` rs
-      <> maybe TruePred (\sz -> genHint (mal, sz) t) msz
-
-instance HasSpec a => HasGenHint (Tree a) where
-  type Hint (Tree a) = (Maybe Integer, Integer)
-  giveHint (avgLen, sz) = typeSpec $ TreeSpec avgLen (Just sz) TrueSpec TrueSpec
-
--- | Function symbols for talking about trees
-data TreeW (dom :: [Type]) (rng :: Type) where
-  RootLabelW :: HasSpec a => TreeW '[Tree a] a
-
-deriving instance Eq (TreeW d r)
-
-deriving instance Show (TreeW d r)
-
-instance Semantics TreeW where
-  semantics RootLabelW = \(Node a _) -> a
-
-instance Syntax TreeW
-
-instance Logic TreeW where
-  propagate f ctxt (ExplainSpec es s) = explainSpec es $ propagate f ctxt s
-  propagate _ _ TrueSpec = TrueSpec
-  propagate _ _ (ErrorSpec msgs) = ErrorSpec msgs
-  propagate RootLabelW (Unary HOLE) (SuspendedSpec v ps) = constrained $ \v' -> Let (App RootLabelW (v' :> Nil)) (v :-> ps)
-  propagate RootLabelW (Unary HOLE) spec = typeSpec $ TreeSpec Nothing Nothing spec TrueSpec
-
-  -- NOTE: this function over-approximates and returns a liberal spec.
-  mapTypeSpec RootLabelW (TreeSpec _ _ rs _) = rs
-
--- | Get the label of the root of the `Tree`
-rootLabel_ ::
-  forall a.
-  HasSpec a =>
-  Term (Tree a) ->
-  Term a
-rootLabel_ = appTerm RootLabelW
diff --git a/libs/constrained-generators/src/Constrained/SumList.hs b/libs/constrained-generators/src/Constrained/SumList.hs
deleted file mode 100644
index 938d86ee257..00000000000
--- a/libs/constrained-generators/src/Constrained/SumList.hs
+++ /dev/null
@@ -1,915 +0,0 @@
-{-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE ConstrainedClassMethods #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE ExistentialQuantification #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE UndecidableSuperClasses #-}
-{-# LANGUAGE ViewPatterns #-}
-
--- | Operations for generating random elements of Num like types, that sum to a particular total.
---   The class `Foldy` (defined in the TheKnot.hs) gives the operations necessary to do this.
---   In this module we define the helper functions necessary to define the methods of the Foldy class.
---   The helper functions do not need to know about the Foldy class, and are not dependent upon any of
---   the mutually recursive operations defined in TheKnot, except the operations defined in the Complete class.
---   That class is defined in this module, but the instance for that class is made in TheKnot.
-module Constrained.SumList (
-  genNumList,
-  pickAll,
-  knownUpperBound,
-  knownLowerBound,
-  genListWithSize,
-  Complete (..),
-  maxFromSpec,
-  Solution (..),
-  logRange,
-  logish,
-  Cost (..),
-  predSpecPair,
-  narrowByFuelAndSize,
-) where
-
-import Constrained.AbstractSyntax
-import Constrained.Base
-import Constrained.Conformance (conformsToSpec)
-import Constrained.Core (Value (..))
-import Constrained.GenT (
-  GE (..),
-  GenT,
-  MonadGenError (..),
-  oneofT,
-  pureGen,
-  push,
-  scaleT,
-  sizeT,
-  suchThatT,
-  tryGenT,
- )
-import Constrained.List (List (..), ListCtx (..))
-import Constrained.NumOrd (
-  IntW (..),
-  MaybeBounded (..),
-  NumSpec (..),
-  Numeric,
-  geqSpec,
-  gtSpec,
-  leqSpec,
-  ltSpec,
-  nubOrd,
- )
-import Constrained.PrettyUtils
-import Control.Applicative ((<|>))
-import Control.Monad (guard)
-import Data.List ((\\))
-import Data.List.NonEmpty (NonEmpty (..))
-import qualified Data.List.NonEmpty as NE
-import Data.Maybe (fromMaybe, isNothing, listToMaybe)
-import qualified Data.Set as Set
-import GHC.Stack
-import Prettyprinter hiding (cat)
-import System.Random (Random (..))
-import Test.QuickCheck (Arbitrary, Gen, choose, shuffle, vectorOf)
-
--- ====================================================================
--- What we need to know, that can only be defined in TheKnot module, is
--- abstracted into this class, which will be a precondition on the `Foldy` class
-
--- | Dependency-trick
-class HasSpec a => Complete a where
-  -- method standing for `simplifySpec`
-  simplifyA :: Specification a -> Specification a
-
-  -- method standing for `genFromSpecT`
-  genFromSpecA :: forall m. (HasCallStack, HasSpec a, MonadGenError m) => Specification a -> GenT m a
-
-  -- method standing for method `theAddFn` from the `Foldy` class
-  theAddA :: Numeric a => IntW '[a, a] a
-  theAddA = AddW
-
--- ==========================================================
--- helpers
-
--- ===================================================================
-
--- | Try to find an upper-bound for the values admitted by a `Specification`
-knownUpperBound ::
-  (TypeSpec a ~ NumSpec a, Ord a, Enum a, Num a, MaybeBounded a) =>
-  Specification a ->
-  Maybe a
-knownUpperBound (ExplainSpec _ s) = knownUpperBound s
-knownUpperBound TrueSpec = upperBound
-knownUpperBound (MemberSpec as) = Just $ maximum as
-knownUpperBound ErrorSpec {} = Nothing
-knownUpperBound SuspendedSpec {} = upperBound
-knownUpperBound (TypeSpec (NumSpecInterval lo hi) cant) = upper (lo <|> lowerBound) (hi <|> upperBound)
-  where
-    upper _ Nothing = Nothing
-    upper Nothing (Just b) = listToMaybe $ [b, b - 1 ..] \\ cant
-    upper (Just a) (Just b)
-      | a == b = a <$ guard (a `notElem` cant)
-      | otherwise = listToMaybe $ [b, b - 1 .. a] \\ cant
-
--- | Try to find a lower-bound for the values admitted by a `Specification`
-knownLowerBound ::
-  (TypeSpec a ~ NumSpec a, Ord a, Enum a, Num a, MaybeBounded a) =>
-  Specification a ->
-  Maybe a
-knownLowerBound (ExplainSpec _ s) = knownLowerBound s
-knownLowerBound TrueSpec = lowerBound
-knownLowerBound (MemberSpec as) = Just $ minimum as
-knownLowerBound ErrorSpec {} = Nothing
-knownLowerBound SuspendedSpec {} = lowerBound
-knownLowerBound (TypeSpec (NumSpecInterval lo hi) cant) =
-  lower (lo <|> lowerBound) (hi <|> upperBound)
-  where
-    lower Nothing _ = Nothing
-    lower (Just a) Nothing = listToMaybe $ [a, a + 1 ..] \\ cant
-    lower (Just a) (Just b)
-      | a == b = a <$ guard (a `notElem` cant)
-      | otherwise = listToMaybe $ [a, a + 1 .. b] \\ cant
-
-isEmptyNumSpec ::
-  (TypeSpec a ~ NumSpec a, Ord a, Enum a, Num a, MaybeBounded a) => Specification a -> Bool
-isEmptyNumSpec = \case
-  ExplainSpec _ s -> isEmptyNumSpec s
-  ErrorSpec {} -> True
-  TrueSpec -> False
-  MemberSpec _ -> False -- MemberSpec always has at least one element (NE.NonEmpty)
-  SuspendedSpec {} -> False
-  TypeSpec i cant -> null $ enumerateInterval i \\ cant
-
--- | Note: potentially infinite list
-enumerateInterval :: (Enum a, Num a, MaybeBounded a) => NumSpec a -> [a]
-enumerateInterval (NumSpecInterval lo hi) =
-  case (lo <|> lowerBound, hi <|> upperBound) of
-    (Nothing, Nothing) -> interleave [0 ..] [-1, -2 ..]
-    (Nothing, Just b) -> [b, b - 1 ..]
-    (Just a, Nothing) -> [a ..]
-    (Just a, Just b) -> [a .. b]
-  where
-    interleave [] ys = ys
-    interleave (x : xs) ys = x : interleave ys xs
-
--- ========================================================================
--- Operations to complete the Foldy instances genNumList, genListWithSize
-
--- | Generate a list of values subject to a constraint on both the elements and
--- the result
-genNumList ::
-  forall a m.
-  ( MonadGenError m
-  , Arbitrary a
-  , Integral a
-  , MaybeBounded a
-  , TypeSpec a ~ NumSpec a
-  , -- , Foldy a
-    Random a
-  , Complete a
-  ) =>
-  Specification a ->
-  Specification a ->
-  GenT m [a]
-genNumList elemSIn foldSIn = do
-  let extraElemConstraints
-        | Just l <- knownLowerBound elemSIn
-        , 0 <= l
-        , Just u <- knownUpperBound foldSIn =
-            leqSpec u
-        | otherwise = TrueSpec
-      elemSIn' = elemSIn <> extraElemConstraints
-  normElemS <- normalize elemSIn'
-  normFoldS <- normalize foldSIn
-  let narrowedSpecs = narrowFoldSpecs (normElemS, normFoldS)
-  explainNE
-    ( NE.fromList
-        [ "Can't generate list of ints with fold constraint"
-        , "  elemSpec = " ++ show elemSIn
-        , "  normElemSpec = " ++ show normElemS
-        , "  foldSpec = " ++ show foldSIn
-        ]
-    )
-    $ gen narrowedSpecs 50 [] >>= pureGen . shuffle
-  where
-    normalize (ExplainSpec es x) = explainSpec es <$> normalize x
-    normalize spec@SuspendedSpec {} = do
-      sz <- sizeT
-      spec' <- buildMemberSpec sz (100 :: Int) mempty spec
-      normalize $ spec'
-    normalize spec =
-      pure $
-        maybe mempty geqSpec lowerBound
-          <> maybe mempty leqSpec upperBound
-          <> spec
-
-    buildMemberSpec _ 0 es _ =
-      pure
-        ( memberSpec
-            (Set.toList es)
-            (pure "In genNumList, in buildMemberSpec 'es' is the empty list, can't make a MemberSpec from that")
-        )
-    buildMemberSpec sz fuel es spec = do
-      me <- scaleT (const sz) $ tryGenT (genFromSpecA @a spec)
-      let sz'
-            | sz > 100 = sz
-            | isNothing me = 2 * sz + 1
-            | Just e <- me, Set.member e es = 2 * sz + 1
-            | otherwise = sz
-      buildMemberSpec
-        sz'
-        (fuel - 1)
-        (maybe es (flip Set.insert es) me)
-        spec
-
-    gen ::
-      forall m'. MonadGenError m' => (Specification a, Specification a) -> Int -> [a] -> GenT m' [a]
-    gen (elemS, foldS) fuel lst
-      | fuel <= 0
-      , not $ 0 `conformsToSpec` foldS =
-          genErrorNE $
-            NE.fromList
-              [ "Ran out of fuel in genNumList"
-              , "  elemSpec =" ++ show elemSIn
-              , "  foldSpec = " ++ show foldSIn
-              , "  lst = " ++ show (reverse lst)
-              ]
-      | ErrorSpec err <- foldS = genErrorNE err
-      | ErrorSpec {} <- elemS = pure lst -- At this point we know that foldS admits 0 (also this should be redundant)
-      | 0 `conformsToSpec` foldS = oneofT [pure lst, nonemptyList @GE] -- TODO: distribution
-      | otherwise = nonemptyList
-      where
-        isUnsat (elemSpec, foldSpec) = isEmptyNumSpec foldSpec || not (0 `conformsToSpec` foldSpec) && isEmptyNumSpec elemSpec
-        nonemptyList :: forall m''. MonadGenError m'' => GenT m'' [a]
-        nonemptyList = do
-          (x, specs') <-
-            explainNE
-              ( NE.fromList
-                  [ "Generating an element:"
-                  , "  elemS = " ++ show elemS
-                  , "  foldS = " ++ show foldS
-                  , "  fuel  = " ++ show fuel
-                  , "  lst   = " ++ show (reverse lst)
-                  ]
-              )
-              $ do
-                sz <- sizeT
-                x <- genFromSpecA @a elemS
-                let foldS' = propagate theAddA (HOLE :? Value x :> Nil) foldS
-                    specs' = narrowByFuelAndSize (fromIntegral $ fuel - 1) sz (elemS, foldS')
-                pure (x, specs')
-                `suchThatT` not
-                . isUnsat
-                . snd
-          gen specs' (fuel - 1) (x : lst)
-
-narrowFoldSpecs ::
-  forall a.
-  ( TypeSpec a ~ NumSpec a
-  , Arbitrary a
-  , Integral a
-  , Random a
-  , MaybeBounded a
-  , Complete a
-  ) =>
-  (Specification a, Specification a) ->
-  (Specification a, Specification a)
-narrowFoldSpecs specs = maybe specs narrowFoldSpecs (go specs)
-  where
-    -- Note: make sure there is some progress when returning Just or this will loop forever
-    go :: (Specification a, Specification a) -> Maybe (Specification a, Specification a)
-    go (simplifyA -> elemS, simplifyA -> foldS) = case (elemS, foldS) of
-      -- Empty foldSpec
-      (_, ErrorSpec {}) -> Nothing
-      _ | isEmptyNumSpec foldS -> Just (elemS, ErrorSpec (NE.fromList ["Empty foldSpec:", show foldS]))
-      -- Empty elemSpec
-      (ErrorSpec {}, MemberSpec ys) | NE.toList ys == [0] -> Nothing
-      (ErrorSpec {}, _)
-        | 0 `conformsToSpec` foldS -> Just (elemS, MemberSpec (pure 0))
-        | otherwise ->
-            Just
-              ( elemS
-              , ErrorSpec $
-                  NE.fromList
-                    [ "Empty elemSpec and non-zero foldSpec"
-                    , show $ indent 2 $ "elemSpec =" /> pretty elemS
-                    , show $ indent 2 $ "foldSpec =" /> pretty foldS
-                    ]
-              )
-      -- We can reduce the size of the `elemS` interval when it is
-      -- `[l, u]` or `[l, ∞)` given that `0 <= l` and we have
-      -- an upper bound on the sum - we can't pick things bigger than the
-      -- upper bound.
-      _
-        | Just lo <- knownLowerBound elemS
-        , 0 <= lo
-        , Just hi <- knownUpperBound foldS
-        , -- Check that we will actually be making the set smaller
-          fromMaybe True ((hi <) <$> knownUpperBound elemS) ->
-            Just (elemS <> typeSpec (NumSpecInterval (Just lo) (Just hi)), foldS)
-      -- We can reduce the size of the foldS set by bumping the lower bound when
-      -- there is a positive lower bound on the elemS, we can't generate things smaller
-      -- than the lower bound on `elemS`.
-      _
-        | Just lo <- knownLowerBound elemS
-        , 0 <= lo
-        , not $ 0 `conformsToSpec` foldS
-        , -- Check that we will actually be making the set smaller
-          fromMaybe True ((lo >) <$> knownLowerBound foldS) ->
-            Just (elemS, foldS <> typeSpec (NumSpecInterval (Just lo) Nothing))
-      -- NOTE: this is far from sufficient, but it's good enough of an approximation
-      -- to avoid the worst failures.
-      _
-        | Just lo <- knownLowerBound elemS
-        , Just loS <- knownLowerBound foldS
-        , Just hi <- knownUpperBound elemS
-        , Just hiS <- knownUpperBound foldS
-        , hi < loS
-        , lo > hiS - lo ->
-            Just
-              ( ErrorSpec $ NE.fromList ["Can't solve diophantine equation"]
-              , ErrorSpec $ NE.fromList ["Can't solve diophantine equation"]
-              )
-      _ -> Nothing
-
--- | Try to narrow down a specification for the elems and fold of a list
-narrowByFuelAndSize ::
-  forall a.
-  ( TypeSpec a ~ NumSpec a
-  , Arbitrary a
-  , Integral a
-  , Random a
-  , MaybeBounded a
-  , Complete a
-  ) =>
-  -- | Fuel
-  a ->
-  -- | Integer
-  Int ->
-  (Specification a, Specification a) ->
-  (Specification a, Specification a)
-narrowByFuelAndSize fuel size specpair =
-  loop (100 :: Int) (onlyOnceTransformations $ (narrowFoldSpecs specpair))
-  where
-    loop 0 specs =
-      error $
-        unlines
-          [ "narrowByFuelAndSize loops:"
-          , "  fuel = " ++ show fuel
-          , "  size = " ++ show size
-          , "  specs = " ++ show specs
-          , "  narrowFoldSpecs spec = " ++ show (narrowFoldSpecs specs)
-          , "  go (narrowFoldSpecs specs) = " ++ show (go (narrowFoldSpecs specs))
-          ]
-    loop n specs = case go specs of
-      Nothing -> specs
-      Just specs' -> loop (n - 1) (narrowFoldSpecs specs')
-
-    -- Transformations only applied once. It's annoying to check if you're
-    -- going to change the spec with these so easier to just make sure you only apply
-    -- these once
-    onlyOnceTransformations (elemS, foldS)
-      | fuel == 1 = (elemS <> foldS, foldS)
-      | otherwise = (elemS, foldS)
-
-    canReach _ 0 s = s == 0
-    canReach e currentfuel s
-      -- You can reach it in one step
-      | s <= e = 0 < currentfuel
-      | otherwise = canReach e (currentfuel - 1) (s - e)
-
-    -- Precondition:
-    --   a is negative
-    --   the type has more negative numbers than positive ones
-    safeNegate a
-      | Just u <- upperBound
-      , a < negate u =
-          u
-      | otherwise = negate a
-
-    divCeil a b
-      | b * d < a = d + 1
-      | otherwise = d
-      where
-        d = a `div` b
-
-    go :: (Specification a, Specification a) -> Maybe (Specification a, Specification a)
-    go (simplifyA -> elemS, simplifyA -> foldS)
-      -- There is nothing we can do
-      | fuel == 0 = Nothing
-      | ErrorSpec {} <- elemS = Nothing
-      | ErrorSpec {} <- foldS = Nothing
-      -- Give up as early as possible
-      | Just 0 <- knownUpperBound elemS
-      , Just 0 <- knownLowerBound elemS
-      , not $ 0 `conformsToSpec` foldS =
-          Just (ErrorSpec (NE.fromList ["only 0 left"]), foldS)
-      -- Make sure we try to generate the smallest possible list
-      -- that gives you the right result - don't put a bunch of zeroes in
-      -- a _small_ (size 0) list.
-      | size == 0
-      , 0 `conformsToSpec` elemS =
-          Just (elemS <> notEqualSpec 0, foldS)
-      -- Member specs with non-zero elements, TODO: explain
-      | MemberSpec ys <- elemS
-      , let xs = NE.toList ys
-      , Just u <- knownUpperBound foldS
-      , all (0 <=) xs
-      , any (0 <) xs
-      , let xMinP = minimum $ filter (0 <) xs
-            possible x = x == u || xMinP <= u - x
-            xs' = filter possible xs
-      , xs' /= xs =
-          Just (memberSpec (nubOrd xs') (pure ("None of " ++ show xs ++ " are possible")), foldS)
-      -- The lower bound on the number of elements is too low
-      | Just e <- knownLowerBound elemS
-      , e > 0
-      , Just s <- knownLowerBound foldS
-      , s > 0
-      , let c = divCeil s fuel
-      , e < c =
-          Just (elemS <> geqSpec c, foldS)
-      -- The upper bound on the number of elements is too high
-      | Just e <- knownUpperBound elemS
-      , e < 0
-      , Just s <- knownUpperBound foldS
-      , s < 0
-      , let c = divCeil (safeNegate s) fuel
-      , negate c < e
-      , maybe True (c <) (knownUpperBound elemS) =
-          Just (elemS <> leqSpec c, foldS)
-      -- It's time to stop generating negative numbers
-      | Just s <- knownLowerBound foldS
-      , s > 0
-      , Just e <- knownUpperBound elemS
-      , e > 0
-      , not $ canReach e (fuel `div` 2 + 1) s
-      , maybe True (<= 0) (knownLowerBound elemS) =
-          Just (elemS <> gtSpec 0, foldS)
-      -- It's time to stop generating positive numbers
-      | Just s <- knownUpperBound foldS
-      , s < 0
-      , Just e <- knownLowerBound elemS
-      , e < 0
-      , not $ canReach (safeNegate e) (fuel `div` 2 + 1) (safeNegate s)
-      , maybe True (0 <=) (knownUpperBound elemS) =
-          Just (elemS <> ltSpec 0, foldS)
-      -- There is nothing we need to do
-      | otherwise = Nothing
-
--- =====================================================================================
--- Like genList, but generate a list whose size conforms to s SizeSpec
--- =====================================================================================
-
--- | Generate a list with 'sizeSpec' elements, that add up to a total that conforms
---   to 'foldSpec'. Every element in the list should conform to 'elemSpec'
-genListWithSize ::
-  forall a m.
-  ( Complete a
-  , TypeSpec a ~ NumSpec a
-  , MonadGenError m
-  , Random a
-  , Integral a
-  , Arbitrary a
-  , MaybeBounded a
-  , Complete Integer
-  ) =>
-  Specification Integer ->
-  Specification a ->
-  Specification a ->
-  GenT m [a]
-genListWithSize sizeSpec elemSpec foldSpec
-  | TrueSpec <- sizeSpec = genNumList elemSpec foldSpec
-  | ErrorSpec _ <- sizeSpec <> geqSpec 0 =
-      fatalErrorNE
-        ( NE.fromList
-            [ "genListWithSize called with possible negative size"
-            , "  sizeSpec = " ++ specName sizeSpec
-            , "  elemSpec = " ++ specName elemSpec
-            , "  foldSpec = " ++ specName foldSpec
-            ]
-        )
-  | otherwise = do
-      total <- genFromSpecA @a foldSpec
-      -- The compatible sizes for the list, for a given choice of total
-      let sizeAdjusted =
-            if total /= 0
-              then sizeSpec <> gtSpec 0 -- if total is not zero, we better not pick a 0 size
-              else
-                if lowerBound @a == Just 0 -- Type `a` has no negative numbers (Natural, Word8, Word16, Word 32, Word64)
-                  then sizeSpec <> equalSpec 0 -- if it is zero, and negative numbers not allowed, then only possible size is 0
-                  else sizeSpec <> gtSpec 0
-          message =
-            [ "\nGenSizedList fails"
-            , "sizespec = " ++ specName sizeSpec
-            , "elemSpec = " ++ specName elemSpec
-            , "foldSpec = " ++ specName foldSpec
-            , "total choosen from foldSpec = " ++ show total
-            , "size adjusted for total = " ++ show sizeAdjusted
-            ]
-      push message $ do
-        count <- genFromSpecA @Integer sizeAdjusted
-        case compare total 0 of
-          EQ ->
-            if count == 0
-              then pure []
-              else pickPositive elemSpec total count
-          GT -> pickPositive elemSpec total count
-          LT -> pickNegative elemSpec total count
-
-pickPositive ::
-  forall t m.
-  (Integral t, Random t, MonadGenError m, TypeSpec t ~ NumSpec t, Complete t) =>
-  Specification t ->
-  t ->
-  Integer ->
-  GenT m [t]
-pickPositive elemspec total count = do
-  sol <-
-    pureGen $
-      pickAll
-        (minFromSpec 0 elemspec) -- Search from [0..total] unless elemspec says otherwise
-        (maxFromSpec total elemspec)
-        (predSpecPair elemspec)
-        total
-        (fromInteger count)
-        (Cost 0)
-  case snd sol of
-    No msgs -> fatalErrorNE (NE.fromList msgs)
-    Yes (x :| _) -> pure x
-
-pickNegative ::
-  forall t m.
-  (Integral t, Complete t, Random t, MonadGenError m, TypeSpec t ~ NumSpec t) =>
-  Specification t ->
-  t ->
-  Integer ->
-  GenT m [t]
-
--- | total can be either negative, or 0. If it is 0, we want `count` numbers that add to `zero`
-pickNegative elemspec total count = do
-  sol <-
-    pureGen $
-      pickAll
-        -- Recall 'total' is negative here.
-        -- Here is a graphic of the range we search in (smallest .. largest)
-        -- [(total+n) .. total .. 0 .. (0-n)],  where n = (total `div` 4) which is negative.
-        (minFromSpec (total + (total `div` 4)) elemspec)
-        (maxFromSpec (0 - (total `div` 4)) elemspec)
-        (predSpecPair elemspec)
-        total
-        (fromInteger count)
-        (Cost 0)
-  case snd sol of
-    No msgs -> fatalErrorNE (NE.fromList msgs)
-    Yes (x :| _) -> pure x
-
-specName :: forall a. HasSpec a => Specification a -> String
-specName (ExplainSpec [x] _) = x
-specName x = show x
-
--- | Name (?!) and semantics of a spec
-predSpecPair :: forall a. HasSpec a => Specification a -> (String, a -> Bool)
-predSpecPair spec = (specName spec, (`conformsToSpec` spec))
-
--- | The smallest number admitted by the spec, if we can find one.
---   if not return the defaultValue 'dv'
-minFromSpec ::
-  forall n.
-  (Ord n, Complete n, TypeSpec n ~ NumSpec n) =>
-  n ->
-  Specification n ->
-  n
-minFromSpec dv (ExplainSpec _ spec) = minFromSpec @n dv spec
-minFromSpec dv TrueSpec = dv
-minFromSpec dv s@(SuspendedSpec _ _) =
-  case simplifyA s of
-    SuspendedSpec {} -> dv
-    x -> minFromSpec @n dv x
-minFromSpec dv (ErrorSpec _) = dv
-minFromSpec _ (MemberSpec xs) = minimum xs
-minFromSpec dv (TypeSpec (NumSpecInterval lo _) _) = maybe dv id lo
-
--- | The largest number admitted by the spec, if we can find one.
---   if not return the defaultValue 'dv'
-maxFromSpec ::
-  forall n.
-  (Ord n, Complete n, TypeSpec n ~ NumSpec n) =>
-  n ->
-  Specification n ->
-  n
-maxFromSpec dv (ExplainSpec _ spec) = maxFromSpec @n dv spec
-maxFromSpec dv TrueSpec = dv
-maxFromSpec dv s@(SuspendedSpec _ _) =
-  case simplifyA s of
-    SuspendedSpec {} -> dv
-    x -> maxFromSpec @n dv x
-maxFromSpec dv (ErrorSpec _) = dv
-maxFromSpec _ (MemberSpec xs) = maximum xs
-maxFromSpec dv (TypeSpec (NumSpecInterval _ hi) _) = maybe dv id hi
-
--- =======================================================
--- Helper functions for genSizedList
-
--- | Either a list of possible answers of an explanation of why there is no
--- solution
-data Solution t = Yes (NonEmpty [t]) | No [String]
-  deriving (Eq)
-
-instance Show t => Show (Solution t) where
-  show (No xs) = "No" ++ "\n" ++ unlines xs
-  show (Yes xs) = "Yes " ++ show xs
-
--- | Special case Int for keeping track of "fuel" to find solutions
-newtype Cost = Cost Int deriving (Eq, Show, Num, Ord)
-
-firstYesG ::
-  Monad m => Solution t -> (x -> Cost -> m (Cost, Solution t)) -> [x] -> Cost -> m (Cost, Solution t)
-firstYesG nullSolution f xs c = go xs c
-  where
-    go [] cost = pure (cost, nullSolution)
-    go [x] cost = f x (cost + 1)
-    go (x : more) cost = do
-      ans <- f x (cost + 1)
-      case ans of
-        (cost1, No _) -> go more cost1
-        (_, Yes _) -> pure ans
-
-noChoices :: Show t => Cost -> String -> t -> t -> t -> Int -> [(t, t)] -> Solution t
-noChoices cost p smallest largest total count samp =
-  No
-    [ "\nNo legal choice can be found, where for each sample (x,y)"
-    , "x+y = total && predicate x && predicate y"
-    , "  predicate = " ++ p
-    , "  smallest = " ++ show smallest
-    , "  largest = " ++ show largest
-    , "  total = " ++ show total
-    , "  count = " ++ show count
-    , "  cost = " ++ show cost
-    , "Small sample of what was explored"
-    , show samp
-    ]
-
--- =====================================================
-
--- | Given 'count', return a list of pairs, that add to 'count'
---   splitsOf 6 --> [(1,5),(2,4),(3,3)].
---   Note we don't return reflections like (5,1) and (4,2),
---   as they have the same information as (1,5) and (2,4).
-splitsOf :: Integral b => b -> [(b, b)]
-splitsOf count = [(i, j) | i <- [1 .. div count 2], let j = count - i]
-{-# SPECIALIZE splitsOf :: Int -> [(Int, Int)] #-}
-
--- | Given a Path, find a representative solution, 'ans', for that path, such that
---   1) (length ans) == 'count',
---   2) (sum ans) == 'total'
---   3) (all p ans) is True
---   What is a path?
---   Suppose i==5, then we recursively explore every way to split 5 into
---   split pairs that add to 5. I.e. (1,4) (2,3), then we split each of those.
---   Here is a picture of the graph of all paths for i==5. A path goes from the root '5'
---   to one of the leaves. Note all leaves are count == '1 (where the solution is '[total]').
---   To solve for 5, we could solve either of the sub problems rooted at 5: [1,4] or [2,3].
---   5
---   |
---   [1,4]
---   |  |
---   |  [1,3]
---   |  |  |
---   |  |  [1,2]
---   |  |     |
---   |  |     [1,1]
---   |  |
---   |  [2,2]
---   |   | |
---   |   | [1,1]
---   |   |
---   |   [1,1]
---   |
---   [2,3]
---    | |
---    | [1,2]
---    |    |
---    |    [1,1]
---    [1,1]
---  In 'pickAll' will explore a path for every split of 'count'
---  so if it returns (No _), we can be somewhat confidant that no solution exists.
---  Note that count of 1 and 2, are base cases.
---  When 'count' is greater than 1, we need to sample from [smallest..total],
---  so 'smallest' better be less that or equal to 'total'
-pickAll ::
-  forall t.
-  (Show t, Integral t, Random t) =>
-  t ->
-  t ->
-  (String, t -> Bool) ->
-  t ->
-  Int ->
-  Cost ->
-  Gen (Cost, Solution t)
-pickAll smallest largest (pName, _) total count cost
-  | cost > 1000 =
-      pure $
-        ( cost
-        , No
-            [ "\nPickAll exceeds cost limit " ++ show cost
-            , "  predicate = " ++ pName
-            , "  smallest = " ++ show smallest
-            , "  largest = " ++ show largest
-            , "  total = " ++ show total
-            , "  count = " ++ show count
-            ]
-        )
-pickAll smallest largest (pName, p) total 0 cost =
-  if total == 0 && p total
-    then pure (cost, Yes $ pure [])
-    else
-      pure
-        ( cost
-        , No
-            [ "We are trying to find list of length 0."
-            , "  Whose sum is " ++ show total ++ "."
-            , "  That is only possible if the sum == 0."
-            , "  All elements have to satisfy " ++ pName
-            , "  smallest = " ++ show smallest
-            , "  largest = " ++ show largest
-            ]
-        )
-pickAll smallest largest (pName, p) total 1 cost =
-  if p total
-    then pure (cost, Yes $ pure [total])
-    else pure (cost, noChoices cost pName smallest largest total 1 [(total, 0)])
-pickAll smallest largest (pName, _) total count cost
-  | smallest > largest =
-      pure $
-        ( cost
-        , No
-            [ "\nThe feasible range to pickAll ["
-                ++ show smallest
-                ++ " .. "
-                ++ show (div total 2)
-                ++ "] was empty"
-            , "  predicate = " ++ pName
-            , "  smallest = " ++ show smallest
-            , "  largest = " ++ show largest
-            , "  total = " ++ show total
-            , "  count = " ++ show count
-            , "  cost = " ++ show cost
-            ]
-        )
-pickAll smallest largest (pName, p) total 2 cost = do
-  -- for large things, use a fair sample.
-  choices <- smallSample smallest largest total 1000 100
-  case filter (\(x, y) -> p x && p y) choices of
-    [] -> pure $ (cost + 1, noChoices cost pName smallest largest total 2 (take 10 choices))
-    zs -> pure $ (cost + 1, Yes $ NE.fromList (fmap (\(x, y) -> [x, y]) zs))
-pickAll smallest largest (pName, p) total count cost = do
-  -- Compute a representative sample of the choices between smallest and total.
-  -- E.g. when smallest = -2, and total = 5, the complete set of values is:
-  -- [(-2,7),(-1,6),(0,5),(1,4),(2,3),(3,2),(4,1),(5,0)]  Note they all add to 5
-  -- We could explore the whole set of values, but that can be millions of choices.
-  -- so we choose to explore a representative subset. See the function 'fairSample', for details.
-  -- Remember this is just 1 step on one path. So if this step fails, there are many more
-  -- paths to explore. In fact there are usually many many solutions. We need to find just 1.
-  choices <- smallSample smallest largest total 1000 20
-  -- The choice of splits is crucial. If total >> count, we want the larger splits first
-  -- if count >> total , we want smaller splits first
-  splits <-
-    if count >= 20
-      then shuffle $ take 10 (splitsOf count)
-      else
-        if total > fromIntegral count
-          then pure (reverse (splitsOf count))
-          else pure (splitsOf count)
-
-  firstYesG
-    (No ["\nNo split has a solution", "cost = " ++ show cost])
-    (doSplit smallest largest (pName, p) total choices)
-    splits
-    cost
-
--- TODO run some tests to see if this is a better solution than firstYesG
--- concatSolution smallest pName total count
---  <$> mapM  (doSplit smallest largest total (pName, p) choices (pickAll (depth +1) smallest)) splits
-
--- {-# SPECIALIZE pickAll::Int -> (String, Int -> Bool) -> Int -> Int -> Cost -> Gen (Cost, Solution Int) #-}
-
-doSplit ::
-  (Random t, Show t, Integral t) =>
-  t ->
-  t ->
-  (String, t -> Bool) ->
-  t ->
-  [(t, t)] ->
-  -- (t -> (String, t -> Bool) -> t -> Int -> Cost -> Gen (Cost, Solution t)) ->
-  (Int, Int) ->
-  Cost ->
-  Gen (Cost, Solution t)
-doSplit smallest largest (pName, p) total sample (i, j) c = go sample c
-  where
-    -- The 'sample' is a list of pairs (x,y), where we know (x+y) == total.
-    -- We will search for the first good solution in the given sample
-    -- to build a representative value for this path, with split (i,j).
-    go ((x, y) : more) cost0 = do
-      -- Note (i+j) = current length of the ans we are looking for
-      --      (x+y) = total
-      -- pick 'ans1' such that (sum ans1 == x) and (length ans1 == i)
-      (cost1, ans1) <- pickAll smallest largest (pName, p) x i cost0
-      -- pick 'ans2' such that (sum ans2 == y) and (length ans2 == j)
-      (cost2, ans2) <- pickAll smallest largest (pName, p) y j cost1
-      case (ans1, ans2) of
-        (Yes ys, Yes zs) -> pure $ (cost2, Yes (NE.fromList [a <> b | a <- NE.toList ys, b <- NE.toList zs]))
-        _ -> go more cost2
-    go [] cost =
-      case sample of
-        [] ->
-          pure $
-            ( cost
-            , No
-                [ "\nThe sample passed to doSplit [" ++ show smallest ++ " .. " ++ show (div total 2) ++ "] was empty"
-                , "  predicate = " ++ pName
-                , "  smallest = " ++ show smallest
-                , "  largest = " ++ show largest
-                , "  total " ++ show total
-                , "  count = " ++ show (i + j)
-                , "  split of count = " ++ show (i, j)
-                ]
-            )
-        ((left, right) : _) ->
-          pure $
-            ( cost
-            , No
-                [ "\nAll choices in (genSizedList " ++ show (i + j) ++ " 'p' " ++ show total ++ ") have failed."
-                , "Here is 1 example failure."
-                , "  smallest = " ++ show smallest
-                , "  largest = " ++ show largest
-                , "  total " ++ show total ++ " = " ++ show left ++ " + " ++ show right
-                , "  count = " ++ show (i + j) ++ ", split of count = " ++ show (i, j)
-                , "We are trying to solve sub-problems like:"
-                , "  split " ++ show left ++ " into " ++ show i ++ " parts, where all parts meet 'p'"
-                , "  split " ++ show right ++ " into " ++ show j ++ " parts, where all parts meet 'p'"
-                , "Predicate 'p' = " ++ pName
-                , "A small prefix of the sample, elements (x,y) where x+y = " ++ show total
-                , unlines (map (("  " ++) . show) (take 10 sample))
-                ]
-            )
-{-# INLINE doSplit #-}
-
--- | If the sample is small enough, then enumerate all of it, otherwise take a fair sample.
-smallSample :: (Random t, Integral t) => t -> t -> t -> t -> Int -> Gen [(t, t)]
-smallSample smallest largest total bound size
-  | largest - smallest <= bound = do
-      shuffle $ takeWhile (uncurry (<=)) [(x, total - x) | x <- [smallest .. total]]
-  | otherwise = do
-      choices <- fair smallest largest size 5 True
-      shuffle [(x, total - x) | x <- choices]
-{-# INLINE smallSample #-}
-
--- | Generates a fair sample of numbers between 'smallest' and 'largest'.
---   makes sure there are numbers of all sizes. Controls both the size of the sample
---   and the precision (how many powers of 10 are covered)
---   Here is how we generate one sample when we call (fair (-3455) (10234) 12 3 True)
---   raw = [(-9999,-1000),(-999,-100),(-99,-10),(-9,-1),(0,9),(10,99),(100,999),(1000,9999),(10000,99999)]
---   ranges = [(-3455,-1000),(-999,-100),(-99,-10),(-9,-1),(0,9),(10,99),(100,999),(1000,9999),(10000,10234)]
---   count = 4
---   largePrecision = [(10000,10234),(1000,9999),(100,999)]
---   smallPrecision = [(-3455,-1000),(-999,-100),(-99,-10)]
---   answer generated = [10128,10104,10027,10048,4911,7821,5585,2157,448,630,802,889]
---   isLarge==True   means be biased towards the large end of the range,
---   isLArge==False  means be biased towards the small end of the range,
-fair :: (Random a, Integral a) => a -> a -> Int -> Int -> Bool -> Gen [a]
-fair smallest largest size precision isLarge =
-  concat <$> mapM oneRange (if isLarge then largePrecision else smallPrecision)
-  where
-    raw = map logRange [logish smallest .. logish largest]
-    fixEnds (x, y) = (max smallest x, min largest y)
-    ranges = map fixEnds raw
-    count = div size precision
-    largePrecision = take precision (reverse ranges)
-    smallPrecision = take precision ranges
-    oneRange (x, y) = vectorOf count (choose (x, y))
-
--- | Get the bucket a number is in, i.e. @0-9, 10-99@, etc.
-logRange :: Integral a => a -> (a, a)
-logRange 1 = (10, 99)
-logRange (-1) = (-9, -1)
-logRange n = case compare n 0 of
-  EQ -> (0, 9)
-  LT -> (negate (div b 10), negate (div a 10))
-  GT -> (10 ^ n, 10 ^ (n + 1) - 1)
-  where
-    (a, b) = logRange (negate n)
-
--- | like (logBase10 n), except negative answers mean negative numbers, rather than fractions less than 1.
-logish :: Integral t => t -> t
-logish n
-  | 0 <= n && n <= 9 = 0
-  | n > 9 = 1 + logish (n `div` 10)
-  | (-9) <= n && n <= (-1) = -1
-  | True = negate (1 + logish (negate n))
-
--- =====================================================================
diff --git a/libs/constrained-generators/src/Constrained/Syntax.hs b/libs/constrained-generators/src/Constrained/Syntax.hs
deleted file mode 100644
index 98ad44ef220..00000000000
--- a/libs/constrained-generators/src/Constrained/Syntax.hs
+++ /dev/null
@@ -1,890 +0,0 @@
-{-# LANGUAGE ExistentialQuantification #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE ImportQualifiedPost #-}
-{-# LANGUAGE ImpredicativeTypes #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE ViewPatterns #-}
--- Rename instances
-{-# OPTIONS_GHC -Wno-orphans #-}
-
--- | This module contains operations and tranformations on Syntax, Term, Pred, etc.
---    1) Computing Free Variables
---    2) Substitution
---    3) Renaming
---    4) internal helper functions
---    5) Syntacic only transformations
-module Constrained.Syntax (
-  -- * Surface syntax
-  lit,
-  genHint,
-  dependsOn,
-  reifies,
-  monitor,
-  explanation,
-  assertReified,
-  reify,
-  letBind,
-  unsafeExists,
-  forAll,
-  assertExplain,
-  exists,
-  assert,
-
-  -- * Free variable computations
-  FreeVars,
-  HasVariables (..),
-  freeVarNames,
-  count,
-  singleton,
-  without,
-
-  -- * TODO: documentme
-  computeDependencies,
-  solvableFrom,
-  respecting,
-  dependency,
-  applyNameHints,
-  envFromPred,
-  isLit,
-  mkCase,
-  unBind,
-  substituteTerm',
-  var,
-  runCaseOn,
-  substitutePred,
-  Name (..),
-  DependGraph,
-  Hints,
-  Subst,
-  SubstEntry (..),
-  irreflexiveDependencyOn,
-  substPred,
-  fromLits,
-  backwardsSubstitution,
-) where
-
-import Constrained.AbstractSyntax
-import Constrained.Base
-import Constrained.Core
-import Constrained.Env (Env)
-import Constrained.Env qualified as Env
-import Constrained.FunctionSymbol
-import Constrained.GenT
-import Constrained.Generic
-import Constrained.Graph (
-  deleteNode,
-  dependencies,
-  nodes,
-  opGraph,
-  subtractGraph,
- )
-import Constrained.Graph qualified as Graph
-import Constrained.List hiding (toList)
-import Control.Monad.Writer (Writer, tell)
-import Data.Foldable (fold, toList)
-import Data.List.NonEmpty qualified as NE
-import Data.Map.Strict (Map)
-import Data.Map.Strict qualified as Map
-import Data.Maybe (fromMaybe, isJust)
-import Data.Monoid qualified as Monoid
-import Data.Orphans ()
-import Data.Semigroup (Any (..))
-import Data.Semigroup qualified as Semigroup
-import Data.Set (Set)
-import Data.Set qualified as Set
-import Data.String (fromString)
-import Data.Typeable
-import Language.Haskell.TH qualified as TH
-import Language.Haskell.TH.Quote qualified as TH
-import Prettyprinter hiding (cat)
-import Test.QuickCheck hiding (Args, Fun, Witness, forAll, witness)
-import Prelude hiding (pred)
-
-------------------------------------------------------------------------
--- Surface Syntax
-------------------------------------------------------------------------
-
--- | Attach an explanation (a list of lines) to a `Pred` to get a better
--- error-message when things go wrong
-assertExplain ::
-  IsPred p =>
-  [String] ->
-  p ->
-  Pred
-assertExplain [] p = toPred p
-assertExplain (s : es) p = Explain (s :| es) (toPred p)
-
--- | Assert something, most commonly a @`Term` `Bool`@
-assert ::
-  IsPred p =>
-  p ->
-  Pred
-assert p = toPred p
-
--- | Quantify over all the elements of a collection
-forAll ::
-  forall p t a.
-  ( Forallable t a
-  , HasSpec t
-  , HasSpec a
-  , IsPred p
-  ) =>
-  Term t ->
-  (Term a -> p) ->
-  Pred
-forAll tm = mkForAll tm . bind
-
-mkForAll ::
-  ( Forallable t a
-  , HasSpec t
-  , HasSpec a
-  ) =>
-  Term t ->
-  Binder a ->
-  Pred
-mkForAll (Lit (forAllToList -> [])) _ = TruePred
-mkForAll _ (_ :-> TruePred) = TruePred
-mkForAll tm binder = ForAll tm binder
-
--- | Existentially quanitfy a value, the first argument is a recovery-function
--- to recover the value from a semantics for all the outer-bound variables during
--- constraint-checking
-exists ::
-  forall a p.
-  (HasSpec a, IsPred p) =>
-  ((forall b. Term b -> b) -> GE a) ->
-  (Term a -> p) ->
-  Pred
-exists sem k =
-  Exists sem $ bind k
-
--- | Existentially quantify a variable without the ability to check the constraint
-unsafeExists ::
-  forall a p.
-  (HasSpec a, IsPred p) =>
-  (Term a -> p) ->
-  Pred
-unsafeExists = exists (\_ -> fatalError "unsafeExists")
-
--- | Create a fresh variable to be able to talk about the same `Term` mutliple times
--- without introducing circular dependencies. The following would work:
--- > letBind (fst_ p) $ \ x ->
--- > letBind (snd_ p) $ \ y ->
--- >   assert $ x <=. y
--- While this does not:
--- > assert $ fst_ p <=. snd_ p
--- Although you'd most likely prefer to use `match` in practise:
--- > match p $ \ x y -> assert $ x <=. y
-letBind ::
-  ( HasSpec a
-  , IsPred p
-  ) =>
-  Term a ->
-  (Term a -> p) ->
-  Pred
-letBind tm@V {} body = toPred (body tm)
-letBind tm body = Let tm (bind body)
-
--- | Bind a @`Term` b@ obtained via a haskell-level function @reification :: a -> b@
--- from a @`Term` a@, the inner `Term` depends strictly on the outer one
-reify ::
-  ( HasSpec a
-  , HasSpec b
-  , IsPred p
-  ) =>
-  Term a ->
-  (a -> b) ->
-  (Term b -> p) ->
-  Pred
-reify t f body =
-  exists (\eval -> pure $ f (eval t)) $ \(name "reify_variable" -> x) ->
-    [ reifies x t f
-    , Explain (pure ("reify " ++ show t ++ " somef $")) $ toPred (body x)
-    ]
-
--- | Like `suchThat` for constraints
-assertReified :: HasSpec a => Term a -> (a -> Bool) -> Pred
--- Note, it is necessary to introduce the extra variable from the `exists` here
--- to make things like `assertRealMultiple` work, if you don't have it then the
--- `reifies` isn't a defining constraint for anything any more.
-assertReified t f =
-  reify t f assert
-
--- | Wrap an 'Explain' around a Pred, unless there is a simpler form.
-explanation :: NE.NonEmpty String -> Pred -> Pred
-explanation _ p@DependsOn {} = p
-explanation _ TruePred = TruePred
-explanation es (FalsePred es') = FalsePred (es <> es')
-explanation es (Assert t) = Explain es $ Assert t
-explanation es p = Explain es p
-
--- | Add QuickCheck monitoring (e.g. 'Test.QuickCheck.collect' or 'Test.QuickCheck.counterexample')
---   to a predicate. To use the monitoring in a property call 'monitorSpec' on the 'Specification'
---   containing the monitoring and a value generated from the specification.
-monitor :: ((forall a. Term a -> a) -> Property -> Property) -> Pred
-monitor = Monitor
-
--- | Fix the first argument to be the haskell-"reification" of the second via
--- the third, "reification-function", argument
-reifies :: (HasSpec a, HasSpec b) => Term b -> Term a -> (a -> b) -> Pred
-reifies = Reifies
-
--- | Fix the solver order of the variables in two terms
-dependsOn :: (HasSpec a, HasSpec b) => Term a -> Term b -> Pred
-dependsOn = DependsOn
-
--- | Embed a literal as a `Term`
-lit :: HasSpec a => a -> Term a
-lit = Lit
-
--- | Add a generation-hint (e.g. a soft size constraint) to a `Term`
-genHint :: forall t. HasGenHint t => Hint t -> Term t -> Pred
-genHint = GenHint
-
--- ==========================================================
--- Variables
--- ==========================================================
-
-mkNamed :: String -> TH.Q TH.Pat
-mkNamed x =
-  pure $
-    TH.ViewP (TH.AppE (TH.VarE $ TH.mkName "name") (TH.LitE $ TH.StringL x)) (TH.VarP $ TH.mkName x)
-
-mkNamedExpr :: String -> TH.Q TH.Exp
-mkNamedExpr x =
-  pure $
-    TH.AppE (TH.AppE (TH.VarE $ TH.mkName "name") (TH.LitE $ TH.StringL x)) (TH.VarE $ TH.mkName x)
-
--- | A quasi-quoter for giving variables readable names:
--- > match p $ \ [var| x |] [var| y |] -> ...
--- will give you better error messages than:
--- > match p $ \ x y -> ...
-var :: TH.QuasiQuoter
-var =
-  TH.QuasiQuoter
-    { -- Parses variables e.g. `constrained $ \ [var| x |] [var| y |] -> ...` from the strings " x " and " y "
-      -- and replaces them with `name "x" -> x` and `name "y" -> y`
-      TH.quotePat = mkNamed . varName
-    , -- Parses variables in expressions like `assert $ [var| x |] + 3 <. 10` and replaces them with `name "x" x`
-      TH.quoteExp = mkNamedExpr . varName
-    , TH.quoteDec = const $ fail "var should only be used at binding sites and in expressions"
-    , TH.quoteType = const $ fail "var should only be used at binding sites and in expressions"
-    }
-  where
-    varName s = case words s of
-      [w] -> w
-      _ -> fail "expected a single var name"
-
--- ============================================================
--- 1) Free variables and variable names
--- ============================================================
-
--- | Get all the free variable names of a thing
-freeVarNames :: forall t. HasVariables t => t -> Set Int
-freeVarNames = Set.mapMonotonic (\(Name v) -> nameOf v) . freeVarSet
-
--- | A multi-set of free variables
-newtype FreeVars = FreeVars {unFreeVars :: Map Name Int}
-  deriving (Show)
-
--- | How many times does a name appear in a t`FreeVars` set?
-count :: Name -> FreeVars -> Int
-count n (FreeVars m) = fromMaybe 0 $ Map.lookup n m
-
-instance Semigroup FreeVars where
-  FreeVars fv <> FreeVars fv' = FreeVars $ Map.unionWith (+) fv fv'
-
-instance Monoid FreeVars where
-  mempty = FreeVars mempty
-
--- | A name appears once
-freeVar :: Name -> FreeVars
-freeVar n = singleton n 1
-
--- | A name appears this many times, no more information than that
-singleton :: Name -> Int -> FreeVars
-singleton n k = FreeVars $ Map.singleton n k
-
--- | Remove some names
-without :: Foldable t => FreeVars -> t Name -> FreeVars
-without (FreeVars m) remove = FreeVars $ foldr Map.delete m (toList remove)
-
--- | Something for which we can do free-variable-check operations
-class HasVariables a where
-  freeVars :: a -> FreeVars
-  freeVarSet :: a -> Set Name
-  freeVarSet = Map.keysSet . unFreeVars . freeVars
-  countOf :: Name -> a -> Int
-  countOf n = count n . freeVars
-  appearsIn :: Name -> a -> Bool
-  appearsIn n = (> 0) . count n . freeVars
-
-instance (HasVariables a, HasVariables b) => HasVariables (a, b) where
-  freeVars (a, b) = freeVars a <> freeVars b
-  freeVarSet (a, b) = freeVarSet a <> freeVarSet b
-  countOf n (a, b) = countOf n a + countOf n b
-  appearsIn n (a, b) = appearsIn n a || appearsIn n b
-
-instance HasVariables (List Term as) where
-  freeVars Nil = mempty
-  freeVars (x :> xs) = freeVars x <> freeVars xs
-  freeVarSet Nil = mempty
-  freeVarSet (x :> xs) = freeVarSet x <> freeVarSet xs
-  countOf _ Nil = 0
-  countOf n (x :> xs) = countOf n x + countOf n xs
-  appearsIn _ Nil = False
-  appearsIn n (x :> xs) = appearsIn n x || appearsIn n xs
-
-instance HasVariables Name where
-  freeVars = freeVar
-  freeVarSet = Set.singleton
-  countOf n n'
-    | n == n' = 1
-    | otherwise = 0
-  appearsIn n n' = n == n'
-
-instance HasVariables (Term a) where
-  freeVars = \case
-    Lit {} -> mempty
-    V x -> freeVar (Name x)
-    App _ ts -> freeVars ts
-  freeVarSet = \case
-    Lit {} -> mempty
-    V x -> freeVarSet (Name x)
-    App _ ts -> freeVarSet ts
-  countOf n = \case
-    Lit {} -> 0
-    V x -> countOf n (Name x)
-    App _ ts -> countOf n ts
-  appearsIn n = \case
-    Lit {} -> False
-    V x -> appearsIn n (Name x)
-    App _ ts -> appearsIn n ts
-
-instance HasVariables Pred where
-  freeVars = \case
-    ElemPred _ t _ -> freeVars t
-    GenHint _ t -> freeVars t
-    Subst x t p -> freeVars t <> freeVars p `without` [Name x]
-    And ps -> foldMap freeVars ps
-    Let t b -> freeVars t <> freeVars b
-    Exists _ b -> freeVars b
-    Assert t -> freeVars t
-    Reifies t' t _ -> freeVars t' <> freeVars t
-    DependsOn x y -> freeVars x <> freeVars y
-    ForAll set b -> freeVars set <> freeVars b
-    Case t bs -> freeVars t <> freeVars bs
-    When b p -> freeVars b <> freeVars p
-    TruePred -> mempty
-    FalsePred _ -> mempty
-    Monitor {} -> mempty
-    Explain _ p -> freeVars p
-  freeVarSet = \case
-    ElemPred _ t _ -> freeVarSet t
-    GenHint _ t -> freeVarSet t
-    Subst x t p -> freeVarSet t <> Set.delete (Name x) (freeVarSet p)
-    And ps -> foldMap freeVarSet ps
-    Let t b -> freeVarSet t <> freeVarSet b
-    Exists _ b -> freeVarSet b
-    Assert t -> freeVarSet t
-    Reifies t' t _ -> freeVarSet t' <> freeVarSet t
-    DependsOn x y -> freeVarSet x <> freeVarSet y
-    ForAll set b -> freeVarSet set <> freeVarSet b
-    Case t bs -> freeVarSet t <> freeVarSet bs
-    When b p -> freeVarSet b <> freeVarSet p
-    Explain _ p -> freeVarSet p
-    TruePred -> mempty
-    FalsePred _ -> mempty
-    Monitor {} -> mempty
-  countOf n = \case
-    ElemPred _ t _ -> countOf n t
-    GenHint _ t -> countOf n t
-    Subst x t p
-      | n == Name x -> countOf n t
-      | otherwise -> countOf n t + countOf n p
-    And ps -> sum $ map (countOf n) ps
-    Let t b -> countOf n t + countOf n b
-    Exists _ b -> countOf n b
-    Assert t -> countOf n t
-    Reifies t' t _ -> countOf n t' + countOf n t
-    DependsOn x y -> countOf n x + countOf n y
-    ForAll set b -> countOf n set + countOf n b
-    Case t bs -> countOf n t + countOf n bs
-    When b p -> countOf n b + countOf n p
-    Explain _ p -> countOf n p
-    TruePred -> 0
-    FalsePred _ -> 0
-    Monitor {} -> 0
-  appearsIn n = \case
-    ElemPred _ t _ -> appearsIn n t
-    GenHint _ t -> appearsIn n t
-    Subst x t p
-      | n == Name x -> appearsIn n t
-      | otherwise -> appearsIn n t || appearsIn n p
-    And ps -> any (appearsIn n) ps
-    Let t b -> appearsIn n t || appearsIn n b
-    Exists _ b -> appearsIn n b
-    Assert t -> appearsIn n t
-    Reifies t' t _ -> appearsIn n t' || appearsIn n t
-    DependsOn x y -> appearsIn n x || appearsIn n y
-    ForAll set b -> appearsIn n set || appearsIn n b
-    Case t bs -> appearsIn n t || appearsIn n bs
-    When b p -> appearsIn n b || appearsIn n p
-    Explain _ p -> appearsIn n p
-    TruePred -> False
-    FalsePred _ -> False
-    Monitor {} -> False
-
-instance HasVariables (Binder a) where
-  freeVars (x :-> p) = freeVars p `without` [Name x]
-  freeVarSet (x :-> p) = Set.delete (Name x) (freeVarSet p)
-  countOf n (x :-> p)
-    | Name x == n = 0
-    | otherwise = countOf n p
-  appearsIn n (x :-> p)
-    | Name x == n = False
-    | otherwise = appearsIn n p
-
-instance HasVariables (f a) => HasVariables (Weighted f a) where
-  freeVars = freeVars . thing
-  freeVarSet = freeVarSet . thing
-  countOf n = countOf n . thing
-  appearsIn n = appearsIn n . thing
-
-instance HasVariables (List (Weighted Binder) as) where
-  freeVars Nil = mempty
-  freeVars (a :> as) = freeVars a <> freeVars as
-  freeVarSet Nil = mempty
-  freeVarSet (a :> as) = freeVarSet a <> freeVarSet as
-  countOf _ Nil = 0
-  countOf n (x :> xs) = countOf n x + countOf n xs
-  appearsIn _ Nil = False
-  appearsIn n (x :> xs) = appearsIn n x || appearsIn n xs
-
-instance {-# OVERLAPPABLE #-} (Foldable t, HasVariables a) => HasVariables (t a) where
-  freeVars = foldMap freeVars
-  freeVarSet = foldMap freeVarSet
-  countOf n = Monoid.getSum . foldMap (Monoid.Sum . countOf n)
-  appearsIn n = any (appearsIn n)
-
-instance HasVariables a => HasVariables (Set a) where
-  freeVars = foldMap freeVars
-  freeVarSet = foldMap freeVarSet
-  countOf n = sum . Set.map (countOf n)
-  appearsIn n = any (appearsIn n)
-
--- =================================================================
--- 2) Substitutions
--- ============================================================
-
--- | A substitution
-type Subst = [SubstEntry]
-
--- | Individual substitution entry
-data SubstEntry where
-  (:=) :: HasSpec a => Var a -> Term a -> SubstEntry
-
--- | Try to run a substitution backwards to abstract
-backwardsSubstitution :: forall a. HasSpec a => Subst -> Term a -> Term a
-backwardsSubstitution sub0 t =
-  case findMatch sub0 t of
-    -- TODO: what about multiple matches??
-    Just x -> V x
-    Nothing -> case t of
-      Lit a -> Lit a
-      V x -> V x
-      App f ts -> App f (mapListC @HasSpec (backwardsSubstitution sub0) ts)
-  where
-    findMatch :: Subst -> Term a -> Maybe (Var a)
-    findMatch [] _ = Nothing
-    findMatch (x := t' : sub1) t1
-      | fastInequality t1 t' = findMatch sub1 t1
-      | Just (x', t'') <- cast (x, t')
-      , t == t'' =
-          Just x'
-      | otherwise = findMatch sub1 t1
-
--- ===================================================================
-
-substituteTerm :: forall a. Subst -> Term a -> Term a
-substituteTerm sub = \case
-  Lit a -> Lit a
-  V x -> substVar sub x
-  App f (mapList (substituteTerm sub) -> (ts :: List Term dom)) ->
-    case fromLits ts of
-      Just vs -> Lit (uncurryList_ unValue (semantics f) vs)
-      _ -> App f ts
-  where
-    substVar :: HasSpec a => Subst -> Var a -> Term a
-    substVar [] x = V x
-    substVar (y := t : sub1) x
-      | Just Refl <- eqVar x y = t
-      | otherwise = substVar sub1 x
-
--- | Apply substitution and check if we did anything
-substituteTerm' :: forall a. Subst -> Term a -> Writer Any (Term a)
-substituteTerm' sub = \case
-  Lit a -> pure $ Lit a
-  V x -> substVar sub x
-  App f ts ->
-    App f <$> mapMList (substituteTerm' sub) ts
-  where
-    substVar :: HasSpec a => Subst -> Var a -> Writer Any (Term a)
-    substVar [] x = pure $ V x
-    substVar (y := t : sub1) x
-      | Just Refl <- eqVar x y = t <$ tell (Any True)
-      | otherwise = substVar sub1 x
-
-substituteBinder :: HasSpec a => Var a -> Term a -> Binder b -> Binder b
-substituteBinder x tm (y :-> p) = y' :-> substitutePred x tm p'
-  where
-    (y', p') =
-      freshen y p (Set.singleton (nameOf x) <> freeVarNames tm <> Set.delete (nameOf y) (freeVarNames p))
-
--- | Apply a single-variable substitution
-substitutePred :: HasSpec a => Var a -> Term a -> Pred -> Pred
-substitutePred x tm = \case
-  ElemPred bool t xs -> ElemPred bool (substituteTerm [x := tm] t) xs
-  GenHint h t -> GenHint h (substituteTerm [x := tm] t)
-  Subst x' t p -> substitutePred x tm $ substitutePred x' t p
-  Assert t -> Assert (substituteTerm [x := tm] t)
-  And ps -> fold (substitutePred x tm <$> ps)
-  Exists k b -> Exists (\eval -> k (eval . substituteTerm [x := tm])) (substituteBinder x tm b)
-  Let t b -> Let (substituteTerm [x := tm] t) (substituteBinder x tm b)
-  ForAll t b -> ForAll (substituteTerm [x := tm] t) (substituteBinder x tm b)
-  Case t bs -> Case (substituteTerm [x := tm] t) (mapList (mapWeighted $ substituteBinder x tm) bs)
-  When b p -> When (substituteTerm [x := tm] b) (substitutePred x tm p)
-  Reifies t' t f -> Reifies (substituteTerm [x := tm] t') (substituteTerm [x := tm] t) f
-  DependsOn t t' -> DependsOn (substituteTerm [x := tm] t) (substituteTerm [x := tm] t')
-  TruePred -> TruePred
-  FalsePred es -> FalsePred es
-  Monitor m -> Monitor (\eval -> m (eval . substituteTerm [x := tm]))
-  Explain es p -> Explain es $ substitutePred x tm p
-
--- =====================================================
--- Substituion under an Env, rather than a single Var
--- It takes Values in the Env, and makes them Literals in the Term.
-
-substTerm :: Env -> Term a -> Term a
-substTerm env = \case
-  Lit a -> Lit a
-  V v
-    | Just a <- Env.lookup env v -> Lit a
-    | otherwise -> V v
-  App f (mapList (substTerm env) -> ts) ->
-    case fromLits ts of
-      Just vs -> Lit (uncurryList_ unValue (semantics f) vs)
-      _ -> App f ts
-
-substBinder :: Env -> Binder a -> Binder a
-substBinder env (x :-> p) = x :-> substPred (Env.remove x env) p
-
--- | Apply a variable-to-value substitution to a `Pred`
-substPred :: Env -> Pred -> Pred
-substPred env = \case
-  ElemPred bool t xs -> ElemPred bool (substTerm env t) xs
-  GenHint h t -> GenHint h (substTerm env t)
-  Subst x t p -> substPred env $ substitutePred x t p
-  Assert t -> Assert (substTerm env t)
-  Reifies t' t f -> Reifies (substTerm env t') (substTerm env t) f
-  ForAll set b -> ForAll (substTerm env set) (substBinder env b)
-  Case t bs -> Case (substTerm env t) (mapList (mapWeighted $ substBinder env) bs)
-  When b p -> When (substTerm env b) (substPred env p)
-  DependsOn x y -> DependsOn (substTerm env x) (substTerm env y)
-  TruePred -> TruePred
-  FalsePred es -> FalsePred es
-  And ps -> fold (substPred env <$> ps)
-  Exists k b -> Exists (\eval -> k $ eval . substTerm env) (substBinder env b)
-  Let t b -> Let (substTerm env t) (substBinder env b)
-  Monitor m -> Monitor m
-  Explain es p -> Explain es $ substPred env p
-
--- | Substitute a value for a `Binder`
-unBind :: a -> Binder a -> Pred
-unBind a (x :-> p) = substPred (Env.singleton x a) p
-
--- ==========================================================
--- Renaming
--- ============================================================
-
--- Name
-
--- | Wrap a `Var` and hide the type
-data Name where
-  Name :: HasSpec a => Var a -> Name
-
-deriving instance Show Name
-
-instance Eq Name where
-  Name v == Name v' = isJust $ eqVar v v'
-
--- Instances
-
-instance Pretty (Var a) where
-  pretty = fromString . show
-
-instance Pretty Name where
-  pretty (Name v) = pretty v
-
-instance Ord Name where
-  compare (Name v) (Name v') = compare (nameOf v, typeOf v) (nameOf v', typeOf v')
-
-instance Rename Name where
-  rename v v' (Name v'') = Name $ rename v v' v''
-
-instance Rename (Term a) where
-  rename v v'
-    | v == v' = id
-    | otherwise = \case
-        Lit l -> Lit l
-        V v'' -> V (rename v v' v'')
-        App f a -> App f (rename v v' a)
-
-instance Rename Pred where
-  rename v v'
-    | v == v' = id
-    | otherwise = \case
-        ElemPred bool t xs -> ElemPred bool (rename v v' t) xs
-        GenHint h t -> GenHint h (rename v v' t)
-        Subst x t p -> rename v v' $ substitutePred x t p
-        And ps -> And (rename v v' ps)
-        Exists k b -> Exists (\eval -> k $ eval . rename v v') (rename v v' b)
-        Let t b -> Let (rename v v' t) (rename v v' b)
-        Reifies t' t f -> Reifies (rename v v' t') (rename v v' t) f
-        Assert t -> Assert (rename v v' t)
-        DependsOn x y -> DependsOn (rename v v' x) (rename v v' y)
-        ForAll set b -> ForAll (rename v v' set) (rename v v' b)
-        Case t bs -> Case (rename v v' t) (rename v v' bs)
-        When b p -> When (rename v v' b) (rename v v' p)
-        TruePred -> TruePred
-        FalsePred es -> FalsePred es
-        Monitor m -> Monitor m
-        Explain es p -> Explain es (rename v v' p)
-
-instance Rename (Binder a) where
-  rename v v' (va :-> psa) = va' :-> rename v v' psa'
-    where
-      (va', psa') = freshen va psa (Set.fromList [nameOf v, nameOf v'] <> Set.delete (nameOf va) (freeVarNames psa))
-
-instance Rename (f a) => Rename (Weighted f a) where
-  rename v v' (Weighted w t) = Weighted w (rename v v' t)
-
--- ============================================================================
--- 4) Internals
--- ============================================================================
-
--- | Try to extract literals from a list of Term, if anything isn't a literal, give up
-fromLits :: List Term as -> Maybe (List Value as)
-fromLits = mapMList fromLit
-
-fromLit :: Term a -> Maybe (Value a)
-fromLit (Lit l) = pure $ Value l
--- fromLit (To x) = (Value . toSimpleRep . unValue) <$> fromLit x -- MAYBE we don't want to do this?
--- fromLit (From x) = (Value . fromSimpleRep . unValue) <$> fromLit x -- Why not apply unary functions to Lit ?
-fromLit _ = Nothing
-
--- | Is a term a literl?
-isLit :: Term a -> Bool
-isLit = isJust . fromLit
-
--- | Build a `caseOn`
-mkCase ::
-  HasSpec (SumOver as) => Term (SumOver as) -> List (Weighted Binder) as -> Pred
-mkCase tm cs
-  | Weighted _ (x :-> p) :> Nil <- cs = Subst x tm p
-  -- TODO: all equal maybe?
-  | Semigroup.getAll $ foldMapList isTrueBinder cs = TruePred
-  | Semigroup.getAll $ foldMapList (isFalseBinder . thing) cs = FalsePred (pure "mkCase on all False")
-  | Lit a <- tm = runCaseOn a (mapList thing cs) (\x val p -> substPred (Env.singleton x val) p)
-  | otherwise = Case tm cs
-  where
-    isTrueBinder (Weighted Nothing (_ :-> TruePred)) = Semigroup.All True
-    isTrueBinder _ = Semigroup.All False
-
-    isFalseBinder (_ :-> FalsePred {}) = Semigroup.All True
-    isFalseBinder _ = Semigroup.All False
-
--- | Run a `caseOn`
-runCaseOn ::
-  SumOver as ->
-  List Binder as ->
-  (forall a. (Typeable a, Show a) => Var a -> a -> Pred -> r) ->
-  r
-runCaseOn _ Nil _ = error "The impossible happened in runCaseOn"
-runCaseOn a ((x :-> ps) :> Nil) f = f x a ps
-runCaseOn s ((x :-> ps) :> bs@(_ :> _)) f = case s of
-  SumLeft a -> f x a ps
-  SumRight a -> runCaseOn a bs f
-
--- | Construct an environment for all variables that show up on the top level
--- (i.e. ones bound in `let` and `exists`) from an environment for all the free
--- variables in the pred. The environment you get out of this function is
--- _bigger_ than the environment you put in. From
--- ```
--- let y = x + 1 in let z = y + 1 in foo x y z
--- ```
--- and an environment with `{x -> 1}` you would get `{x -> 1, y -> 2, z -> 3}`
--- out.
-envFromPred :: Env -> Pred -> GE Env
-envFromPred env p = case p of
-  ElemPred _bool _term _xs -> pure env
-  -- NOTE: these don't bind anything
-  Assert {} -> pure env
-  DependsOn {} -> pure env
-  Monitor {} -> pure env
-  TruePred {} -> pure env
-  FalsePred {} -> pure env
-  GenHint {} -> pure env
-  -- NOTE: this is ok because the variables either come from an `Exists`, a `Let`, or from
-  -- the top level
-  Reifies {} -> pure env
-  -- NOTE: variables in here shouldn't escape to the top level
-  ForAll {} -> pure env
-  Case {} -> pure env
-  -- These can introduce binders that show up in the plan
-  When _ pp -> envFromPred env pp
-  Subst x a pp -> envFromPred env (substitutePred x a pp)
-  Let t (x :-> pp) -> do
-    v <- runTerm env t
-    envFromPred (Env.extend x v env) pp
-  Explain _ pp -> envFromPred env pp
-  Exists c (x :-> pp) -> do
-    v <- c (errorGE . explain "envFromPred: Exists" . runTerm env)
-    envFromPred (Env.extend x v env) pp
-  And [] -> pure env
-  And (pp : ps) -> do
-    env' <- envFromPred env pp
-    envFromPred env' (And ps)
-
-------------------------------------------------------------------------
--- Lifting name hints to binders
-------------------------------------------------------------------------
-
-findNameHint :: HasVariables t => Var a -> t -> Var a
-findNameHint v t =
-  case [nameHint v' | Name v' <- Set.toList $ freeVarSet t, nameOf v' == nameOf v, nameHint v' /= "v"] of
-    [] -> v
-    nh : _ -> v {nameHint = nh}
-
-liftNameHintToBinder :: Binder a -> Binder a
-liftNameHintToBinder (x :-> p) = x' :-> substitutePred x (V x') (applyNameHintsPred p)
-  where
-    x' = findNameHint x p
-
-applyNameHintsPred :: Pred -> Pred
-applyNameHintsPred pred = case pred of
-  ElemPred {} -> pred
-  Monitor {} -> pred
-  And ps -> And $ map applyNameHintsPred ps
-  Exists k b -> Exists k (liftNameHintToBinder b)
-  Subst v t p -> applyNameHintsPred (substitutePred v t p)
-  Let t b -> Let t (liftNameHintToBinder b)
-  Assert {} -> pred
-  Reifies {} -> pred
-  DependsOn {} -> pred
-  ForAll t b -> ForAll t (liftNameHintToBinder b)
-  Case t bs -> Case t (mapList (mapWeighted liftNameHintToBinder) bs)
-  When b p' -> When b (applyNameHintsPred p')
-  GenHint {} -> pred
-  TruePred {} -> pred
-  FalsePred {} -> pred
-  Explain es p' -> Explain es (applyNameHintsPred p')
-
--- | Makes sure that uses of the @[var| |]@ quasi-quoter are correctly
--- propagated to the binding site of the variable. This is done as a separate
--- pass to make sure we don't traverse the `Specification` too many times
-applyNameHints :: Specification a -> Specification a
-applyNameHints (ExplainSpec es x) = explainSpec es (applyNameHints x)
-applyNameHints (SuspendedSpec x p) =
-  SuspendedSpec x' p'
-  where
-    x' :-> p' = liftNameHintToBinder (x :-> p)
-applyNameHints spec = spec
-
-------------------------------------------------------------------------
--- Dependency Graphs
-------------------------------------------------------------------------
-
--- | `Graph` specialized to dependencies for variables
-type DependGraph = Graph.Graph Name
-
--- | A variable depends on a thing witha buch of other variables
-dependency :: HasVariables t => Name -> t -> DependGraph
-dependency x (freeVarSet -> xs) = Graph.dependency x xs
-
--- | Everything to the left depends on everything from the right, except themselves
-irreflexiveDependencyOn ::
-  forall t t'. (HasVariables t, HasVariables t') => t -> t' -> DependGraph
-irreflexiveDependencyOn (freeVarSet -> xs) (freeVarSet -> ys) = Graph.irreflexiveDependencyOn xs ys
-
--- | These variables are free
-noDependencies :: HasVariables t => t -> DependGraph
-noDependencies (freeVarSet -> xs) = Graph.noDependencies xs
-
--- | Hints from `dependsOn`
-type Hints = DependGraph
-
--- | Adjust a `DependGraph` to some `Hints`
-respecting :: Hints -> DependGraph -> DependGraph
-respecting hints g = g `subtractGraph` opGraph hints
-
--- | Given a dependency graph, are all the presrequisites of a variable covered by the set?
-solvableFrom :: Name -> Set Name -> DependGraph -> Bool
-solvableFrom x s g =
-  let less = dependencies x g
-   in s `Set.isSubsetOf` less && not (x `Set.member` less)
-
--- | Get the dependencies that appear in a `Pred`
-computeDependencies :: Pred -> DependGraph
-computeDependencies = \case
-  ElemPred _bool term _xs -> computeTermDependencies term
-  Monitor {} -> mempty
-  Subst x t p -> computeDependencies (substitutePred x t p)
-  Assert t -> computeTermDependencies t
-  Reifies t' t _ -> t' `irreflexiveDependencyOn` t
-  ForAll set b ->
-    let innerG = computeBinderDependencies b
-     in innerG <> set `irreflexiveDependencyOn` nodes innerG
-  x `DependsOn` y -> x `irreflexiveDependencyOn` y
-  Case t bs ->
-    let innerG = foldMapList (computeBinderDependencies . thing) bs
-     in innerG <> t `irreflexiveDependencyOn` nodes innerG
-  When b p ->
-    let pG = computeDependencies p
-        oG = nodes pG `irreflexiveDependencyOn` b
-     in oG <> pG
-  TruePred -> mempty
-  FalsePred {} -> mempty
-  And ps -> foldMap computeDependencies ps
-  Exists _ b -> computeBinderDependencies b
-  Let t b -> noDependencies t <> computeBinderDependencies b
-  GenHint _ t -> noDependencies t
-  Explain _ p -> computeDependencies p
-
-computeBinderDependencies :: Binder a -> DependGraph
-computeBinderDependencies (x :-> p) =
-  deleteNode (Name x) $ computeDependencies p
-
-computeTermDependencies :: Term a -> DependGraph
-computeTermDependencies = fst . computeTermDependencies'
-
-computeTermDependencies' :: Term a -> (DependGraph, Set Name)
-computeTermDependencies' = \case
-  (App _ args) -> go args
-  Lit {} -> (mempty, mempty)
-  (V x) -> (noDependencies (Name x), Set.singleton (Name x))
-  where
-    go :: List Term as -> (DependGraph, Set Name)
-    go Nil = (mempty, mempty)
-    go (t :> ts) =
-      let (gr, ngr) = go ts
-          (tgr, ntgr) = computeTermDependencies' t
-       in (ntgr `irreflexiveDependencyOn` ngr <> tgr <> gr, ngr <> ntgr)
diff --git a/libs/constrained-generators/src/Constrained/Test.hs b/libs/constrained-generators/src/Constrained/Test.hs
deleted file mode 100644
index 200d0fbd8a3..00000000000
--- a/libs/constrained-generators/src/Constrained/Test.hs
+++ /dev/null
@@ -1,425 +0,0 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE NumericUnderscores #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# OPTIONS_GHC -Wno-orphans #-}
-
--- | Useful properties for debugging HasSpec instances and this library itself
-module Constrained.Test (
-  prop_sound,
-  prop_constrained_satisfies_sound,
-  prop_constrained_explained,
-  prop_complete,
-  prop_constrained_satisfies_complete,
-  prop_shrink_sound,
-  prop_conformEmpty,
-  prop_univSound,
-  prop_mapSpec,
-  prop_propagateSpecSound,
-  prop_gen_sound,
-  specType,
-) where
-
-import Constrained.API.Extend
-import Constrained.Base
-import Constrained.Core
-import Constrained.FunctionSymbol
-import Constrained.GenT
-import Constrained.Generation
-import Constrained.List
-import Constrained.NumOrd
-import Constrained.PrettyUtils
-import Constrained.Spec.List
-import Constrained.Spec.Map
-import Constrained.Spec.Set
-import Constrained.TheKnot
-import Data.List (nub)
-import qualified Data.List.NonEmpty as NE
-import Data.Map (Map)
-import Data.Set (Set)
-import Data.Typeable (Typeable, typeOf)
-import Prettyprinter
-import Test.QuickCheck hiding (Fun)
-import qualified Test.QuickCheck as QC
-
--- | Check that a generator from a given `Specification` is sound, it never
--- generates a bad value that doesn't satisfy the constraint
-prop_sound ::
-  HasSpec a =>
-  Specification a ->
-  QC.Property
-prop_sound spec =
-  QC.forAllBlind (strictGen $ genFromSpecT spec) $ \ma ->
-    case ma of
-      Result a ->
-        QC.cover 80 True "successful" $
-          QC.counterexample (show a) $
-            monitorSpec spec a $
-              conformsToSpecProp a spec
-      _ -> QC.cover 80 False "successful" True
-
--- | Modify the `Specification` in `prop_sound` to test re-use
-prop_constrained_satisfies_sound :: HasSpec a => Specification a -> QC.Property
-prop_constrained_satisfies_sound spec = prop_sound (constrained $ \a -> satisfies a spec)
-
--- | Check that explanations don't immediately ruin soundness
-prop_constrained_explained :: HasSpec a => Specification a -> QC.Property
-prop_constrained_explained spec =
-  QC.forAll QC.arbitrary $ \es ->
-    prop_sound $ constrained $ \x -> Explain es $ x `satisfies` spec
-
--- | `prop_complete ps` assumes that `ps` is satisfiable and checks that it doesn't crash
-prop_complete :: HasSpec a => Specification a -> QC.Property
-prop_complete s =
-  QC.forAllBlind (strictGen $ genFromSpecT s) $ \ma -> fromGEProp $ do
-    a <- ma
-    -- Force the value to make sure we don't crash with `error` somewhere
-    -- or fall into an inifinite loop
-    pure $ length (show a) > 0
-
--- | Like `prop_constrained_satisfies_sound` for completeness
-prop_constrained_satisfies_complete :: HasSpec a => Specification a -> QC.Property
-prop_constrained_satisfies_complete spec = prop_complete (constrained $ \a -> satisfies a spec)
-
--- | Check that shrinking preserves constraint adherence
-prop_shrink_sound :: HasSpec a => Specification a -> QC.Property
-prop_shrink_sound s =
-  QC.forAll (strictGen $ genFromSpecT s) $ \ma -> fromGEDiscard $ do
-    a <- ma
-    let shrinks = shrinkWithSpec s a
-    pure $
-      QC.cover 40 (not $ null shrinks) "non-null shrinks" $
-        if null shrinks
-          then QC.property True
-          else QC.forAll (QC.elements shrinks) $ \a' ->
-            conformsToSpecProp a' s
-
--- | Check that anything conforms to the trivial specification
-prop_conformEmpty ::
-  forall a.
-  HasSpec a =>
-  a ->
-  QC.Property
-prop_conformEmpty a = QC.property $ conformsTo a (emptySpec @a)
-
--- | Check that propagation works properly
-prop_univSound :: TestableFn -> QC.Property
-prop_univSound (TestableFn (fn :: t as b)) =
-  QC.label (show fn) $
-    QC.forAllShrinkBlind @QC.Property (QC.arbitrary @(TestableCtx as)) QC.shrink $ \tc@(TestableCtx ctx) ->
-      QC.forAllShrinkBlind QC.arbitrary QC.shrink $ \spec ->
-        QC.counterexample ("\nfn ctx = " ++ showCtxWith fn tc) $
-          QC.counterexample (show $ "\nspec =" <+> pretty spec) $
-            let sspec = simplifySpec (propagate fn ctx spec)
-             in QC.counterexample ("\n" ++ show ("propagate ctx spec =" /> pretty sspec)) $
-                  QC.counterexample ("\n" ++ show (prettyPlan sspec)) $
-                    QC.within 20_000_000 $
-                      QC.forAllBlind (strictGen $ genFromSpecT sspec) $ \ge ->
-                        fromGEDiscard $ do
-                          a <- ge
-                          let res = uncurryList_ unValue (semantics fn) $ fillListCtx ctx $ \HOLE -> Value a
-                          pure $
-                            QC.counterexample ("\ngenerated value: a = " ++ show a) $
-                              QC.counterexample ("\nfn ctx[a] = " ++ show res) $
-                                conformsToSpecProp res spec
-
--- | Similar to `prop_sound`
-prop_gen_sound :: forall a. HasSpec a => Specification a -> QC.Property
-prop_gen_sound spec =
-  let sspec = simplifySpec spec
-   in QC.tabulate "specType spec" [specType spec] $
-        QC.tabulate "specType (simplifySpec spec)" [specType sspec] $
-          QC.counterexample ("\n" ++ show (prettyPlan sspec)) $
-            QC.forAllBlind (strictGen $ genFromSpecT @a @GE sspec) $ \ge ->
-              fromGEDiscard $ do
-                a <- ge
-                pure $
-                  QC.counterexample ("\ngenerated value: a = " ++ show a) $
-                    conformsToSpecProp a spec
-
--- | Pretty-print the type of a spec for test statistics, @"SuspendedSpec"@, @"MemberSpec"@, etc.
-specType :: Specification a -> String
-specType (ExplainSpec [] s) = specType s
-specType (ExplainSpec _ s) = "(ExplainSpec " ++ specType s ++ ")"
-specType SuspendedSpec {} = "SuspendedSpec"
-specType ErrorSpec {} = "ErrorSpec"
-specType MemberSpec {} = "MemberSpec"
-specType TypeSpec {} = "TypeSpec"
-specType TrueSpec {} = "TrueSpec"
-
--- ============================================================
--- An abstraction that hides everything about a function symbol
--- But includes inside in the constraints, everything needed to
--- use the function symbol
-
-showCtxWith ::
-  forall fn as b.
-  AppRequires fn as b =>
-  fn as b ->
-  TestableCtx as ->
-  String
-showCtxWith fn (TestableCtx ctx) = show tm
-  where
-    tm :: Term b
-    tm =
-      uncurryList (appTerm fn) $
-        fillListCtx (mapListCtxC @HasSpec @_ @Value @Term (lit @_ . unValue) ctx) (\HOLE -> V $ Var 0 "v")
-
-data TestableFn where
-  TestableFn ::
-    ( QC.Arbitrary (Specification b)
-    , Typeable (FunTy as b)
-    , AppRequires t as b
-    ) =>
-    t as b ->
-    TestableFn
-
-instance Show TestableFn where
-  show (TestableFn (fn :: t as b)) =
-    show fn ++ " :: " ++ show (typeOf (undefined :: FunTy as b))
-
--- | Check that `mapSpec` is correct
-prop_mapSpec ::
-  ( HasSpec a
-  , AppRequires t '[a] b
-  ) =>
-  t '[a] b ->
-  Specification a ->
-  QC.Property
-prop_mapSpec funsym spec =
-  QC.forAll (strictGen $ genFromSpecT spec) $ \ma -> fromGEDiscard $ do
-    a <- ma
-    pure $ conformsToSpec (semantics funsym a) (mapSpec funsym spec)
-
--- | Check that propagation is correct via `genInverse`
-prop_propagateSpecSound ::
-  ( HasSpec a
-  , AppRequires t '[a] b
-  ) =>
-  t '[a] b ->
-  b ->
-  QC.Property
-prop_propagateSpecSound funsym b =
-  QC.forAll (strictGen $ genInverse (Fun funsym) TrueSpec b) $ \ma -> fromGEDiscard $ do
-    a <- ma
-    pure $ semantics funsym a == b
-
-------------------------------------------------------------------------
--- Arbitrary instances for Specifications
-------------------------------------------------------------------------
-
-instance (Arbitrary (Specification a), Arbitrary (Specification b)) => Arbitrary (SumSpec a b) where
-  arbitrary =
-    SumSpec
-      <$> frequency
-        [ (3, pure Nothing)
-        , (10, Just <$> ((,) <$> choose (0, 100) <*> choose (0, 100)))
-        , (1, arbitrary)
-        ]
-      <*> arbitrary
-      <*> arbitrary
-  shrink (SumSpec h a b) = [SumSpec h' a' b' | (h', a', b') <- shrink (h, a, b)]
-
-instance (Arbitrary (Specification a), Arbitrary (Specification b)) => Arbitrary (PairSpec a b) where
-  arbitrary = Cartesian <$> arbitrary <*> arbitrary
-  shrink (Cartesian a b) = uncurry Cartesian <$> shrink (a, b)
-
--- TODO: consider making this more interesting to get fewer discarded tests
--- in `prop_gen_sound`
-instance
-  ( Arbitrary k
-  , Arbitrary v
-  , Arbitrary (TypeSpec k)
-  , Arbitrary (TypeSpec v)
-  , Ord k
-  , HasSpec k
-  , Foldy v
-  ) =>
-  Arbitrary (MapSpec k v)
-  where
-  arbitrary =
-    MapSpec
-      <$> arbitrary
-      <*> arbitrary
-      <*> arbitrary
-      <*> arbitrary
-      <*> arbitrary
-      <*> frequency [(1, pure NoFold), (1, arbitrary)]
-  shrink = genericShrink
-
-instance Arbitrary (FoldSpec (Map k v)) where
-  arbitrary = pure NoFold
-
-instance (HasSpec a, Arbitrary (TypeSpec a)) => Arbitrary (Specification a) where
-  arbitrary = do
-    baseSpec <-
-      frequency
-        [ (1, pure TrueSpec)
-        ,
-          ( 7
-          , do
-              zs <- nub <$> listOf1 (genFromSpec TrueSpec)
-              pure
-                ( memberSpec
-                    zs
-                    ( NE.fromList
-                        [ "In (Arbitrary Specification) this should never happen"
-                        , "listOf1 generates empty list."
-                        ]
-                    )
-                )
-          )
-        , (10, typeSpec <$> arbitrary)
-        ,
-          ( 1
-          , do
-              len <- choose (1, 5)
-              TypeSpec <$> arbitrary <*> vectorOf len (genFromSpec TrueSpec)
-          )
-        , (1, ErrorSpec <$> arbitrary)
-        , -- Recurse to make sure we apply the tricks for generating suspended specs multiple times
-          (1, arbitrary)
-        ]
-    -- TODO: we probably want smarter ways of generating constraints
-    frequency
-      [ (1, pure $ constrained $ \x -> x `satisfies` baseSpec)
-      , (1, ExplainSpec ["Arbitrary"] <$> arbitrary)
-      ,
-        ( 1
-        , pure $ constrained $ \x -> exists (\eval -> pure $ eval x) $ \y ->
-            [ assert $ x ==. y
-            , y `satisfies` baseSpec
-            ]
-        )
-      , (1, pure $ constrained $ \x -> letBind x $ \y -> y `satisfies` baseSpec)
-      ,
-        ( 1
-        , pure $ constrained $ \x -> exists (\_ -> pure True) $ \b ->
-            ifElse b (x `satisfies` baseSpec) (x `satisfies` baseSpec)
-        )
-      ,
-        ( 1
-        , pure $ constrained $ \x -> exists (\_ -> pure True) $ \b ->
-            [ ifElse b True (x `satisfies` baseSpec)
-            , x `satisfies` baseSpec
-            ]
-        )
-      ,
-        ( 1
-        , pure $ constrained $ \x -> exists (\_ -> pure False) $ \b ->
-            [ ifElse b (x `satisfies` baseSpec) True
-            , x `satisfies` baseSpec
-            ]
-        )
-      ,
-        ( 1
-        , pure $ constrained $ \x -> explanation (pure "its very subtle, you won't get it.") $ x `satisfies` baseSpec
-        )
-      , (10, pure baseSpec)
-      ]
-
-instance
-  ( Arbitrary a
-  , Arbitrary (FoldSpec a)
-  , Arbitrary (TypeSpec a)
-  , HasSpec a
-  ) =>
-  Arbitrary (ListSpec a)
-  where
-  arbitrary = ListSpec <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
-  shrink (ListSpec a b c d e) = [ListSpec a' b' c' d' e' | (a', b', c', d', e') <- shrink (a, b, c, d, e)]
-
-instance {-# OVERLAPPABLE #-} (Arbitrary (Specification a), Foldy a) => Arbitrary (FoldSpec a) where
-  arbitrary = oneof [FoldSpec (Fun IdW) <$> arbitrary, pure NoFold]
-  shrink NoFold = []
-  shrink (FoldSpec (Fun (getWitness -> Just IdW)) spec) = FoldSpec (Fun IdW) <$> shrink spec
-  shrink FoldSpec {} = [NoFold]
-
-instance (Ord a, Arbitrary (Specification a), Arbitrary a) => Arbitrary (SetSpec a) where
-  arbitrary = SetSpec <$> arbitrary <*> arbitrary <*> arbitrary
-  shrink (SetSpec a b c) = [SetSpec a' b' c' | (a', b', c') <- shrink (a, b, c)]
-
--- TODO: consider improving this
-instance Arbitrary (FoldSpec (Set a)) where
-  arbitrary = pure NoFold
-
-------------------------------------------------------------------------
--- Random contexts
-------------------------------------------------------------------------
-
-data TestableCtx as where
-  TestableCtx ::
-    HasSpec a =>
-    ListCtx Value as (HOLE a) ->
-    TestableCtx as
-
-instance forall as. (All HasSpec as, TypeList as) => QC.Arbitrary (TestableCtx as) where
-  arbitrary = do
-    let shape = listShape @as
-    idx <- QC.choose (0, lengthList shape - 1)
-    go idx shape
-    where
-      go :: forall f as'. All HasSpec as' => Int -> List f as' -> QC.Gen (TestableCtx as')
-      go 0 (_ :> as) =
-        TestableCtx . (HOLE :?) <$> mapMListC @HasSpec (\_ -> Value <$> genFromSpec TrueSpec) as
-      go n (_ :> as) = do
-        TestableCtx ctx <- go (n - 1) as
-        TestableCtx . (:! ctx) . Value <$> genFromSpec TrueSpec
-      go _ _ = error "The impossible happened in Arbitrary for TestableCtx"
-
-  shrink (TestableCtx ctx) = TestableCtx <$> shrinkCtx ctx
-    where
-      shrinkCtx :: forall c as'. All HasSpec as' => ListCtx Value as' c -> [ListCtx Value as' c]
-      shrinkCtx (c :? as) = (c :?) <$> go as
-      shrinkCtx (Value a :! ctx') = map ((:! ctx') . Value) (shrinkWithSpec TrueSpec a) ++ map (Value a :!) (shrinkCtx ctx')
-
-      go :: forall as'. All HasSpec as' => List Value as' -> [List Value as']
-      go Nil = []
-      go (Value a :> as) = map ((:> as) . Value) (shrinkWithSpec TrueSpec a) ++ map (Value a :>) (go as)
-
-instance QC.Arbitrary TestableFn where
-  arbitrary =
-    QC.elements
-      [ -- data IntW
-        TestableFn $ AddW @Int
-      , TestableFn $ NegateW @Int
-      , TestableFn $ SizeOfW @(Map Int Int)
-      , -- data BaseW
-        TestableFn $ EqualW @Int
-      , TestableFn $ ProdFstW @Int @Int
-      , TestableFn $ ProdSndW @Int @Int
-      , TestableFn $ ProdW @Int @Int
-      , TestableFn $ InjRightW @Int @Int
-      , TestableFn $ InjLeftW @Int @Int
-      , TestableFn $ ElemW @Int
-      , TestableFn $ FromGenericW @(Either Int Bool)
-      , TestableFn $ ToGenericW @(Either Int Bool)
-      , -- data SetW
-        TestableFn $ SingletonW @Int
-      , TestableFn $ UnionW @Int
-      , TestableFn $ SubsetW @Int
-      , TestableFn $ MemberW @Int
-      , TestableFn $ DisjointW @Int
-      , TestableFn $ FromListW @Int
-      , -- data BoolW
-        TestableFn $ NotW
-      , TestableFn $ OrW
-      , -- data OrdW
-        TestableFn $ LessW @Int
-      , TestableFn $ LessOrEqualW @Int
-      , -- data MapW
-        TestableFn $ RngW @Int @Int
-      , TestableFn $ DomW @Int @Int
-      , TestableFn $ LookupW @Int @Int
-      , -- data ListW
-        TestableFn $ FoldMapW @Int (Fun IdW)
-      , TestableFn $ SingletonListW @Int
-      , TestableFn $ AppendW @Int
-      ]
-  shrink _ = []
diff --git a/libs/constrained-generators/src/Constrained/TheKnot.hs b/libs/constrained-generators/src/Constrained/TheKnot.hs
deleted file mode 100644
index 2b967cae936..00000000000
--- a/libs/constrained-generators/src/Constrained/TheKnot.hs
+++ /dev/null
@@ -1,480 +0,0 @@
-{-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DefaultSignatures #-}
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE DeriveTraversable #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE ImpredicativeTypes #-}
-{-# LANGUAGE InstanceSigs #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE PatternSynonyms #-}
-{-# LANGUAGE PolyKinds #-}
-{-# LANGUAGE QuantifiedConstraints #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE UndecidableSuperClasses #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# OPTIONS_GHC -Wno-orphans -Wno-name-shadowing #-}
-
--- | All the things that are mutually recursive.
-module Constrained.TheKnot (
-  FunW (..),
-  ProdW (..),
-  SizeW (..),
-  PairSpec (..),
-  ifElse,
-  sizeOf_,
-
-  -- * Useful internal function symbols
-  prodFst_,
-  prodSnd_,
-  prod_,
-
-  -- * Misc
-  genFromSizeSpec,
-  maxSpec,
-  rangeSize,
-  hasSize,
-  genInverse,
-  mapSpec,
-  between,
-
-  -- * Patterns
-  pattern Product,
-
-  -- * Classes
-  Sized (..),
-) where
-
-import Constrained.AbstractSyntax
-import Constrained.Base
-import Constrained.Conformance
-import Constrained.Core
-import Constrained.FunctionSymbol
-import Constrained.GenT
-import Constrained.Generation
-import Constrained.Generic
-import Constrained.List
-import Constrained.NumOrd
-import Constrained.PrettyUtils
-import Constrained.SumList
--- TODO: some strange things here, why is SolverStage in here?!
--- Because it is mutually recursive with something else in here.
-import Constrained.Syntax
-import Control.Applicative
-import Control.Monad
-import Data.Foldable
-import Data.Kind
-import Data.List (nub)
-import qualified Data.List.NonEmpty as NE
-import Data.Maybe
-import Data.Typeable
-import Prettyprinter hiding (cat)
-import Prelude hiding (cycle, pred)
-
-instance Numeric a => Complete a where
-  simplifyA = simplifySpec
-  genFromSpecA = genFromSpecT
-
--- | If the `Specification Bool` doesn't constrain the boolean you will get a `TrueSpec` out.
-ifElse :: (IsPred p, IsPred q) => Term Bool -> p -> q -> Pred
-ifElse b p q = whenTrue b p <> whenTrue (not_ b) q
-
--- --------------- Simplification of Sum types --------------------
-
--- =======================================================================================
-
--- | Functor like property for Specification, but instead of a Haskell function (a -> b),
---   it takes a function symbol (t '[a] b) from a to b.
---   Note, in this context, a function symbol is some constructor of a witnesstype.
---   Eg. ProdFstW, InjRightW, SingletonW, etc. NOT the lifted versions like fst_ singleton_,
---   which construct Terms. We had to wait until here to define this because it
---   depends on Semigroup property of Specification, and Asserting equality
-mapSpec ::
-  forall t a b.
-  AppRequires t '[a] b =>
-  t '[a] b ->
-  Specification a ->
-  Specification b
-mapSpec f (ExplainSpec es s) = explainSpec es (mapSpec f s)
-mapSpec f TrueSpec = mapTypeSpec f (emptySpec @a)
-mapSpec _ (ErrorSpec err) = ErrorSpec err
-mapSpec f (MemberSpec as) = MemberSpec $ NE.nub $ fmap (semantics f) as
-mapSpec f (SuspendedSpec x p) =
-  constrained $ \x' ->
-    Exists (\_ -> fatalError "mapSpec") (x :-> fold [Assert $ (x' ==. appTerm f (V x)), p])
-mapSpec f (TypeSpec ts cant) = mapTypeSpec f ts <> notMemberSpec (map (semantics f) cant)
-
--- ================================================================
--- HasSpec for Products
--- ================================================================
-
-pairView :: Term (Prod a b) -> Maybe (Term a, Term b)
-pairView (App (getWitness -> Just ProdW) (x :> y :> Nil)) = Just (x, y)
-pairView _ = Nothing
-
-cartesian ::
-  forall a b.
-  (HasSpec a, HasSpec b) =>
-  Specification a ->
-  Specification b ->
-  Specification (Prod a b)
-cartesian (ErrorSpec es) (ErrorSpec fs) = ErrorSpec (es <> fs)
-cartesian (ErrorSpec es) _ = ErrorSpec (NE.cons "cartesian left" es)
-cartesian _ (ErrorSpec es) = ErrorSpec (NE.cons "cartesian right" es)
-cartesian s s' = typeSpec $ Cartesian s s'
-
--- | t`TypeSpec` for @`Prod` a b@
-data PairSpec a b = Cartesian (Specification a) (Specification b)
-
-instance (HasSpec a, HasSpec b) => HasSpec (Prod a b) where
-  type TypeSpec (Prod a b) = PairSpec a b
-
-  type Prerequisites (Prod a b) = (HasSpec a, HasSpec b)
-
-  emptySpec = Cartesian mempty mempty
-
-  combineSpec (Cartesian a b) (Cartesian a' b') = cartesian (a <> a') (b <> b')
-
-  conformsTo (Prod a b) (Cartesian sa sb) = conformsToSpec a sa && conformsToSpec b sb
-
-  genFromTypeSpec (Cartesian sa sb) = Prod <$> genFromSpecT sa <*> genFromSpecT sb
-
-  shrinkWithTypeSpec (Cartesian sa sb) (Prod a b) =
-    [Prod a' b | a' <- shrinkWithSpec sa a]
-      ++ [Prod a b' | b' <- shrinkWithSpec sb b]
-
-  toPreds x (Cartesian sf ss) =
-    satisfies (prodFst_ x) sf
-      <> satisfies (prodSnd_ x) ss
-
-  cardinalTypeSpec (Cartesian x y) = (cardinality x) + (cardinality y)
-
-  typeSpecHasError (Cartesian x y) =
-    case (isErrorLike x, isErrorLike y) of
-      (False, False) -> Nothing
-      (True, False) -> Just $ errorLikeMessage x
-      (False, True) -> Just $ errorLikeMessage y
-      (True, True) -> Just $ (errorLikeMessage x <> errorLikeMessage y)
-
-  alternateShow (Cartesian left right@(TypeSpec r [])) =
-    case alternateShow @b r of
-      (BinaryShow "Cartesian" ps) -> BinaryShow "Cartesian" ("," <+> viaShow left : ps)
-      (BinaryShow "SumSpec" ps) -> BinaryShow "Cartesian" ("," <+> viaShow left : ["SumSpec" /> vsep ps])
-      _ -> BinaryShow "Cartesian" ["," <+> viaShow left, "," <+> viaShow right]
-  alternateShow (Cartesian left right) = BinaryShow "Cartesian" ["," <+> viaShow left, "," <+> viaShow right]
-
-instance (HasSpec a, HasSpec b) => Show (PairSpec a b) where
-  show pair@(Cartesian l r) = case alternateShow @(Prod a b) pair of
-    (BinaryShow "Cartesian" ps) -> show $ parens ("Cartesian" /> vsep ps)
-    _ -> "(Cartesian " ++ "(" ++ show l ++ ") (" ++ show r ++ "))"
-
--- ==================================================
--- Logic instances for Prod
--- ==================================================
-
--- | Function symbols for talking about `Prod`
-data ProdW :: [Type] -> Type -> Type where
-  ProdW :: (HasSpec a, HasSpec b) => ProdW '[a, b] (Prod a b)
-  ProdFstW :: (HasSpec a, HasSpec b) => ProdW '[Prod a b] a
-  ProdSndW :: (HasSpec a, HasSpec b) => ProdW '[Prod a b] b
-
-deriving instance Eq (ProdW as b)
-
-deriving instance Show (ProdW as b)
-
-instance Syntax ProdW
-
-instance Semantics ProdW where
-  semantics ProdW = Prod
-  semantics ProdFstW = prodFst
-  semantics ProdSndW = prodSnd
-
-instance Logic ProdW where
-  propagateTypeSpec ProdFstW (Unary HOLE) ts cant = cartesian (TypeSpec ts cant) TrueSpec
-  propagateTypeSpec ProdSndW (Unary HOLE) ts cant =
-    cartesian TrueSpec (TypeSpec ts cant)
-  propagateTypeSpec ProdW (a :>: HOLE) sc@(Cartesian sa sb) cant
-    | a `conformsToSpec` sa = sb <> foldMap notEqualSpec (sameFst a cant)
-    | otherwise =
-        ErrorSpec
-          ( NE.fromList
-              ["propagate (pair_ " ++ show a ++ " HOLE) has conformance failure on a", show (TypeSpec sc cant)]
-          )
-  propagateTypeSpec ProdW (HOLE :<: b) sc@(Cartesian sa sb) cant
-    | b `conformsToSpec` sb = sa <> foldMap notEqualSpec (sameSnd b cant)
-    | otherwise =
-        ErrorSpec
-          ( NE.fromList
-              ["propagate (pair_ HOLE " ++ show b ++ ") has conformance failure on b", show (TypeSpec sc cant)]
-          )
-
-  propagateMemberSpec ProdFstW (Unary HOLE) es = cartesian (MemberSpec es) TrueSpec
-  propagateMemberSpec ProdSndW (Unary HOLE) es = cartesian TrueSpec (MemberSpec es)
-  propagateMemberSpec ProdW (a :>: HOLE) es =
-    case (nub (sameFst a (NE.toList es))) of
-      (w : ws) -> MemberSpec (w :| ws)
-      [] ->
-        ErrorSpec $
-          NE.fromList
-            [ "propagate (pair_ HOLE " ++ show a ++ ") on (MemberSpec " ++ show (NE.toList es)
-            , "Where " ++ show a ++ " does not appear as the fst component of anything in the MemberSpec."
-            ]
-  propagateMemberSpec ProdW (HOLE :<: b) es =
-    case (nub (sameSnd b (NE.toList es))) of
-      (w : ws) -> MemberSpec (w :| ws)
-      [] ->
-        ErrorSpec $
-          NE.fromList
-            [ "propagate (pair_ HOLE " ++ show b ++ ") on (MemberSpec " ++ show (NE.toList es)
-            , "Where " ++ show b ++ " does not appear as the snd component of anything in the MemberSpec."
-            ]
-
-  rewriteRules ProdFstW ((pairView -> Just (x, _)) :> Nil) Evidence = Just x
-  rewriteRules ProdSndW ((pairView -> Just (_, y)) :> Nil) Evidence = Just y
-  rewriteRules _ _ _ = Nothing
-
-  mapTypeSpec ProdFstW (Cartesian s _) = s
-  mapTypeSpec ProdSndW (Cartesian _ s) = s
-
--- | `fst` on `Prod`
-prodFst_ :: (HasSpec a, HasSpec b) => Term (Prod a b) -> Term a
-prodFst_ = appTerm ProdFstW
-
--- | `snd` on `Prod`
-prodSnd_ :: (HasSpec a, HasSpec b) => Term (Prod a b) -> Term b
-prodSnd_ = appTerm ProdSndW
-
--- | `(,)` on `Prod`
-prod_ :: (HasSpec a, HasSpec b) => Term a -> Term b -> Term (Prod a b)
-prod_ = appTerm ProdW
-
-sameFst :: Eq a1 => a1 -> [Prod a1 a2] -> [a2]
-sameFst a ps = [b | Prod a' b <- ps, a == a']
-
-sameSnd :: Eq a1 => a1 -> [Prod a2 a1] -> [a2]
-sameSnd b ps = [a | Prod a b' <- ps, b == b']
-
--- | Pattern for `prod_`
-pattern Product ::
-  forall c.
-  () =>
-  forall a b.
-  ( c ~ Prod a b
-  , AppRequires ProdW '[a, b] (Prod a b)
-  ) =>
-  Term a ->
-  Term b ->
-  Term c
-pattern Product x y <- (App (getWitness -> Just ProdW) (x :> y :> Nil))
-
--- ================================================================
--- The TypeSpec for List. Used in the HasSpec instance for Lists
--- ================================================================
-
--- | Generalized `length` function
-sizeOf_ :: (HasSpec a, Sized a) => Term a -> Term Integer
-sizeOf_ = curryList (App SizeOfW)
-
--- | Because Sizes should always be >= 0, We provide this alternate generator
---   that can be used to replace (genFromSpecT @Integer), to ensure this important property
-genFromSizeSpec :: MonadGenError m => Specification Integer -> GenT m Integer
-genFromSizeSpec integerSpec = genFromSpecT (integerSpec <> geqSpec 0)
-
--- =====================================================================
--- Syntax, Semantics and Logic instances for function symbols on List
-
--- ==============  Helper functions
-
--- ================
--- Sized
--- ================
-
-type SizeSpec = NumSpec Integer
-
--- | The things we need to talk about the `sizeOf_` a thing
-class Sized t where
-  sizeOf :: t -> Integer
-  default sizeOf :: (HasSimpleRep t, Sized (SimpleRep t)) => t -> Integer
-  sizeOf = sizeOf . toSimpleRep
-
-  liftSizeSpec :: HasSpec t => SizeSpec -> [Integer] -> Specification t
-  default liftSizeSpec ::
-    ( Sized (SimpleRep t)
-    , GenericRequires t
-    ) =>
-    SizeSpec ->
-    [Integer] ->
-    Specification t
-  liftSizeSpec sz cant = fromSimpleRepSpec $ liftSizeSpec sz cant
-
-  liftMemberSpec :: HasSpec t => [Integer] -> Specification t
-  default liftMemberSpec ::
-    ( Sized (SimpleRep t)
-    , GenericRequires t
-    ) =>
-    [Integer] ->
-    Specification t
-  liftMemberSpec = fromSimpleRepSpec . liftMemberSpec
-
-  sizeOfTypeSpec :: HasSpec t => TypeSpec t -> Specification Integer
-  default sizeOfTypeSpec ::
-    ( HasSpec (SimpleRep t)
-    , Sized (SimpleRep t)
-    , TypeSpec t ~ TypeSpec (SimpleRep t)
-    ) =>
-    TypeSpec t ->
-    Specification Integer
-  sizeOfTypeSpec = sizeOfTypeSpec @(SimpleRep t)
-
--- =============================================================
--- All Foldy class instances are over Numbers (so far).
--- Foldy class requires higher order functions, so here they are.
--- Note this is a new witness type, different from BaseW
--- but serving the same purpose. Note it can take Witnesses from
--- other classes as inputs. See ComposeW
--- ==============================================================
-
--- | Function symbols for basic higher-order functions
-data FunW (dom :: [Type]) (rng :: Type) where
-  IdW :: forall a. FunW '[a] a
-  ComposeW ::
-    forall b t1 t2 a r.
-    ( AppRequires t1 '[b] r
-    , AppRequires t2 '[a] b
-    , HasSpec b
-    ) =>
-    t1 '[b] r ->
-    t2 '[a] b ->
-    FunW '[a] r
-
-instance Semantics FunW where
-  semantics IdW = id
-  semantics (ComposeW f g) = semantics f . semantics g
-
-instance Syntax FunW
-
-instance Show (FunW dom rng) where
-  show IdW = "id_"
-  show (ComposeW x y) = "(compose_ " ++ show x ++ " " ++ show y ++ ")"
-
-instance Eq (FunW dom rng) where
-  IdW == IdW = True
-  ComposeW f f' == ComposeW g g' = compareWit f g && compareWit f' g'
-  _ == _ = False
-
-compareWit ::
-  forall t1 bs1 r1 t2 bs2 r2.
-  (AppRequires t1 bs1 r1, AppRequires t2 bs2 r2) =>
-  t1 bs1 r1 ->
-  t2 bs2 r2 ->
-  Bool
-compareWit x y = case (eqT @t1 @t2, eqT @bs1 @bs2, eqT @r1 @r2) of
-  (Just Refl, Just Refl, Just Refl) -> x == y
-  _ -> False
-
--- ===================================
--- Logic instances for IdW and ComposeW
-
-instance Logic FunW where
-  propagate IdW (Unary HOLE) = id
-  propagate (ComposeW f g) (Unary HOLE) = propagate g (Unary HOLE) . propagate f (Unary HOLE)
-
-  mapTypeSpec IdW ts = typeSpec ts
-  mapTypeSpec (ComposeW g h) ts = mapSpec g . mapSpec h $ typeSpec ts
-
-  -- Note we need the Evidence to apply App to f, and to apply App to g
-  rewriteRules (ComposeW f g) (x :> Nil) Evidence = Just $ App f (App g (x :> Nil) :> Nil)
-  rewriteRules IdW (x :> Nil) Evidence = Just x
-
--- =======================================================
--- The Foldy class instances for Numbers
--- =======================================================
-
--- | Invert a `Fun` and combine it with a `Specification` for the input to
--- generate a value
-genInverse ::
-  ( MonadGenError m
-  , HasSpec a
-  , HasSpec b
-  ) =>
-  Fun '[a] b ->
-  Specification a ->
-  b ->
-  GenT m a
-genInverse (Fun f) argS x =
-  let argSpec' = argS <> propagate f (HOLE :? Nil) (equalSpec x)
-   in explainNE
-        ( NE.fromList
-            [ "genInverse"
-            , "  f = " ++ show f
-            , show $ "  argS =" <+> pretty argS
-            , "  x = " ++ show x
-            , show $ "  argSpec' =" <+> pretty argSpec'
-            ]
-        )
-        $ genFromSpecT argSpec'
-
--- | Function symbols for generalized `length` and `Data.Set.size` functions.
--- Used to implement `sizeOf_`.
-data SizeW (dom :: [Type]) rng :: Type where
-  SizeOfW :: (Sized n, HasSpec n) => SizeW '[n] Integer
-
-deriving instance Eq (SizeW ds r)
-
-instance Show (SizeW d r) where
-  show SizeOfW = "sizeOf_"
-
-instance Semantics SizeW where
-  semantics SizeOfW = sizeOf -- From the Sized class.
-
-instance Syntax SizeW
-
-instance Logic SizeW where
-  propagateTypeSpec SizeOfW (Unary HOLE) ts cant = liftSizeSpec ts cant
-
-  propagateMemberSpec SizeOfW (Unary HOLE) es = liftMemberSpec (NE.toList es)
-
-  mapTypeSpec (SizeOfW :: SizeW '[a] b) ts =
-    constrained $ \x ->
-      unsafeExists $ \x' -> Assert (x ==. sizeOf_ x') <> toPreds @a x' ts
-
--- ======================================
-
--- | A spec for a positive non-empty range
-rangeSize :: Integer -> Integer -> SizeSpec
-rangeSize a b | a < 0 || b < 0 = error ("Negative Int in call to rangeSize: " ++ show a ++ " " ++ show b)
-rangeSize a b = NumSpecInterval (Just a) (Just b)
-
--- | Constrain a number to be between two points
-between :: (HasSpec a, TypeSpec a ~ NumSpec a) => a -> a -> Specification a
-between lo hi = TypeSpec (NumSpecInterval (Just lo) (Just hi)) []
-
--- | The widest interval whose largest element is admitted by the original spec
-maxSpec :: Specification Integer -> Specification Integer
-maxSpec (ExplainSpec es s) = explainSpec es (maxSpec s)
-maxSpec TrueSpec = TrueSpec
-maxSpec s@(SuspendedSpec _ _) =
-  constrained $ \x -> unsafeExists $ \y -> [y `satisfies` s, Explain (pure "maxSpec on SuspendedSpec") $ Assert (x <=. y)]
-maxSpec (ErrorSpec xs) = ErrorSpec xs
-maxSpec (MemberSpec xs) = leqSpec (maximum xs)
-maxSpec (TypeSpec (NumSpecInterval _ hi) bad) = TypeSpec (NumSpecInterval Nothing hi) bad
-
--- | How to constrain the size of any type, with a Sized instance
-hasSize :: (HasSpec t, Sized t) => SizeSpec -> Specification t
-hasSize sz = liftSizeSpec sz []
diff --git a/libs/constrained-generators/src/Constrained/TypeErrors.hs b/libs/constrained-generators/src/Constrained/TypeErrors.hs
deleted file mode 100644
index 9eab6d2e821..00000000000
--- a/libs/constrained-generators/src/Constrained/TypeErrors.hs
+++ /dev/null
@@ -1,64 +0,0 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE PolyKinds #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
-
--- | This module implementes this very neat little trick for observing when
--- type families are stuck https://blog.csongor.co.uk/report-stuck-families/
--- which allows us to report much better type errors when our generics tricks
--- fail.
-module Constrained.TypeErrors (
-  Computes,
-  AssertComputes,
-  AssertSpineComputes,
-  module X,
-) where
-
-import Data.Kind
-import GHC.TypeError as X
-
--- | The idea of this type family is that if `ty` evaluates to a type (other than Dummy which
--- we haven't exported) then `Computes ty (TE err)` will evaluate to `()` without
--- getting stuck and without expanding `TE` to `TypeError err`.
---
--- If, on the other hand, GHC gets stuck evaluating `ty` it will (hopefully) try to normalize
--- everything and (hopefully) end up with `Computes (TypeError err) ty` which in turn will cause
--- it to throw `err` as a type error.
---
--- Now, the important thing here is that you can't do `Computes _ _ = ()` because that doesn't
--- force the evaluation of `ty` and consequently doesn't end up with GHC wanting to report
--- that `Computes tyThatDoesntCompute (TE err)` fails and consequently normalizing `TE err`
--- and finally arriving at `TypeError err`.
-type family Computes (ty :: k0) (err :: Constraint) (a :: k) :: k where
-  Computes Dummy _ _ =
-    TypeError
-      (Text "This shouldn't be reachable because " :<>: ShowType Dummy :<>: Text " shouldn't be exported!")
-  Computes (Dummy : as) _ _ =
-    TypeError
-      (Text "This shouldn't be reachable because " :<>: ShowType Dummy :<>: Text " shouldn't be exported!")
-  Computes _ _ a = a
-
--- This is intentionally hidden in here to avoid any funny business
-data Dummy
-
--- | Assert that type @ty` computes
-type AssertComputes ty em = Computes ty (TypeError em) (() :: Constraint)
-
-type family AssertSpineComputesF (help :: ErrorMessage) (xs :: [k]) (err :: ()) :: Constraint where
-  AssertSpineComputesF _ '[] _ = ()
-  AssertSpineComputesF help (_ : xs) err = AssertSpineComputes help xs
-
--- | Assert that the entire spine of a type-level list computes
-type AssertSpineComputes help (xs :: [k]) =
-  AssertSpineComputesF
-    help
-    xs
-    ( TypeError
-        ( Text "Type list computation is stuck on "
-            :$$: Text "  "
-              :<>: ShowType xs
-            :$$: help
-        )
-    )
diff --git a/libs/constrained-generators/test/Constrained/Tests.hs b/libs/constrained-generators/test/Constrained/Tests.hs
deleted file mode 100644
index 5d7ba3c442b..00000000000
--- a/libs/constrained-generators/test/Constrained/Tests.hs
+++ /dev/null
@@ -1,466 +0,0 @@
-{-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE NumericUnderscores #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# OPTIONS_GHC -Wno-orphans #-}
-
-module Constrained.Tests where
-
-import Constrained.API.Extend
-import Constrained.Examples.Basic
-import Constrained.Examples.Either
-import Constrained.Examples.Fold (
-  Outcome (..),
-  evenSpec,
-  listSumComplex,
-  logishProp,
-  oddSpec,
-  pickProp,
-  sum3,
-  sum3WithLength,
-  sumProp,
-  sumProp2,
-  testFoldSpec,
- )
-import Constrained.Examples.List
-import Constrained.Examples.Map
-import Constrained.Examples.Set
-import Constrained.Examples.Tree
-import Constrained.SumList (narrowByFuelAndSize)
-import Constrained.Test
-import Control.Monad
-import Data.Int
-import qualified Data.List.NonEmpty as NE
-import Data.Map (Map)
-import Data.Set (Set)
-import Data.Word
-import GHC.Natural
-import Test.Hspec
-import Test.Hspec.QuickCheck
-import Test.QuickCheck hiding (Args, Fun, forAll)
-
-------------------------------------------------------------------------
--- Test suite
-------------------------------------------------------------------------
-
-testAll :: IO ()
-testAll = hspec $ tests False
-
-tests :: Bool -> Spec
-tests nightly =
-  describe "constrained" . modifyMaxSuccess (\ms -> if nightly then ms * 10 else ms) $ do
-    -- TODO: double-shrinking
-    testSpecNoShrink "reifiesMultiple" reifiesMultiple
-    testSpec "assertReal" assertReal
-    testSpecNoShrink "chooseBackwards" chooseBackwards
-    testSpecNoShrink "chooseBackwards'" chooseBackwards'
-    -- TODO: turn this on again when QuickCheck version is bumped
-    -- testSpec "whenTrueExists" whenTrueExists
-    testSpec "assertRealMultiple" assertRealMultiple
-    -- TODO: quickcheck version
-    testSpecNoShrink "setSpec" setSpec
-    testSpec "leqPair" leqPair
-    testSpec "setPair" setPair
-    testSpecNoShrink "listEmpty" listEmpty
-    -- TODO: quickcheck version
-    testSpecNoShrink "compositionalSpec" compositionalSpec
-    testSpec "simplePairSpec" simplePairSpec
-    testSpec "trickyCompositional" trickyCompositional
-    testSpec "emptyListSpec" emptyListSpec
-    testSpec "eitherSpec" eitherSpec
-    testSpec "maybeSpec" maybeSpec
-    testSpecNoShrink "eitherSetSpec" eitherSetSpec
-    testSpec "fooSpec" fooSpec
-    testSpec "mapElemSpec" mapElemSpec
-    testSpec "mapElemKeySpec" mapElemKeySpec
-    -- TODO: double shrinking
-    testSpecNoShrink "mapIsJust" mapIsJust
-    testSpecNoShrink "intSpec" intSpec
-    testSpecNoShrink "mapPairSpec" mapPairSpec
-    testSpecNoShrink "mapEmptyDomainSpec" mapEmptyDomainSpec
-    -- TODO: this _can_ be shrunk, but it's incredibly expensive to do
-    -- so and it's not obvious if there is a faster way without implementing
-    -- more detailed shrinking of `SuspendedSpec`s
-    testSpecNoShrink "setPairSpec" setPairSpec
-    -- TODO: quickcheck version
-    testSpecNoShrink "fixedSetSpec" fixedSetSpec
-    testSpec "setOfPairLetSpec" setOfPairLetSpec
-    testSpecNoShrink "emptyEitherSpec" emptyEitherSpec
-    testSpecNoShrink "emptyEitherMemberSpec" emptyEitherMemberSpec
-    testSpec "setSingletonSpec" setSingletonSpec
-    testSpec "pairSingletonSpec" pairSingletonSpec
-    testSpec "eitherSimpleSetSpec" eitherSimpleSetSpec
-    testSpecNoShrink "emptySetSpec" emptySetSpec
-    testSpec "forAllAnySpec" forAllAnySpec
-    testSpecNoShrink "notSubsetSpec" notSubsetSpec
-    testSpec "maybeJustSetSpec" maybeJustSetSpec
-    testSpec "weirdSetPairSpec" weirdSetPairSpec
-    testSpec "knownDomainMap" knownDomainMap
-    -- TODO: figure out double-shrinking
-    testSpecNoShrink "testRewriteSpec" testRewriteSpec
-    testSpec "parallelLet" parallelLet
-    testSpec "letExists" letExists
-    testSpec "letExistsLet" letExistsLet
-    testSpec "notSubset" notSubset
-    testSpec "unionSized" unionSized
-    -- TODO: figure out double-shrinking
-    testSpecNoShrink "dependencyWeirdness" dependencyWeirdness
-    testSpec "foldTrueCases" foldTrueCases
-    testSpec "foldSingleCase" foldSingleCase
-    testSpec "listSumPair" (listSumPair @Int)
-    -- TODO: figure out double-shrinking
-    testSpecNoShrink "parallelLetPair" parallelLetPair
-    testSpec "mapSizeConstrained" mapSizeConstrained
-    testSpec "isAllZeroTree" isAllZeroTree
-    testSpec "noChildrenSameTree" noChildrenSameTree
-    testSpec "isBST" isBST
-    testSpecNoShrink "pairListError" pairListError
-    testSpecNoShrink "listMustSizeIssue" listMustSizeIssue
-    testSpec "successiveChildren" successiveChildren
-    testSpec "successiveChildren8" successiveChildren8
-    testSpecNoShrink "roseTreeList" roseTreeList
-    testSpec "orPair" orPair
-    testSpec "roseTreePairs" roseTreePairs
-    testSpec "roseTreeMaybe" roseTreeMaybe
-    testSpec "badTreeInteraction" badTreeInteraction
-    testSpec "sumRange" sumRange
-    testSpec "sumListBad" sumListBad
-    testSpec "listExistsUnfree" listExistsUnfree
-    -- TODO: turn this on when we bump quickcheck version
-    -- testSpec "listSumShort" listSumShort
-    testSpec "existsUnfree" existsUnfree
-    testSpec "appendSize" appendSize
-    testSpecNoShrink "appendSingleton" appendSingleton
-    testSpec "singletonSubset" singletonSubset
-    -- TODO: double shrinking
-    testSpecNoShrink "reifyYucky" reifyYucky
-    testSpec "fixedRange" fixedRange
-    testSpec "rangeHint" rangeHint
-    testSpec "basicSpec" basicSpec
-    testSpec "canFollowLike" canFollowLike
-    testSpec "ifElseBackwards" ifElseBackwards
-    testSpecNoShrink "three" three
-    testSpecNoShrink "three'" three'
-    testSpecNoShrink "threeSpecific" threeSpecific
-    testSpecNoShrink "threeSpecific'" threeSpecific'
-    testSpecNoShrink "trueSpecUniform" trueSpecUniform
-    testSpec "ifElseMany" ifElseMany
-    testSpecNoShrink "propBack" propBack
-    testSpecNoShrink "propBack'" propBack'
-    testSpecNoShrink "propBack''" propBack''
-    testSpec "complexUnion" complexUnion
-    testSpec "unionBounded" unionBounded
-    testSpec "elemSpec" elemSpec
-    testSpec "lookupSpecific" lookupSpecific
-    testSpec "mapRestrictedValues" mapRestrictedValues
-    testSpec "mapRestrictedValuesThree" mapRestrictedValuesThree
-    testSpec "mapRestrictedValuesBool" mapRestrictedValuesBool
-    testSpec "mapSetSmall" mapSetSmall
-    testSpecNoShrink "powersetPickOne" powersetPickOne
-    testSpecNoShrink "appendSuffix" appendSuffix
-    testSpecNoShrink "appendForAll" appendForAll
-    testSpec "wtfSpec" wtfSpec
-    numberyTests
-    sizeTests
-    numNumSpecTree
-    sequence_
-      [ testSpec ("intRangeSpec " ++ show i) (intRangeSpec i)
-      | i <- [-1000, -100, -10, 0, 10, 100, 1000]
-      ]
-    describe "prop_conformEmpty" $ do
-      prop "Int" $ prop_conformEmpty @Int
-      prop "Set Int" $ prop_conformEmpty @(Set Int)
-      prop "Map Int Int" $ prop_conformEmpty @(Map Int Int)
-      prop "[Int]" $ prop_conformEmpty @[Int]
-      prop "[(Int, Int)]" $ prop_conformEmpty @[(Int, Int)]
-    prop "prop_univSound @BaseFn" $
-      withMaxSuccess (if nightly then 100_000 else 10_000) $
-        prop_univSound
-    describe "prop_gen_sound" $ do
-      modifyMaxSuccess (const $ if nightly then 10_000 else 1000) $ do
-        prop "Int" $ prop_gen_sound @Int
-        prop "Bool" $ prop_gen_sound @Bool
-        prop "(Int, Int)" $ prop_gen_sound @(Int, Int)
-        prop "Map Int Int" $ prop_gen_sound @(Map Int Int)
-        prop "Set Int" $ prop_gen_sound @(Set Int)
-        prop "Set Bool" $ prop_gen_sound @(Set Bool)
-        prop "[Int]" $ prop_gen_sound @[Int]
-        prop "[(Int, Int)]" $ prop_gen_sound @[(Int, Int)]
-        prop "Map Bool Int" $ prop_gen_sound @(Map Bool Int)
-      -- Slow tests that shouldn't run 1000 times
-      xprop "Map (Set Int) Int" $ prop_gen_sound @(Map (Set Int) Int)
-      prop "[(Set Int, Set Bool)]" $ prop_gen_sound @[(Set Int, Set Bool)]
-      prop "Set (Set Bool)" $ prop_gen_sound @(Set (Set Bool))
-    negativeTests
-    prop "prop_noNarrowLoop" $ withMaxSuccess 1000 prop_noNarrowLoop
-    conformsToSpecESpec
-    foldWithSizeTests
-
-negativeTests :: Spec
-negativeTests =
-  describe "negative tests" $ do
-    prop "reifies 10 x id" $
-      expectFailure $
-        prop_complete @Int $
-          constrained $
-            \x ->
-              explanation (pure "The value is decided before reifies happens") $
-                reifies 10 x id
-    prop "reify overconstrained" $
-      expectFailure $
-        prop_complete @Int $
-          constrained $ \x ->
-            explanation
-              (pure "You can't constrain the variable introduced by reify as its already decided")
-              $ reify x id
-              $ \y -> y ==. 10
-    testSpecFail "singletonErrorTooMany" singletonErrorTooMany
-    testSpecFail "singletonErrorTooLong" singletonErrorTooLong
-    testSpecFail "appendTooLong" appendTooLong
-    testSpecFail "overconstrainedAppend" overconstrainedAppend
-    testSpecFail "overconstrainedPrefixes" overconstrainedPrefixes
-    testSpecFail "overconstrainedSuffixes" overconstrainedSuffixes
-    testSpecFail "appendForAllBad" appendForAllBad
-
-testSpecFail :: HasSpec a => String -> Specification a -> Spec
-testSpecFail s spec =
-  prop (s ++ " fails") $
-    expectFailure $
-      withMaxSuccess 1 $
-        prop_complete spec
-
-numberyTests :: Spec
-numberyTests =
-  describe "numbery tests" $ do
-    testNumberyListSpec "listSum" listSum
-    testNumberyListSpecNoShrink "listSumForall" listSumForall
-    testNumberyListSpec "listSumRange" listSumRange
-    testNumberyListSpec "listSumRangeUpper" listSumRangeUpper
-    testNumberyListSpec "listSumRangeRange" listSumRangeRange
-    testNumberyListSpec "listSumElemRange" listSumElemRange
-
-sizeTests :: Spec
-sizeTests =
-  describe "SizeTests" $ do
-    testSpecNoShrink "sizeAddOrSub1" sizeAddOrSub1
-    testSpecNoShrink "sizeAddOrSub2" sizeAddOrSub2
-    testSpecNoShrink "sizeAddOrSub3" sizeAddOrSub3
-    testSpecNoShrink "sizeAddOrSub4 returns Negative Size" sizeAddOrSub4
-    testSpecNoShrink "sizeAddOrSub5" sizeAddOrSub5
-    testSpecNoShrink "sizeAddOrSub5" sizeAddOrSub5
-    testSpec "listSubSize" listSubSize
-    testSpec "listSubSize" setSubSize
-    testSpec "listSubSize" mapSubSize
-    testSpec "hasSizeList" hasSizeList
-    testSpec "hasSizeSet" hasSizeSet
-    testSpec "hasSizeMap" hasSizeMap
-
-testNumberyListSpec :: String -> (forall a. Numbery a => Specification [a]) -> Spec
-testNumberyListSpec = testNumberyListSpec' True
-
-testNumberyListSpecNoShrink :: String -> (forall a. Numbery a => Specification [a]) -> Spec
-testNumberyListSpecNoShrink = testNumberyListSpec' False
-
-testNumberyListSpec' :: Bool -> String -> (forall a. Numbery a => Specification [a]) -> Spec
-testNumberyListSpec' withShrink n p =
-  describe n $ do
-    testSpec' withShrink "Integer" (p @Integer)
-    testSpec' withShrink "Natural" (p @Natural)
-    testSpec' withShrink "Word64" (p @Word64)
-    testSpec' withShrink "Word32" (p @Word32)
-    testSpec' withShrink "Word16" (p @Word16)
-    testSpec' withShrink "Word8" (p @Word8)
-    testSpec' withShrink "Int64" (p @Int64)
-    testSpec' withShrink "Int32" (p @Int32)
-    testSpec' withShrink "Int16" (p @Int16)
-    testSpec' withShrink "Int8" (p @Int8)
-
-testSpec :: HasSpec a => String -> Specification a -> Spec
-testSpec = testSpec' True
-
-testSpecNoShrink :: HasSpec a => String -> Specification a -> Spec
-testSpecNoShrink = testSpec' False
-
-testSpec' :: HasSpec a => Bool -> String -> Specification a -> Spec
-testSpec' withShrink n s = do
-  let checkCoverage' = checkCoverageWith stdConfidence {certainty = 1_000_000}
-  describe n $ do
-    prop "prop_sound" $
-      within 10_000_000 $
-        checkCoverage' $
-          prop_sound s
-    prop "prop_constrained_satisfies_sound" $
-      within 10_000_000 $
-        checkCoverage' $
-          prop_constrained_satisfies_sound s
-
-    prop "prop_constrained_explained" $
-      within 10_000_0000 $
-        checkCoverage' $
-          prop_constrained_explained s
-
-    when withShrink $
-      prop "prop_shrink_sound" $
-        discardAfter 100_000 $
-          checkCoverage' $
-            prop_shrink_sound s
-
-------------------------------------------------------------------------
--- Test properties of the instance Num (NumSpec Integer)
-------------------------------------------------------------------------
-
--- | When we multiply intervals, we get a bounding box, around the possible values.
---   When the intervals have infinities, the bounding box can be very loose. In fact the
---   order in which we multiply intervals with infinities can affect how loose the bounding box is.
---   So ((NegInf, n) * (a, b)) * (c,d)  AND  (NegInf, n) * ((a, b) * (c,d)) may have different bounding boxes
---   To test the associative laws we must have no infinities, and then the associative law will hold.
-noInfinity :: Gen (NumSpec Integer)
-noInfinity = do
-  lo <- arbitrary
-  hi <- suchThat arbitrary (> lo)
-  pure $ NumSpecInterval (Just lo) (Just hi)
-
-plusNegate :: NumSpec Integer -> NumSpec Integer -> Property
-plusNegate x y = x - y === x + negate y
-
-commutesNumSpec :: NumSpec Integer -> NumSpec Integer -> Property
-commutesNumSpec x y = x + y === y + x
-
-assocNumSpec :: NumSpec Integer -> NumSpec Integer -> NumSpec Integer -> Property
-assocNumSpec x y z = x + (y + z) === (x + y) + z
-
-commuteTimes :: NumSpec Integer -> NumSpec Integer -> Property
-commuteTimes x y = x * y === y * x
-
-assocNumSpecTimes :: Gen Property
-assocNumSpecTimes = do
-  x <- noInfinity
-  y <- noInfinity
-  z <- noInfinity
-  pure (x * (y * z) === (x * y) * z)
-
-negNegate :: NumSpec Integer -> Property
-negNegate x = x === negate (negate x)
-
-scaleNumSpec :: NumSpec Integer -> Property
-scaleNumSpec y = y + y === 2 * y
-
-scaleOne :: NumSpec Integer -> Property
-scaleOne y = y === 1 * y
-
-numNumSpecTree :: Spec
-numNumSpecTree =
-  describe "Num (NumSpec Integer) properties" $
-    modifyMaxSuccess (const 10000) $ do
-      prop "plusNegate(x - y == x + negate y)" plusNegate
-      prop "scaleNumSpec(y + y = 2 * y)" scaleNumSpec
-      prop "scaleOne(y = 1 * y)" scaleOne
-      prop "negNagate(x = x == negate (negate x))" negNegate
-      prop "commutesNumSpec(x+y = y+x)" commutesNumSpec
-      prop "assocNumSpec(x+(y+z) == (x+y)+z)" assocNumSpec
-      prop "assocNumSpecTimes(x*(y*z) == (x*y)*z)" assocNumSpecTimes
-      prop "commuteTimes" commuteTimes
-
-------------------------------------------------------------------------
--- Tests for `hasSize`
-------------------------------------------------------------------------
-
-hasSizeList :: Specification [Int]
-hasSizeList = hasSize (rangeSize 0 4)
-
-hasSizeSet :: Specification (Set Int)
-hasSizeSet = hasSize (rangeSize 1 3)
-
-hasSizeMap :: Specification (Map Int Int)
-hasSizeMap = hasSize (rangeSize 1 3)
-
-------------------------------------------------------------------------
--- Tests for narrowing
-------------------------------------------------------------------------
-
-prop_noNarrowLoop :: Int -> Int -> Specification Int -> Specification Int -> Property
-prop_noNarrowLoop f s eSpec fSpec =
-  -- Make sure the fuel is non-negative
-  f >= 0 ==>
-    discardAfter 100_000 $
-      narrowByFuelAndSize f s (eSpec, fSpec) `seq`
-        property True
-
--- | The test succeeds if conformsToSpec and conformsToSpecE both conform, or both fail to conform.
---   We collect answers by specType (ErrorSpec, MemberSpec, SuspendedSpec, ...) and whether
---   they both conform, or they both fail to conform.
-conformsToSpecETest :: forall a. HasSpec a => a -> Specification a -> Property
-conformsToSpecETest a speca =
-  let resultE = conformsToSpecE a speca (pure ("ConformsToSpecETest " ++ show a ++ " " ++ show speca))
-   in if conformsToSpec a speca
-        then case resultE of
-          Nothing -> property (collect (specType speca ++ " both conform") True)
-          Just xs -> counterexample (unlines (NE.toList xs)) False
-        else case resultE of
-          Nothing ->
-            counterexample ("conformstoSpec returns False, but conformsToSpecE returns no explanations") False
-          Just _ -> property (collect (specType speca ++ " both fail to conform") True)
-
-conformsToSpecESpec :: Spec
-conformsToSpecESpec =
-  describe "Testing alignment of conformsToSpec and conformsToSpecE" $
-    modifyMaxSuccess (const 1000) $ do
-      prop "Int" (conformsToSpecETest @Int)
-      prop "Word64" (conformsToSpecETest @Word64)
-      prop "Bool" (conformsToSpecETest @Bool)
-      prop "[Int]" (conformsToSpecETest @[Int])
-      prop "(Int,Bool)" (conformsToSpecETest @(Int, Bool))
-      prop "Set Integer" (conformsToSpecETest @(Set Integer))
-      prop "Set[Int]" (conformsToSpecETest @(Set [Int]))
-      prop "Map Int Int" (conformsToSpecETest @(Map Int Int))
-
--- ======================================================================
--- Test for use of Fold with size annotations
-
-foldWithSizeTests :: Spec
-foldWithSizeTests = do
-  describe "Summation tests with size. " $ do
-    prop "logish is sound" logishProp
-    prop "small odd/even tests" pickProp
-    prop "negative small" $ sumProp (-1000) 100 TrueSpec (-400 :: Int) 4 Succeed
-    prop "negative sum too small" $ sumProp (-1000) 0 TrueSpec (-8002 :: Int) 4 Fail
-    prop "negative large" $ sumProp (-60000 :: Int) 0 TrueSpec (-1000) 4 Succeed
-    prop "(between 50 60) small enough" $ sumProp 1 10 (between 50 60) (200 :: Int) 4 Succeed
-    prop "(between 50 60) too large" $ sumProp 1 10 (between 50 60) (400 :: Int) 4 Fail
-    prop "(count 2) large is fast" $ sumProp 1 5000000 TrueSpec (5000000 :: Int) 2 Succeed
-    prop "(count 5) large is fast" $ sumProp 1 5000000 TrueSpec (5000000 :: Int) 5 Succeed
-    prop "even succeeds on even" $ sumProp2 1 50000 ("even", even) (45876 :: Int) 5 Succeed
-    prop "even succeeds on even spec" $ sumProp 1 50000 evenSpec (45876 :: Int) 5 Succeed
-    prop "even fails on odd total, odd count" $ sumProp 1 50000 evenSpec (45875 :: Int) 3 Fail
-    prop "odd fails on odd total, even count" $ sumProp 1 50000 oddSpec (45878 :: Int) 3 Fail
-    prop "odd succeeds on odd total, odd count" $ sumProp 1 50000 oddSpec (45871 :: Int) 3 Succeed
-    xprop "succeeds with large count" $
-      withMaxSuccess 100 (sumProp 1 1500567 TrueSpec (1500567 :: Int) 20 Succeed)
-    prop "sum3 is sound" $ prop_constrained_satisfies_sound sum3
-    prop "(sum3WithLength 3) is sound" $ prop_constrained_satisfies_sound (sum3WithLength 3)
-    prop "(sum3WithLength 4) is sound" $ prop_constrained_satisfies_sound (sum3WithLength 4)
-    prop "(sum3WithLength 7) is sound" $ prop_constrained_satisfies_sound (sum3WithLength 7)
-    prop "listSum is sound" $ prop_constrained_satisfies_sound (listSum @Int)
-    prop "listSumPair is sound" $ prop_constrained_satisfies_sound (listSumPair @Word64)
-    -- This, by design, will fail for inputs greater than 7
-    prop "listSumComplex is sound" $ prop_constrained_satisfies_sound (listSumComplex @Integer 7)
-    prop "All sizes are negative" $
-      testFoldSpec @Int (between (-5) (-2)) evenSpec (MemberSpec (pure 100)) Fail
-    prop "Only some sizes are negative" $
-      testFoldSpec @Int (between (-5) 0) evenSpec (MemberSpec (pure 100)) Fail
-    prop "total and count can only be 0 in Word type" $
-      testFoldSpec @Word64 (between 0 0) evenSpec (MemberSpec (pure 0)) Succeed
-    prop "something of size 2, can add to 0 in type with negative values." $
-      testFoldSpec @Int (between 2 2) (between (-10) 10) (MemberSpec (pure 0)) Succeed
-    prop "TEST listSum" $ prop_constrained_satisfies_sound (listSum @Int)
-
--- TODO Needs to sample like this: OR [pick t c | t <- total, c <- count]
--- prop "count =0, total is 0,1,2" $ testFoldSpec @Int (between 0 1) evenSpec (between 0 2) Succeed
diff --git a/libs/constrained-generators/test/Tests.hs b/libs/constrained-generators/test/Tests.hs
deleted file mode 100644
index 09b5c148e15..00000000000
--- a/libs/constrained-generators/test/Tests.hs
+++ /dev/null
@@ -1,11 +0,0 @@
-module Main where
-
-import Constrained.Tests
-import Data.Maybe
-import System.Environment
-import Test.Hspec
-
-main :: IO ()
-main = do
-  nightly <- isJust <$> lookupEnv "NIGHTLY"
-  hspec $ tests nightly
diff --git a/libs/constrained-generators/testlib/Test/Minimal/Base.hs b/libs/constrained-generators/testlib/Test/Minimal/Base.hs
deleted file mode 100644
index 501595a4414..00000000000
--- a/libs/constrained-generators/testlib/Test/Minimal/Base.hs
+++ /dev/null
@@ -1,501 +0,0 @@
-{-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeFamilies #-}
-
--- Base types: Term, Pred, Spec, Ctx, and classes: HasSpec, Syntax, Semantics, and Logic for the MinModel
-module Test.Minimal.Base where
-
-import Constrained.Core (Evidence (..), Var (..), eqVar)
-import Constrained.GenT
-import Constrained.List hiding (ListCtx)
-import Data.Kind
-import Data.List.NonEmpty (NonEmpty (..))
-import qualified Data.List.NonEmpty as NE
-import Data.String (fromString)
-import Data.Typeable
-import GHC.Stack
-import Prettyprinter
-
--- ===========================================
--- Terms
--- ===========================================
-
-type AppRequires t dom rng =
-  ( Logic t
-  , TypeList dom
-  , Eq (t dom rng)
-  , Show (t dom rng)
-  , Typeable dom
-  , Typeable rng
-  , All HasSpec dom
-  , HasSpec rng
-  )
-
-data Term a where
-  App ::
-    forall t dom rng.
-    AppRequires t dom rng =>
-    t dom rng ->
-    List Term dom ->
-    Term rng
-  Lit :: (Typeable a, Eq a, Show a) => a -> Term a
-  V :: HasSpec a => Var a -> Term a
-
-instance Eq (Term a) where
-  V x == V x' = x == x'
-  Lit a == Lit b = a == b
-  App (w1 :: x1) (ts :: List Term dom1) == App (w2 :: x2) (ts' :: List Term dom2) =
-    case (eqT @dom1 @dom2, eqT @x1 @x2) of
-      (Just Refl, Just Refl) ->
-        w1 == w2
-          && sameTerms ts ts'
-      _ -> False
-  _ == _ = False
-
--- | If the list is composed solely of literals, apply the function to get a value
-applyFunSym ::
-  forall t ds rng.
-  (Typeable rng, Eq rng, Show rng, Semantics t) => FunTy ds rng -> List Term ds -> Maybe rng
-applyFunSym f Nil = Just f
-applyFunSym f (Lit x :> xs) = applyFunSym @t (f x) xs
-applyFunSym _ _ = Nothing
-
-reducesToLit :: Term a -> Maybe a
-reducesToLit (Lit n) = Just n
-reducesToLit (V _) = Nothing
-reducesToLit (App (f :: t ds r) xs) = applyFunSym @t (semantics f) xs
-
--- How to compare the args of two applications for equality
-sameTerms :: All HasSpec as => List Term as -> List Term as -> Bool
-sameTerms Nil Nil = True
-sameTerms (x :> xs) (y :> ys) = x == y && sameTerms xs ys
-
--- ===========================================
--- Function Symbol Classes
--- ===========================================
-
--- | Syntactic operations are ones that have to do with the structure and appearence of the type.
-class Syntax (t :: [Type] -> Type -> Type) where
-  inFix :: forall dom rng. t dom rng -> Bool
-  inFix _ = False
-  name :: forall dom rng. t dom rng -> String
-
--- | Semantic operations are ones that give the function symbol, meaning as a function.
---   I.e. how to apply the function to a list of arguments and return a value,
---   or to apply meaning preserving rewrite rules.
-class Syntax t => Semantics (t :: [Type] -> Type -> Type) where
-  semantics :: forall d r. t d r -> FunTy d r -- e.g. FunTy '[a,Int] Bool == a -> Int -> Bool
-  rewriteRules ::
-    forall ds rng.
-    (TypeList ds, Typeable ds, HasSpec rng, All HasSpec ds) =>
-    t ds rng -> List Term ds -> Evidence (Typeable rng, Eq rng, Show rng) -> Maybe (Term rng)
-  rewriteRules t l Evidence = Lit <$> (applyFunSym @t (semantics t) l)
-
--- | Logical operations are one that support reasoning about how a function symbol
---   relates to logical properties, that we call Spec's
-class (Typeable t, Syntax t, Semantics t) => Logic (t :: [Type] -> Type -> Type) where
-  {-# MINIMAL propagate | (propagateTypeSpec, propagateMemberSpec) #-}
-
-  propagateTypeSpec ::
-    (AppRequires t as b, HasSpec a) =>
-    t as b -> ListCtx as (HOLE a) -> TypeSpec b -> [b] -> Spec a
-  propagateTypeSpec f ctx ts cant = propagate f ctx (TypeSpec ts cant)
-
-  propagateMemberSpec ::
-    (AppRequires t as b, HasSpec a) =>
-    t as b -> ListCtx as (HOLE a) -> NonEmpty b -> Spec a
-  propagateMemberSpec f ctx xs = propagate f ctx (MemberSpec xs)
-
-  propagate ::
-    (AppRequires t as b, HasSpec a) =>
-    t as b -> ListCtx as (HOLE a) -> Spec b -> Spec a
-  propagate _ _ TrueSpec = TrueSpec
-  propagate _ _ (ErrorSpec es) = ErrorSpec es
-  propagate f ctx (SuspendedSpec v ps) = constrained $ \v' -> Let (App f (fromListCtx ctx v')) (v :-> ps)
-  propagate f ctx (TypeSpec ts cant) = propagateTypeSpec f ctx ts cant
-  propagate f ctx (MemberSpec xs) = propagateMemberSpec f ctx xs
-
--- ===========================
--- Pred
--- ===========================
-
-data Pred where
-  ElemPred :: forall a. HasSpec a => Bool -> Term a -> NonEmpty a -> Pred
-  And :: [Pred] -> Pred
-  Exists :: ((forall b. Term b -> b) -> GE a) -> Binder a -> Pred
-  ForAll :: (Container t a, HasSpec t, HasSpec a) => Term t -> Binder a -> Pred
-  DependsOn :: (HasSpec a, HasSpec b) => Term a -> Term b -> Pred
-  Assert :: Term Bool -> Pred
-  TruePred :: Pred
-  FalsePred :: NonEmpty String -> Pred
-  Case :: HasSpec (Either a b) => Term (Either a b) -> Binder a -> Binder b -> Pred
-  Let :: Term a -> Binder a -> Pred
-  Subst :: HasSpec a => Var a -> Term a -> Pred -> Pred
-
-data Binder a where
-  (:->) :: HasSpec a => Var a -> Pred -> Binder a
-
-class Container t e | t -> e where
-  fromForAllSpec :: (HasSpec t, HasSpec e) => Spec e -> Spec t
-  forAllToList :: t -> [e]
-
-data Binders as where
-  Binds :: All HasSpec as => List Var as -> Pred -> Binders as
-
-data Bind a where
-  Bind :: HasSpec a => {varBind :: Var a, termBind :: Term a} -> Bind a
-
-toBind :: All HasSpec as => List Term as -> List Var as -> List Bind as
-toBind Nil Nil = Nil
-toBind (t :> ts) (v :> vs) = (Bind v t :> toBind ts vs)
-
--- ================================
--- Spec
--- ================================
-
-data Spec a where
-  TrueSpec :: Spec a
-  ErrorSpec :: NonEmpty String -> Spec a
-  SuspendedSpec :: HasSpec a => Var a -> Pred -> Spec a -- Maybe we elide this at first
-  MemberSpec :: NonEmpty a -> Spec a
-  TypeSpec :: HasSpec a => TypeSpec a -> [a] -> Spec a
-
-typeSpec :: HasSpec a => TypeSpec a -> Spec a
-typeSpec ts = TypeSpec ts mempty
-
-constrained :: forall a. HasSpec a => (Term a -> Pred) -> Spec a
-constrained body =
-  let x :-> p = bind body
-   in SuspendedSpec x p
-
-bind :: HasSpec a => (Term a -> Pred) -> Binder a
-bind bodyf = newv :-> bodyPred
-  where
-    bodyPred = {- toPred -} body
-    newv = Var (nextVar bodyPred) "v"
-    body = bodyf (V newv)
-
-    nextVar q = 1 + bound q
-
-    boundBinder :: Binder a -> Int
-    boundBinder (x :-> p) = max (nameOf x) (bound p)
-
-    bound (ElemPred _ _ _) = -1
-    bound (Subst x _ p) = max (nameOf x) (bound p)
-    bound (And ps) = maximum $ (-1) : map bound ps -- (-1) as the default to get 0 as `nextVar p`
-    bound (Let _ b) = boundBinder b
-    bound (ForAll _ b) = boundBinder b
-    bound (Exists _ b) = boundBinder b
-    bound (Case _ ba bb) = max (boundBinder ba) (boundBinder bb)
-    bound Assert {} = -1
-    bound TruePred = -1
-    bound FalsePred {} = -1
-    bound DependsOn {} = -1
-
--- ========================================
--- HasSpec
--- ========================================
-
-class (Typeable a, Eq a, Show a, Show (TypeSpec a), Typeable (TypeSpec a)) => HasSpec a where
-  -- | The `TypeSpec a` is the type-specific `Spec a`.
-  type TypeSpec a
-
-  -- `TypeSpec` behaves sort-of like a monoid with a neutral
-  -- element `anySpec` and a `combineSpec` for combining
-  -- two `TypeSpec a`. However, in order to provide flexibilty
-  -- `combineSpec` takes two `TypeSpec` and constucts a `Spec`. This
-  -- avoids e.g. having to have a separate implementation of `ErrorSpec`
-  -- and `MemberSpec` in `TypeSpec`.
-
-  anySpec :: TypeSpec a
-  combineSpec :: TypeSpec a -> TypeSpec a -> Spec a
-
-  -- | Generate a value that satisfies the `TypeSpec`.
-  -- The key property for this generator is soundness:
-  --  ∀ a ∈ genFromTypeSpec spec. a `conformsTo` spec
-  genFromTypeSpec :: (HasCallStack, MonadGenError m) => TypeSpec a -> GenT m a
-
-  -- | Check conformance to the spec.
-  conformsTo :: HasCallStack => a -> TypeSpec a -> Bool
-
-  -- | Convert a spec to predicates:
-  -- The key property here is:
-  --   ∀ a. a `conformsTo` spec == a `conformsTo` constrained (\t -> toPreds t spec)
-  toPreds :: Term a -> TypeSpec a -> Pred
-
-  -- | This is used to detect self inconsistencies in a (TypeSpec t)
-  --   guardTypeSpec message ty --> ErrorSpec message, if ty is inconsistent
-  guardTypeSpec :: TypeSpec a -> Spec a
-  guardTypeSpec ty = typeSpec ty
-
--- =========================================
--- Contexts
--- =========================================
-
-data HOLE a b where
-  HOLE :: HOLE a a
-
-deriving instance Show (HOLE a b)
-
--- | Note the arrows (n :|> hole) and (hole :<| n) always point towards the term with
---   type `(c x)`, (i.e. `hole` in the picture above) where the target variable must occur.
-data ListCtx (as :: [Type]) (c :: Type -> Type) where
-  Unary :: c a -> ListCtx '[a] c
-  (:<|) :: c b -> x -> ListCtx '[b, x] c
-  (:|>) :: x -> c b -> ListCtx '[x, b] c
-
-data Ctx v (a :: Type) where
-  CtxHole :: HasSpec v => Ctx v v
-  CtxApp ::
-    ( AppRequires fn as b
-    , HasSpec b
-    , TypeList as
-    , Typeable as
-    , All HasSpec as
-    , Logic fn
-    ) =>
-    fn as b -> ListCtx as (Ctx v) -> Ctx v b
-
-ctxHasSpec :: Ctx v a -> Evidence (HasSpec a)
-ctxHasSpec CtxHole = Evidence
-ctxHasSpec CtxApp {} = Evidence
-
--- | From a ListCtx, build a (List Term as), to which the function symbol can be applied.
---   Hole becomes 't', values become `Lit` .
-fromListCtx :: All HasSpec as => ListCtx as (HOLE a) -> Term a -> List Term as
-fromListCtx (Unary HOLE) t = t :> Nil
-fromListCtx (HOLE :<| y) t = t :> Lit y :> Nil
-fromListCtx (x :|> HOLE) t = Lit x :> t :> Nil
-
---- | Consider the term `((size_ x +. Lit 3) <=. Lit 12)` with a bunch of nested function symbols, with just 1 variable 'x'
---    `(toCtx x term)` builds a context, with exactly one `CtxHole`, replacing the variable `x`
---    `CtxApp <=. (CtxApp +. (CtxApp size_ (Unary CtxHole) :<| 3) :<| 12)`
---    Working our way from outside in, we first propagate (<=.), then (+.), then (size_). This reduces in several steps
---    1) propagateSpec (CtxApp <=. (CtxApp +. (CtxApp size_ (Unary CtxHole) :<| 3) :<| 12)) $  spec
---    2) propagateSpec (CtxApp +. (CtxApp size_ (Unary CtxHole) :<| 3)) $  (propagate <=. (HOLE:<| 12))
---    3) propagateSpec (CtxApp size_ (Unary CtxHole)) $ (propagate +. (HOLE:<| 3) (propagate <=. (HOLE :<| 12)))
---    4) propagateSpec CtxHole $ (propagate size_ Hole (propagate +. (HOLE:<| 3) (propagate <=. (HOLE :<| 12))))
---    5) propagate size_ Hole (propagate +. (HOLE:<| 3) (propagate <=. (HOLE :<| 12)))
---    Note the pattern in the code below. The recursize call to 'propagateSpec' is on the pattern variable `ctx` which is the
---    part of the context pointed to by the arrows (:<|) and (:|>), and this recurive call to `propagateSpec` is
---    applied to a new spec computed by 'propagate', where the variable `ctx` is replaced by HOLE.
---    we end up on line 5), with three nested calls to `propagate`
-propagateSpec ::
-  forall v a.
-  HasSpec v =>
-  Ctx v a ->
-  Spec a ->
-  Spec v
-propagateSpec context spec = case context of
-  CtxHole -> spec
-  CtxApp f (Unary ctx) | Evidence <- ctxHasSpec ctx -> propagateSpec ctx (propagate f (Unary HOLE) spec)
-  CtxApp f (ctx :<| v) | Evidence <- ctxHasSpec ctx -> propagateSpec ctx (propagate f (HOLE :<| v) spec)
-  CtxApp f (v :|> ctx) | Evidence <- ctxHasSpec ctx -> propagateSpec ctx (propagate f (v :|> HOLE) spec)
-
--- Construct a Ctx for a variable 'v', which should occur exactly once in the given Term.
-toCtx ::
-  forall m v a.
-  (Typeable v, Show v, MonadGenError m, HasCallStack) =>
-  Var v -> Term a -> m (Ctx v a)
-toCtx v = go
-  where
-    go :: forall b. Term b -> m (Ctx v b)
-    go (Lit i) =
-      fatalErrorNE $
-        NE.fromList
-          [ "toCtx applied to literal: (Lit " ++ show i ++ ")"
-          , "A context is always constructed from an (App f xs) term"
-          , "with a single occurence of the target variable " ++ show v ++ "@(" ++ show (typeOf v) ++ ")"
-          ]
-    go t@(App f xs) = CtxApp f <$> toCtxList (show t) v xs
-    go (V v')
-      | Just Refl <- eqVar v v' = pure $ CtxHole
-      | otherwise =
-          fatalErrorNE $
-            NE.fromList
-              [ "A context is always constructed from an (App f xs) term with a single target variable"
-              , "which in this case is: " ++ show v ++ " :: (" ++ show (typeOf v) ++ ")"
-              , "Instead we found an unknown variable: " ++ show v' ++ " :: (" ++ show (typeOf v') ++ ")"
-              ]
-
-toCtxList ::
-  forall m v as.
-  (Show v, Typeable v, MonadGenError m, HasCallStack) =>
-  String -> Var v -> List Term as -> m (ListCtx as (Ctx v))
-toCtxList termName v Nil = fatalErrorNE $ ("toCtxList without hole, for variable " ++ show v) :| [termName]
-toCtxList termName v (V v' :> Nil)
-  | Just Refl <- eqVar v v' = pure $ Unary CtxHole
-  | otherwise =
-      fatalErrorNE $
-        NE.fromList
-          [ "A context is always constructed from an (App f xs) term,"
-          , "with a single occurence of the target variable " ++ show v ++ "@(" ++ show (typeOf v) ++ ")"
-          , "Instead we found an unknown variable " ++ show v' ++ "@(" ++ show (typeOf v') ++ ")"
-          , "in an application: " ++ termName
-          ]
-toCtxList termName v (x :> y :> Nil)
-  | Just i <- reducesToLit x = do hole <- toCtx v y; pure $ (i :|> hole)
-  | Just i <- reducesToLit y = do hole <- toCtx v x; pure $ (hole :<| i)
-  | otherwise =
-      fatalErrorNE $
-        "toCtx applied to an App with 2 parameters."
-          :| [ termName
-             , "The target variable we are searching for is " ++ show v
-             , "One of these parameters must reduce to a literal, which is not the case."
-             , "If both are non-literals, then term could have two variables, which is not allowed."
-             ]
-toCtxList termName v xs =
-  fatalErrorNE $
-    NE.fromList
-      [ "toCtx applied to an App with more than 2 parameters"
-      , termName
-      , "The target variable we are searching for is " ++ show v
-      , "All function symbols should have 1 or 2 parameters"
-      , "This one appears to accept " ++ show (lengthList xs) ++ "."
-      ]
-
--- ===================================================================
--- Pretty Printer Helper functions
--- ===================================================================
-
-data WithPrec a = WithPrec Int a
-
-parensIf :: Bool -> Doc ann -> Doc ann
-parensIf True = parens
-parensIf False = id
-
-prettyPrec :: Pretty (WithPrec a) => Int -> a -> Doc ann
-prettyPrec p = pretty . WithPrec p
-
-ppList ::
-  forall f as ann.
-  All HasSpec as => -- can we use something other than All HasSpec as here? We know Function Symbol HERE
-  (forall a. HasSpec a => f a -> Doc ann) ->
-  List f as ->
-  [Doc ann]
-ppList _ Nil = []
-ppList pp (a :> as) = pp a : ppList pp as
-
-ppList_ :: forall f as ann. (forall a. f a -> Doc ann) -> List f as -> [Doc ann]
-ppList_ _ Nil = []
-ppList_ pp (a :> as) = pp a : ppList_ pp as
-
-prettyType :: forall t x. Typeable t => Doc x
-prettyType = fromString $ show (typeRep (Proxy @t))
-
-vsep' :: [Doc ann] -> Doc ann
-vsep' = align . mconcat . punctuate hardline
-
-(/>) :: Doc ann -> Doc ann -> Doc ann
-h /> cont = hang 2 $ sep [h, align cont]
-
-infixl 5 />
-
-short :: forall a x. (Show a, Typeable a) => [a] -> Doc x
-short [] = "[]"
-short [x] =
-  let raw = show x
-      refined = if length raw <= 20 then raw else take 20 raw ++ " ... "
-   in "[" <+> fromString refined <+> "]"
-short xs =
-  let raw = show xs
-   in if length raw <= 50
-        then fromString raw
-        else "([" <+> viaShow (length xs) <+> "elements ...] @" <> prettyType @a <> ")"
-
-showType :: forall t. Typeable t => String
-showType = show (typeRep (Proxy @t))
-
--- ==========================================================================
--- Pretty and Show instances
--- ==========================================================================
-
--- ------------ Term -----------------
-instance Pretty (WithPrec (Term a)) where
-  pretty (WithPrec p t) = case t of
-    Lit n -> fromString $ showsPrec p n ""
-    V x -> viaShow x
-    App x Nil -> viaShow x
-    App f as
-      | inFix f
-      , a :> b :> Nil <- as ->
-          parensIf (p > 9) $ prettyPrec 10 a <+> viaShow f <+> prettyPrec 10 b
-      | otherwise -> parensIf (p > 10) $ viaShow f <+> align (fillSep (ppList (prettyPrec 11) as))
-
-instance Pretty (Term a) where
-  pretty = prettyPrec 0
-
-instance Show (Term a) where
-  showsPrec p t = shows $ pretty (WithPrec p t)
-
--- ------------ Pred -----------------
-
-instance Pretty Pred where
-  pretty = \case
-    ElemPred True term vs ->
-      align $
-        sep
-          [ "MemberPred"
-          , parens (pretty term)
-          , if length vs <= 2
-              then brackets (fillSep (punctuate "," (map viaShow (NE.toList vs))))
-              else "(" <> viaShow (length vs) <> " items)"
-          ]
-    ElemPred False term vs -> align $ sep ["notMemberPred", pretty term, fillSep (punctuate "," (map viaShow (NE.toList vs)))]
-    -- Exists _ (x :-> p) -> align $ sep ["exists" <+> viaShow x <+> "in", pretty p]
-    Let t (x :-> p) -> align $ sep ["let" <+> viaShow x <+> "=" /> pretty t <+> "in", pretty p]
-    And ps -> braces $ vsep' $ map pretty ps
-    Exists _ (x :-> p) -> align $ sep ["exists" <+> viaShow x <+> "in", pretty p]
-    Assert t -> "assert $" <+> pretty t
-    -- Reifies t' t _ -> "reifies" <+> pretty (WithPrec 11 t') <+> pretty (WithPrec 11 t)
-    DependsOn a b -> pretty a <+> "<-" /> pretty b
-    ForAll t (x :-> p) -> "forall" <+> viaShow x <+> "in" <+> pretty t <+> "$" /> pretty p
-    Case t as bs -> "case" <+> pretty t <+> "of" /> vsep' [pretty as, pretty bs]
-    -- When b p -> "whenTrue" <+> pretty (WithPrec 11 b) <+> "$" /> pretty p
-    Subst x t p -> "[" <> pretty t <> "/" <> viaShow x <> "]" <> pretty p
-    -- GenHint h t -> "genHint" <+> fromString (showsPrec 11 h "") <+> "$" <+> pretty t
-    TruePred -> "True"
-    FalsePred {} -> "False"
-
--- Monitor {} -> "monitor"
--- Explain es p -> "Explain" <+> viaShow (NE.toList es) <+> "$" /> pretty p
-
-instance Show Pred where
-  show = show . pretty
-
-instance Pretty (Binder a) where
-  pretty (x :-> p) = viaShow x <+> "->" <+> pretty p
-
--- ------------ Specifications -----------------
-
-instance HasSpec a => Pretty (WithPrec (Spec a)) where
-  pretty (WithPrec d s) = case s of
-    ErrorSpec es -> "ErrorSpec" /> vsep' (map fromString (NE.toList es))
-    TrueSpec -> fromString $ "TrueSpec @(" ++ showType @a ++ ")"
-    MemberSpec xs -> "MemberSpec" <+> short (NE.toList xs)
-    SuspendedSpec x p -> parensIf (d > 10) $ "constrained $ \\" <+> viaShow x <+> "->" /> pretty p
-    -- TODO: require pretty for `TypeSpec` to make this much nicer
-    TypeSpec ts cant ->
-      parensIf (d > 10) $
-        "TypeSpec"
-          /> vsep
-            [ fromString (showsPrec 11 ts "")
-            , viaShow cant
-            ]
-
-instance HasSpec a => Pretty (Spec a) where
-  pretty = pretty . WithPrec 0
-
-instance HasSpec a => Show (Spec a) where
-  showsPrec d = shows . pretty . WithPrec d
diff --git a/libs/constrained-generators/testlib/Test/Minimal/Model.hs b/libs/constrained-generators/testlib/Test/Minimal/Model.hs
deleted file mode 100644
index 5eeddeed8f9..00000000000
--- a/libs/constrained-generators/testlib/Test/Minimal/Model.hs
+++ /dev/null
@@ -1,1228 +0,0 @@
-{-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE ImportQualifiedPost #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE PatternSynonyms #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE ViewPatterns #-}
--- HasSpec instances for known types Integer, Bool, Set , (,)
-{-# OPTIONS_GHC -Wno-orphans #-}
-
-module Test.Minimal.Model where
-
-import Constrained.Core (
-  Evidence (..),
-  Var (..),
-  eqVar,
-  freshen,
-  unionWithMaybe,
- )
-import Constrained.Env (Env)
-import Constrained.Env qualified as Env
-import Constrained.GenT
-import Constrained.Graph qualified as Graph
-import Constrained.List hiding (ListCtx)
-import Control.Monad (guard)
-import Control.Monad.Writer (Writer, runWriter, tell)
-import Data.Foldable (fold)
-import Data.Foldable qualified as Foldable (fold)
-import Data.Kind
-import Data.List (nub, partition, (\\))
-import Data.List.NonEmpty (NonEmpty (..))
-import Data.List.NonEmpty qualified as NE
-import Data.Maybe (isNothing, listToMaybe, maybeToList)
-import Data.Semigroup (Any (..))
-import Data.Set (Set)
-import Data.Set qualified as Set
-import Data.Typeable
-import GHC.Stack
-import Prettyprinter
-import Test.Minimal.Base
-import Test.Minimal.Syntax
-import Test.QuickCheck hiding (forAll)
-
--- ====================================================
--- Now some concrete examples
--- 1) Introduce the function symbols
--- 2) Give the Syntax, Semantics, and Logic instances
--- 3) Give the HasSpec instance
--- ====================================================
-
--- ======== Integer example ==============
-
-data IntegerSym (dom :: [Type]) rng where
-  PlusW :: IntegerSym '[Integer, Integer] Integer
-  MinusW :: IntegerSym '[Integer, Integer] Integer
-  NegateW :: IntegerSym '[Integer] Integer
-  LessOrEqW :: IntegerSym '[Integer, Integer] Bool
-  GreaterOrEqW :: IntegerSym '[Integer, Integer] Bool
-
-deriving instance Eq (IntegerSym dom rng)
-
-instance Show (IntegerSym dom rng) where show = name
-
-instance Syntax IntegerSym where
-  name PlusW = "+."
-  name MinusW = "-."
-  name NegateW = "negate_"
-  name LessOrEqW = "<=."
-  name GreaterOrEqW = ">=."
-  inFix NegateW = False
-  inFix _ = True
-
-instance Semantics IntegerSym where
-  semantics PlusW = (+)
-  semantics MinusW = (-)
-  semantics NegateW = negate
-  semantics LessOrEqW = (<=)
-  semantics GreaterOrEqW = (>=)
-
-instance Logic IntegerSym where
-  propagate tag ctx spec = case (tag, ctx, spec) of
-    (_, _, TrueSpec) -> TrueSpec
-    (_, _, ErrorSpec xs) -> ErrorSpec xs
-    (f, context, SuspendedSpec v ps) ->
-      constrained $ \v' -> Let (App f (fromListCtx context v')) (v :-> ps)
-    (LessOrEqW, HOLE :<| l, bspec) ->
-      caseBoolSpec bspec $ \case True -> leqSpec l; False -> gtSpec l
-    (LessOrEqW, l :|> HOLE, bspec) ->
-      caseBoolSpec bspec $ \case True -> geqSpec l; False -> ltSpec l
-    (GreaterOrEqW, HOLE :<| x, spec1) ->
-      propagate LessOrEqW (x :|> HOLE) spec1
-    (GreaterOrEqW, x :|> HOLE, spec2) ->
-      propagate LessOrEqW (HOLE :<| x) spec2
-    (NegateW, Unary HOLE, TypeSpec interval cant) -> typeSpec (negateRange interval) <> notMemberSpec (map negate cant)
-    (NegateW, Unary HOLE, MemberSpec xs) -> MemberSpec $ NE.nub $ fmap negate xs
-    (PlusW, HOLE :<| n, TypeSpec (Interval lo hi) bad) ->
-      TypeSpec (Interval ((minus n) <$> lo) ((minus n) <$> hi)) (map (minus n) bad)
-    (PlusW, HOLE :<| n, MemberSpec xs) ->
-      MemberSpec (fmap (minus n) xs)
-    (PlusW, n :|> HOLE, TypeSpec (Interval lo hi) bad) ->
-      TypeSpec (Interval ((minus n) <$> lo) ((minus n) <$> hi)) (map (minus n) bad)
-    (PlusW, n :|> HOLE, MemberSpec xs) -> MemberSpec (fmap (minus n) xs)
-    (MinusW, HOLE :<| n, TypeSpec (Interval lo hi) bad) ->
-      TypeSpec (Interval ((+ n) <$> lo) ((+ n) <$> hi)) (map (+ n) bad)
-    (MinusW, HOLE :<| n, MemberSpec xs) ->
-      MemberSpec (fmap (+ n) xs)
-    (MinusW, n :|> HOLE, TypeSpec (Interval lo hi) bad) ->
-      TypeSpec (negateRange (Interval ((minus n) <$> lo) ((minus n) <$> hi))) (map (minus n) bad)
-    (MinusW, n :|> HOLE, MemberSpec xs) ->
-      MemberSpec (fmap (minus n) xs)
-
-negateRange :: Range -> Range
-negateRange (Interval ml mu) = Interval (negate <$> mu) (negate <$> ml)
-
-minus :: Integer -> Integer -> Integer
-minus n x = n - x
-
-geqSpec :: Integer -> Spec Integer
-geqSpec n = typeSpec (Interval (Just n) Nothing)
-
-leqSpec :: Integer -> Spec Integer
-leqSpec n = typeSpec (Interval Nothing (Just n))
-
-gtSpec :: Integer -> Spec Integer
-gtSpec n = typeSpec (Interval (Just (n + 1)) Nothing)
-
-ltSpec :: Integer -> Spec Integer
-ltSpec n = typeSpec (Interval Nothing (Just (n - 1)))
-
-(<=.) :: Term Integer -> Term Integer -> Term Bool
-(<=.) x y = App LessOrEqW (x :> y :> Nil)
-
-(>=.) :: Term Integer -> Term Integer -> Term Bool
-(>=.) x y = App GreaterOrEqW (x :> y :> Nil)
-
-(+.) :: Term Integer -> Term Integer -> Term Integer
-(+.) x y = App PlusW (x :> y :> Nil)
-
-(-.) :: Term Integer -> Term Integer -> Term Integer
-(-.) x y = App MinusW (x :> y :> Nil)
-
-negate_ :: Term Integer -> Term Integer
-negate_ x = App NegateW (x :> Nil)
-
--- =========================
--- HasSpec Integer instance
-
-data Range = Interval (Maybe Integer) (Maybe Integer) deriving (Eq, Show)
-
-instance Semigroup Range where
-  Interval ml mu <> Interval ml' mu' =
-    Interval
-      (unionWithMaybe max ml ml')
-      (unionWithMaybe min mu mu')
-
-instance Monoid Range where
-  mempty = Interval Nothing Nothing
-
-instance HasSpec Integer where
-  type TypeSpec Integer = Range
-
-  -- \| From -∞ to +∞
-  anySpec = Interval Nothing Nothing
-
-  -- \| Catch inconsistencies after using Monoid operation of the two Ranges.
-  combineSpec s s' = guardTypeSpec (s <> s')
-
-  -- \| In Interval where the lo bound is greater than the hi bound is inconsistent
-  guardTypeSpec r@(Interval (Just n) (Just m))
-    | n > m = ErrorSpec (pure ("lower bound greater than upper bound\n" ++ show r))
-    | otherwise = typeSpec r
-  guardTypeSpec range = typeSpec range
-
-  genFromTypeSpec (Interval ml mu) = do
-    n <- sizeT
-    chooseT =<< constrainInterval ml mu (fromIntegral n)
-
-  conformsTo i (Interval ml mu) = maybe True (<= i) ml && maybe True (i <=) mu
-
-  toPreds v (Interval ml mu) =
-    Foldable.fold $
-      [Assert $ Lit l <=. v | l <- maybeToList ml]
-        ++ [Assert $ v <=. Lit u | u <- maybeToList mu]
-
-constrainInterval ::
-  MonadGenError m => Maybe Integer -> Maybe Integer -> Integer -> m (Integer, Integer)
-constrainInterval ml mu qcSize =
-  case (ml, mu) of
-    (Nothing, Nothing) -> pure (-qcSize', qcSize')
-    (Just l, Nothing)
-      | l < 0 -> pure (max l (negate qcSize'), qcSize')
-      | otherwise -> pure (l, l + 2 * qcSize')
-    (Nothing, Just u)
-      | u > 0 -> pure (negate qcSize', min u qcSize')
-      | otherwise -> pure (u - qcSize' - qcSize', u)
-    (Just l, Just u)
-      | l > u -> genError ("bad interval: " ++ show l ++ " " ++ show u)
-      | u < 0 -> pure (safeSub l (safeSub l u qcSize') qcSize', u)
-      | l >= 0 -> pure (l, safeAdd u (safeAdd u l qcSize') qcSize')
-      -- TODO: this is a bit suspect if the bounds are lopsided
-      | otherwise -> pure (max l (-qcSize'), min u qcSize')
-  where
-    qcSize' = abs $ fromInteger qcSize
-    -- FIX THIS TO WORK just on Integer, Should be much simpler, as Integer has no undeflow or overflow.
-    safeSub l a b
-      | a - b > a = l
-      | otherwise = max l (a - b)
-    safeAdd u a b
-      | a + b < a = u
-      | otherwise = min u (a + b)
-
--- ========== Bool example ==================
-
-data BoolSym (dom :: [Type]) rng where
-  NotW :: BoolSym '[Bool] Bool
-
-deriving instance Eq (BoolSym dom rng)
-
-instance Show (BoolSym dom rng) where show = name
-
-instance Syntax BoolSym where
-  name NotW = "not_"
-  inFix _ = False
-
-instance Semantics BoolSym where
-  semantics NotW = not
-
-instance Logic BoolSym where
-  propagate _ _ TrueSpec = TrueSpec
-  propagate _ _ (ErrorSpec msgs) = ErrorSpec msgs
-  propagate NotW (Unary HOLE) (SuspendedSpec v ps) =
-    constrained $ \v' -> Let (App NotW (v' :> Nil)) (v :-> ps)
-  propagate NotW (Unary HOLE) spec =
-    caseBoolSpec spec (equalSpec . not)
-
-not_ :: Term Bool -> Term Bool
-not_ x = App NotW (x :> Nil)
-
--- =========================
--- HasSpec Bool instance
-
-instance HasSpec Bool where
-  type TypeSpec Bool = Set Bool
-
-  anySpec = Set.fromList [False, True]
-
-  combineSpec s s' = typeSpec (Set.union s s')
-
-  genFromTypeSpec set
-    | Set.null set = fatalError "genFromTypeSpec @Set where the typeSpec is Set.empty"
-    | otherwise = oneofT (map pure (Set.toList set))
-
-  guardTypeSpec s
-    | Set.null s = ErrorSpec $ pure "guardTypeSpec @Set where the typeSpec is Set.empty"
-    | otherwise = TypeSpec s []
-
-  conformsTo i set = Set.member i set
-
-  toPreds v set = case Set.toList set of
-    [] -> FalsePred (pure "toPreds @Set where the typeSpec is Set.empty")
-    (x : xs) -> ElemPred True v (x :| xs)
-
--- ========== Set example =======================
-
-data SetSym (dom :: [Type]) rng where
-  MemberW :: (HasSpec a, Ord a) => SetSym [a, Set a] Bool
-  SizeW :: (HasSpec a, Ord a) => SetSym '[Set a] Integer
-  SubsetW :: (HasSpec a, Ord a) => SetSym [Set a, Set a] Bool
-
-deriving instance Eq (SetSym dom rng)
-
-instance Show (SetSym dom rng) where show = name
-
-instance Syntax SetSym where
-  name MemberW = "member_"
-  name SizeW = "size_"
-  name SubsetW = "subset_"
-  inFix _ = False
-
-instance Semantics SetSym where
-  semantics MemberW = Set.member
-  semantics SizeW = setSize
-  semantics SubsetW = Set.isSubsetOf
-
-  rewriteRules SubsetW (Lit s :> _ :> Nil) Evidence | null s = Just $ Lit True
-  rewriteRules SubsetW (x :> Lit s :> Nil) Evidence | null s = Just $ x ==. Lit Set.empty
-  rewriteRules MemberW (t :> Lit s :> Nil) Evidence
-    | null s = Just $ Lit False
-    | [a] <- Set.toList s = Just $ t ==. Lit a
-  rewriteRules t l Evidence = Lit <$> (applyFunSym @SetSym (semantics t) l)
-
-instance Logic SetSym where
-  propagate tag ctx spec = case (tag, ctx, spec) of
-    (_, _, TrueSpec) -> TrueSpec
-    (_, _, ErrorSpec es) -> ErrorSpec es
-    (f, context, SuspendedSpec v ps) -> constrained $ \v' -> Let (App f (fromListCtx context v')) (v :-> ps)
-    (MemberW, HOLE :<| (s :: Set a), spec1) ->
-      caseBoolSpec spec1 $ \case
-        True -> memberSpec (Set.toList s) (pure "propagateSpecFun on (Member x s) where s is Set.empty")
-        False -> notMemberSpec s
-    (MemberW, e :|> HOLE, spec2) ->
-      caseBoolSpec spec2 $ \case
-        True -> typeSpec $ SetSpec (Set.singleton e) mempty mempty
-        False -> typeSpec $ SetSpec mempty (notEqualSpec e) mempty
-    (SizeW, Unary HOLE, spec3) -> typeSpec (SetSpec mempty mempty spec3)
-    (SubsetW, HOLE :<| big, spec4) -> caseBoolSpec spec4 $ \case
-      True -> constrained $ \small ->
-        And
-          [ Assert $ size_ small <=. Lit (setSize big)
-          , forAll small $ \x -> Assert $ member_ x (Lit big)
-          ]
-      False -> constrained $ \small ->
-        exists (\eval -> headGE $ Set.difference big (eval small)) $ \e ->
-          And
-            [ -- set `DependsOn` e,
-              Assert $ not_ $ member_ e (Lit big)
-            , Assert $ member_ e small
-            ]
-    (SubsetW, small :|> HOLE, spec5) -> caseBoolSpec spec5 $ \case
-      True -> typeSpec $ SetSpec small TrueSpec mempty
-      False -> constrained $ \big ->
-        exists (\eval -> headGE $ Set.difference (eval big) small) $ \e ->
-          And
-            [ -- set `DependsOn` e,
-              Assert $ member_ e (Lit small)
-            , Assert $ not_ $ member_ e big
-            ]
-
-setSize :: Set a -> Integer
-setSize = toInteger . Set.size
-
-size_ :: (HasSpec s, Ord s) => Term (Set s) -> Term Integer
-size_ s = App SizeW (s :> Nil)
-
-subset_ :: (HasSpec s, Ord s) => Term (Set s) -> Term (Set s) -> Term Bool
-subset_ s1 s2 = App SubsetW (s1 :> s2 :> Nil)
-
-member_ :: (Ord a, HasSpec a) => Term a -> Term (Set a) -> Term Bool
-member_ x y = App MemberW (x :> y :> Nil)
-
--- Helpers for the `HasSpec (Set s)` instance
-
-instance Ord s => Container (Set s) s where
-  fromForAllSpec e = typeSpec $ SetSpec mempty e TrueSpec
-  forAllToList = Set.toList
-
-data SetSpec a = SetSpec {setMust :: Set a, setAll :: Spec a, setCount :: Spec Integer}
-  deriving (Show)
-
-guardSetSpec :: (HasSpec a, Ord a) => SetSpec a -> Spec (Set a)
-guardSetSpec (SetSpec must elemS ((<> geqSpec 0) -> size))
-  | Just u <- knownUpperBound size
-  , u < 0 =
-      ErrorSpec (("guardSetSpec: negative size " ++ show u) :| [])
-  | not (all (`conformsToSpec` elemS) must) =
-      ErrorSpec (("Some 'must' items do not conform to 'element' spec: " ++ show elemS) :| [])
-  | isErrorLike size = ErrorSpec ("guardSetSpec: error in size" :| [])
-  | isErrorLike (geqSpec (setSize must) <> size) =
-      ErrorSpec $
-        ("Must set size " ++ show (setSize must) ++ ", is inconsistent with SetSpec size" ++ show size)
-          :| []
-  | otherwise = typeSpec (SetSpec must elemS size)
-
-knownUpperBound :: Spec Integer -> Maybe Integer
-knownUpperBound TrueSpec = Nothing
-knownUpperBound (MemberSpec as) = Just $ maximum as
-knownUpperBound ErrorSpec {} = Nothing
-knownUpperBound SuspendedSpec {} = Nothing
-knownUpperBound (TypeSpec (Interval lo hi) cant) = upper lo hi
-  where
-    upper _ Nothing = Nothing
-    upper Nothing (Just b) = listToMaybe $ [b, b - 1 ..] \\ cant
-    upper (Just a) (Just b)
-      | a == b = a <$ guard (a `notElem` cant)
-      | otherwise = listToMaybe $ [b, b - 1 .. a] \\ cant
-
-instance (Ord a, HasSpec a) => Semigroup (SetSpec a) where
-  SetSpec must es size <> SetSpec must' es' size' =
-    SetSpec (must <> must') (es <> es') (size <> size')
-
-instance (Ord a, HasSpec a) => Monoid (SetSpec a) where
-  mempty = SetSpec mempty mempty TrueSpec
-
--- =========================
--- HasSpec Set instance
-
-instance (Container (Set a) a, Ord a, HasSpec a) => HasSpec (Set a) where
-  type TypeSpec (Set a) = SetSpec a
-
-  anySpec = SetSpec Set.empty TrueSpec TrueSpec
-
-  combineSpec x y = guardSetSpec (x <> y)
-
-  conformsTo s (SetSpec must es size) =
-    and
-      [ setSize s `conformsToSpec` size
-      , must `Set.isSubsetOf` s
-      , all (`conformsToSpec` es) s
-      ]
-
-  toPreds s (SetSpec m es size) =
-    Foldable.fold $
-      -- Don't include this if the must set is empty
-      [Assert $ subset_ (Lit m) s | not $ Set.null m]
-        ++ [ forAll s (\e -> satisfies e es)
-           , satisfies (size_ s) size
-           ]
-
-  guardTypeSpec = guardSetSpec
-
-  genFromTypeSpec (SetSpec must e _)
-    | any (not . (`conformsToSpec` e)) must =
-        genErrorNE
-          ( NE.fromList
-              [ "Failed to generate set"
-              , "Some element in the must set does not conform to the elem specification"
-              , "Unconforming elements from the must set:"
-              , unlines (map (\x -> "  " ++ show x) (filter (not . (`conformsToSpec` e)) (Set.toList must)))
-              , "Element Specifcation"
-              , "  " ++ show e
-              ]
-          )
-  -- Special case when elemS is a MemberSpec.
-  -- Just union 'must' with enough elements of 'xs' to meet  'szSpec'
-  genFromTypeSpec (SetSpec must (MemberSpec xs) szSpec) = do
-    let szSpec' = szSpec <> geqSpec (setSize must) -- <> maxSpec (cardinality elemS)
-    choices <- pureGen $ shuffle (NE.toList xs \\ Set.toList must)
-    size <- fromInteger <$> genFromSpecT szSpec'
-    let additions = Set.fromList $ take (size - Set.size must) choices
-    pure (Set.union must additions)
-  genFromTypeSpec (SetSpec must elemS szSpec) = do
-    let szSpec' = szSpec <> geqSpec (setSize must) -- <> maxSpec (cardinality elemS)
-    sizecount <-
-      explain "Choose a size for the Set to be generated" $
-        genFromSpecT szSpec'
-    let targetSize = sizecount - setSize must
-    explainNE
-      ( NE.fromList
-          [ "Choose size count = " ++ show sizecount
-          , "szSpec' = " ++ show szSpec'
-          , "Picking items not in must = " ++ show (Set.toList must)
-          , "that also meet the element test: "
-          , "  " ++ show elemS
-          ]
-      )
-      $ go 100 targetSize must
-    where
-      go _ n s | n <= 0 = pure s
-      go tries n s = do
-        e <-
-          explainNE
-            ( NE.fromList
-                [ "Generate set member at type " ++ showType @a
-                , "  number of items starting with  = " ++ show (Set.size must)
-                , "  number of items left to pick   = " ++ show n
-                , "  number of items already picked = " ++ show (Set.size s)
-                ]
-            )
-            $ withMode Strict
-            $ suchThatWithTryT tries (genFromSpecT elemS) (`Set.notMember` s)
-
-        go tries (n - 1) (Set.insert e s)
-
--- ========== Pairs example =======================
-
-pattern Pair ::
-  forall c. () => forall a b. (c ~ (a, b), HasSpec a, HasSpec b) => Term a -> Term b -> Term c
-pattern Pair x y <- App (getWitness -> Just PairW) (x :> y :> Nil)
-
-data PairSym (dom :: [Type]) rng where
-  FstW :: PairSym '[(a, b)] a
-  SndW :: PairSym '[(a, b)] b
-  PairW :: PairSym '[a, b] (a, b)
-
-deriving instance Eq (PairSym dom rng)
-
-instance Show (PairSym dom rng) where show = name
-
-instance Syntax PairSym where
-  name FstW = "fst_"
-  name SndW = "snd_"
-  name PairW = "pair_"
-  inFix _ = False
-
-instance Semantics PairSym where
-  semantics FstW = fst
-  semantics SndW = snd
-  semantics PairW = (,)
-  rewriteRules FstW (Pair x _ :> Nil) Evidence = Just x
-  rewriteRules SndW (Pair _ y :> Nil) Evidence = Just y
-  rewriteRules t l Evidence = Lit <$> applyFunSym @PairSym (semantics t) l
-
-instance Logic PairSym where
-  propagateTypeSpec FstW (Unary HOLE) ts cant = typeSpec $ Cartesian (TypeSpec ts cant) TrueSpec
-  propagateTypeSpec SndW (Unary HOLE) ts cant = typeSpec $ Cartesian TrueSpec (TypeSpec ts cant)
-  propagateTypeSpec PairW (a :|> HOLE) sc@(Cartesian sa sb) cant
-    | a `conformsToSpec` sa = sb <> foldMap notEqualSpec (sameFst a cant)
-    | otherwise =
-        ErrorSpec
-          ( NE.fromList
-              ["propagate (pair_ " ++ show a ++ " HOLE) has conformance failure on a", show (TypeSpec sc cant)]
-          )
-  propagateTypeSpec PairW (HOLE :<| b) sc@(Cartesian sa sb) cant
-    | b `conformsToSpec` sb = sa <> foldMap notEqualSpec (sameSnd b cant)
-    | otherwise =
-        ErrorSpec
-          ( NE.fromList
-              ["propagate (pair_ HOLE " ++ show b ++ ") has conformance failure on b", show (TypeSpec sc cant)]
-          )
-
-  propagateMemberSpec FstW (Unary HOLE) es = typeSpec $ Cartesian (MemberSpec es) TrueSpec
-  propagateMemberSpec SndW (Unary HOLE) es = typeSpec $ Cartesian TrueSpec (MemberSpec es)
-  propagateMemberSpec PairW (a :|> HOLE) es =
-    case (nub (sameFst a (NE.toList es))) of
-      (w : ws) -> MemberSpec (w :| ws)
-      [] ->
-        ErrorSpec $
-          NE.fromList
-            [ "propagate (pair_ HOLE " ++ show a ++ ") on (MemberSpec " ++ show (NE.toList es)
-            , "Where " ++ show a ++ " does not appear as the fst component of anything in the MemberSpec."
-            ]
-  propagateMemberSpec PairW (HOLE :<| b) es =
-    case (nub (sameSnd b (NE.toList es))) of
-      (w : ws) -> MemberSpec (w :| ws)
-      [] ->
-        ErrorSpec $
-          NE.fromList
-            [ "propagate (pair_ HOLE " ++ show b ++ ") on (MemberSpec " ++ show (NE.toList es)
-            , "Where " ++ show b ++ " does not appear as the snd component of anything in the MemberSpec."
-            ]
-
-sameFst :: Eq a1 => a1 -> [(a1, a2)] -> [a2]
-sameFst a ps = [b | (a', b) <- ps, a == a']
-
-sameSnd :: Eq a1 => a1 -> [(a2, a1)] -> [a2]
-sameSnd b ps = [a | (a, b') <- ps, b == b']
-
-fst_ :: (HasSpec a, HasSpec b) => Term (a, b) -> Term a
-fst_ x = App FstW (x :> Nil)
-
-snd_ :: (HasSpec a, HasSpec b) => Term (a, b) -> Term b
-snd_ x = App SndW (x :> Nil)
-
-pair_ :: (HasSpec a, HasSpec b) => Term a -> Term b -> Term (a, b)
-pair_ a b = App PairW (a :> b :> Nil)
-
--- ========== The Pair (a,b) HasSpec instance
-
-data PairSpec a b = Cartesian (Spec a) (Spec b)
-
-instance (HasSpec a, HasSpec b) => Show (PairSpec a b) where
-  show (Cartesian l r) = "(Cartesian " ++ "(" ++ show l ++ ") (" ++ show r ++ "))"
-
-instance (HasSpec a, HasSpec b) => Semigroup (PairSpec a b) where
-  (Cartesian x y) <> (Cartesian a b) = Cartesian (x <> a) (y <> b)
-
-instance (HasSpec a, HasSpec b) => Monoid (PairSpec a b) where mempty = Cartesian mempty mempty
-
-guardPair :: forall a b. (HasSpec a, HasSpec b) => Spec a -> Spec b -> Spec (a, b)
-guardPair specA specB = handleErrors specA specB (\s t -> typeSpec (Cartesian s t))
-
-instance (HasSpec a, HasSpec b) => HasSpec (a, b) where
-  type TypeSpec (a, b) = PairSpec a b
-
-  anySpec = Cartesian mempty mempty
-
-  combineSpec (Cartesian a b) (Cartesian a' b') = guardPair (a <> a') (b <> b')
-
-  conformsTo (a, b) (Cartesian sa sb) = conformsToSpec a sa && conformsToSpec b sb
-
-  guardTypeSpec (Cartesian x y) = guardPair x y
-
-  genFromTypeSpec (Cartesian sa sb) = (,) <$> genFromSpecT sa <*> genFromSpecT sb
-
-  toPreds x (Cartesian sf ss) =
-    satisfies (fst_ x) sf
-      <> satisfies (snd_ x) ss
-
--- ========== Either example =======================
-
-data EitherSym (dom :: [Type]) rng where
-  LeftW :: EitherSym '[a] (Either a b)
-  RightW :: EitherSym '[b] (Either a b)
-
-deriving instance Eq (EitherSym dom rng)
-
-instance Show (EitherSym dom rng) where show = name
-
-instance Syntax EitherSym where
-  name LeftW = "left_"
-  name RightW = "right_"
-  inFix _ = False
-
-instance Semantics EitherSym where
-  semantics LeftW = Left
-  semantics RightW = Right
-
-instance Logic EitherSym where
-  propagateTypeSpec LeftW (Unary HOLE) (SumSpec sl _) cant = sl <> foldMap notEqualSpec [a | Left a <- cant]
-  propagateTypeSpec RightW (Unary HOLE) (SumSpec _ sr) cant = sr <> foldMap notEqualSpec [a | Right a <- cant]
-
-  propagateMemberSpec LeftW (Unary HOLE) es =
-    case [a | Left a <- NE.toList es] of
-      (x : xs) -> MemberSpec (x :| xs)
-      [] ->
-        ErrorSpec $
-          pure $
-            "propMemberSpec (left_ HOLE) on (MemberSpec es) with no Left in es: " ++ show (NE.toList es)
-  propagateMemberSpec RightW (Unary HOLE) es =
-    case [a | Right a <- NE.toList es] of
-      (x : xs) -> MemberSpec (x :| xs)
-      [] ->
-        ErrorSpec $
-          pure $
-            "propagate (Right HOLE) on (MemberSpec es) with no Right in es: " ++ show (NE.toList es)
-
-left_ :: (HasSpec a, HasSpec b) => Term a -> Term (Either a b)
-left_ x = App LeftW (x :> Nil)
-
-right_ :: (HasSpec a, HasSpec b) => Term b -> Term (Either a b)
-right_ x = App RightW (x :> Nil)
-
--- ========== The Either HasSpec instance
-
-data SumSpec a b = SumSpec a b
-
-deriving instance (Eq a, Eq b) => Eq (SumSpec a b)
-
-deriving instance (Show a, Show b) => Show (SumSpec a b)
-
-guardSum :: forall a b. (HasSpec a, HasSpec b) => Spec a -> Spec b -> Spec (Either a b)
-guardSum (ErrorSpec es) (ErrorSpec fs) = ErrorSpec (es <> fs)
-guardSum (ErrorSpec es) _ = ErrorSpec (NE.cons "sum error on left" es)
-guardSum _ (ErrorSpec es) = ErrorSpec (NE.cons "sum error on right" es)
-guardSum s s' = typeSpec $ SumSpec s s'
-
-instance (HasSpec a, HasSpec b) => HasSpec (Either a b) where
-  type TypeSpec (Either a b) = SumSpec (Spec a) (Spec b)
-
-  anySpec = SumSpec mempty mempty
-
-  combineSpec (SumSpec a b) (SumSpec c d) = guardSum (a <> c) (b <> d)
-
-  conformsTo (Left a) (SumSpec sa _) = conformsToSpec a sa
-  conformsTo (Right b) (SumSpec _ sb) = conformsToSpec b sb
-
-  toPreds x (SumSpec a b) = Case x (bind $ \y -> satisfies y a) (bind $ \y -> satisfies y b)
-
-  genFromTypeSpec (SumSpec (simplifySpec -> sa) (simplifySpec -> sb))
-    | emptyA, emptyB = genError "genFromTypeSpec @SumSpec: empty"
-    | emptyA = Right <$> genFromSpecT sb
-    | emptyB = Left <$> genFromSpecT sa
-    | otherwise = oneofT [Left <$> genFromSpecT sa, Right <$> genFromSpecT sb]
-    where
-      emptyA = isErrorLike sa
-      emptyB = isErrorLike sb
-
--- ========== List example ===================
-
-data ListSym (dom :: [Type]) rng where
-  ElemW :: Eq a => ListSym [a, [a]] Bool
-  LengthW :: ListSym '[[a]] Integer
-
-instance Syntax ListSym where
-  name ElemW = "elem_"
-  name LengthW = "length_"
-  inFix _ = False
-
-instance Semantics ListSym where
-  semantics ElemW = elem
-  semantics LengthW = toInteger . length
-
--- =========================================================================
--- User Facing functions
--- ====================================================================
-
--- | Generalize `genFromTypeSpec` from `TypeSpec t` to `Spec t`
---   Generate a value that satisfies the spec. This function can fail if the
---   spec is inconsistent, there is a dependency error, or if the underlying
---   generators are not flexible enough.
-genFromSpecT ::
-  forall a m. (HasCallStack, HasSpec a, MonadGenError m) => Spec a -> GenT m a
-genFromSpecT (simplifySpec -> spec) = case spec of
-  MemberSpec as -> explain ("genFromSpecT on spec" ++ show spec) $ pureGen (elements (NE.toList as))
-  TrueSpec -> genFromSpecT (typeSpec $ anySpec @a)
-  SuspendedSpec x p
-    -- NOTE: If `x` isn't free in `p` we still have to try to generate things
-    -- from `p` to make sure `p` is sat and then we can throw it away. A better
-    -- approach would be to only do this in the case where we don't know if `p`
-    -- is sat. The proper way to implement such a sat check is to remove
-    -- sat-but-unnecessary variables in the optimiser.
-    | not $ Name x `appearsIn` p -> do
-        !_ <- genFromPreds mempty p
-        genFromSpecT TrueSpec
-    | otherwise -> do
-        env <- genFromPreds mempty p
-        Env.find env x
-  TypeSpec s cant -> do
-    mode <- getMode
-    explainNE
-      ( NE.fromList
-          [ "genFromSpecT on (TypeSpec tspec cant) at type " ++ showType @a
-          , "tspec = "
-          , show s
-          , "cant = " ++ show cant
-          , "with mode " ++ show mode
-          ]
-      )
-      $
-      -- TODO: we could consider giving `cant` as an argument to `genFromTypeSpec` if this
-      -- starts giving us trouble.
-      genFromTypeSpec s `suchThatT` (`notElem` cant)
-  ErrorSpec e -> genErrorNE e
-
--- | A version of `genFromSpecT` that simply errors if the generator fails
-genFromSpec :: forall a. (HasCallStack, HasSpec a) => Spec a -> Gen a
-genFromSpec spec = do
-  res <- catchGen $ genFromSpecT @a @GE spec
-  either (error . ('\n' :) . catMessages) pure res
-
--- | A version of `genFromSpecT` that runs in the IO monad. Good for debugging.
-debugSpec :: forall a. HasSpec a => Spec a -> IO ()
-debugSpec spec = do
-  ans <- generate $ genFromGenT $ inspect (genFromSpecT spec)
-  let f x = putStrLn (unlines (NE.toList x))
-      ok x =
-        if conformsToSpec x spec
-          then putStrLn "True"
-          else putStrLn "False, perhaps there is an unsafeExists in the spec?"
-  case ans of
-    FatalError xs -> mapM_ f xs
-    GenError xs -> mapM_ f xs
-    Result x -> print spec >> print (simplifySpec spec) >> print x >> ok x
-
--- | Generate a satisfying `Env` for a `p : Pred fn`. The `Env` contains values for
--- all the free variables in `flattenPred p`.
-genFromPreds :: forall m. MonadGenError m => Env -> Pred -> GenT m Env
--- TODO: remove this once optimisePred does a proper fixpoint computation
-genFromPreds env0 (optimisePred . optimisePred -> preds) =
-  {- explain1 (show $ "genFromPreds fails\nPreds are:" /> pretty preds) -} do
-    -- NOTE: this is just lazy enough that the work of flattening,
-    -- computing dependencies, and linearizing is memoized in
-    -- properties that use `genFromPreds`.
-    plan <- runGE $ prepareLinearization preds
-    go env0 plan
-  where
-    go :: Env -> SolverPlan -> GenT m Env
-    go env plan | isEmptyPlan plan = pure env
-    go env plan = explain (show $ "Stepping the plan:" /> vsep [pretty env, pretty (substPlan env plan)]) $ do
-      (env', plan') <- stepPlan env plan
-      go env' plan'
-
--- =============================================================
--- Simplifcation
--- =============================================================
-
-simplifySpec :: HasSpec a => Spec a -> Spec a
-simplifySpec spec = case applyNameHints spec of
-  SuspendedSpec x p ->
-    let optP = optimisePred p
-     in fromGESpec $
-          explain
-            ("\nWhile calling simplifySpec on var " ++ show x ++ "\noptP=\n" ++ show optP ++ "\n")
-            (computeSpecSimplified x optP)
-  MemberSpec xs -> MemberSpec xs
-  ErrorSpec es -> ErrorSpec es
-  TypeSpec ts cant -> TypeSpec ts cant
-  TrueSpec -> TrueSpec
-
--- | Turn 'GenError' into 'ErrorSpec', and FatalError into 'error'
-fromGESpec :: HasCallStack => GE (Spec a) -> Spec a
-fromGESpec ge = case ge of
-  Result s -> s
-  GenError xs -> ErrorSpec (catMessageList xs)
-  FatalError es -> error $ catMessages es
-
-------- Stages of simplifying -------------------------------
-
--- TODO: it might be necessary to run aggressiveInlining again after the let floating etc.
-optimisePred :: Pred -> Pred
-optimisePred p =
-  simplifyPred
-    . letSubexpressionElimination
-    . letFloating
-    . aggressiveInlining
-    . simplifyPred
-    $ p
-
-aggressiveInlining :: Pred -> Pred
-aggressiveInlining pred0
-  | inlined = aggressiveInlining pInlined
-  | otherwise = pred0
-  where
-    (pInlined, Any inlined) = runWriter $ go (freeVars pred0) [] pred0
-
-    underBinder fvs x p = fvs `without` [Name x] <> singleton (Name x) (countOf (Name x) p)
-
-    underBinderSub sub x =
-      [ x' := t
-      | x' := t <- sub
-      , isNothing $ eqVar x x'
-      ]
-
-    -- NOTE: this is safe because we only use the `Subst` when it results in a literal so there
-    -- is no risk of variable capture.
-    goBinder :: FreeVars -> Subst -> Binder a -> Writer Any (Binder a)
-    goBinder fvs sub (x :-> p) = (x :->) <$> go (underBinder fvs x p) (underBinderSub sub x) p
-
-    -- Check that the name `n` is only ever used as the only variable
-    -- in the expressions where it appears. This ensures that it doesn't
-    -- interact with anything.
-    onlyUsedUniquely n p = case p of
-      Assert t
-        | n `appearsIn` t -> Set.size (freeVarSet t) == 1
-        | otherwise -> True
-      And ps -> all (onlyUsedUniquely n) ps
-      -- TODO: we can (and should) probably add a bunch of cases to this.
-      _ -> False
-
-    go fvs sub pred2 = case pred2 of
-      ElemPred bool t xs
-        | not (isLit t)
-        , Lit a <- substituteAndSimplifyTerm sub t -> do
-            tell $ Any True
-            pure $ ElemPred bool (Lit a) xs
-        | otherwise -> pure $ ElemPred bool t xs
-      Subst x t p -> go fvs sub (substitutePred x t p)
-      ForAll set b
-        | not (isLit set)
-        , Lit a <- substituteAndSimplifyTerm sub set -> do
-            tell $ Any True
-            pure $ foldMap (`unBind` b) (forAllToList a)
-        | otherwise -> ForAll set <$> goBinder fvs sub b
-      Case t as bs
-        | not (isLit t)
-        , Lit a <- substituteAndSimplifyTerm sub t -> do
-            tell $ Any True
-            pure $ runCaseOn a as bs $ \x v p -> substPred (Env.singleton x v) p
-        | otherwise -> Case t <$> (goBinder fvs sub as) <*> (goBinder fvs sub bs)
-      Let t (x :-> p)
-        | all (\n -> count n fvs <= 1) (freeVarSet t) -> do
-            tell $ Any True
-            pure $ substitutePred x t p
-        | onlyUsedUniquely (Name x) p -> do
-            tell $ Any True
-            pure $ substitutePred x t p
-        | not $ Name x `appearsIn` p -> do
-            tell $ Any True
-            pure p
-        | not (isLit t)
-        , Lit a <- substituteAndSimplifyTerm sub t -> do
-            tell $ Any True
-            pure $ unBind a (x :-> p)
-        | otherwise -> Let t . (x :->) <$> go (underBinder fvs x p) (x := t : sub) p
-      Exists k b -> Exists k <$> goBinder fvs sub b
-      And ps -> Foldable.fold <$> mapM (go fvs sub) ps
-      Assert t
-        | not (isLit t)
-        , Lit b <- substituteAndSimplifyTerm sub t -> do
-            tell $ Any True
-            pure $ toPred b
-        | otherwise -> pure pred2
-      DependsOn t t'
-        | not (isLit t)
-        , Lit {} <- substituteAndSimplifyTerm sub t -> do
-            tell $ Any True
-            pure $ TruePred
-        | not (isLit t')
-        , Lit {} <- substituteAndSimplifyTerm sub t' -> do
-            tell $ Any True
-            pure $ TruePred
-        | otherwise -> pure pred2
-      TruePred -> pure pred2
-      FalsePred {} -> pure pred2
-
--- ==================================================================================
-
--- | Lifts 'propagateSpec' to take a Monadic 'Ctx'
-propagateSpecM ::
-  forall v a m.
-  (Monad m, HasSpec v) =>
-  Spec a ->
-  m (Ctx v a) ->
-  m (Spec v)
-propagateSpecM spec ctxM = do ctx <- ctxM; pure $ propagateSpec ctx spec
-
--- | Precondition: the `Pred` defines the `Var a`
--- Runs in `GE` in order for us to have detailed context on failure.
-computeSpecSimplified ::
-  forall a. (HasSpec a, HasCallStack) => Var a -> Pred -> GE (Spec a)
-computeSpecSimplified x pred3 = localGESpec $ case simplifyPred pred3 of
-  And ps -> do
-    spec <- fold <$> mapM (computeSpecSimplified x) ps
-    case spec of
-      SuspendedSpec y ps' -> pure $ SuspendedSpec y $ simplifyPred ps'
-      s -> pure s
-  ElemPred True t xs -> propagateSpecM (MemberSpec xs) (toCtx x t)
-  ElemPred False (t :: Term b) xs -> propagateSpecM (TypeSpec @b (anySpec @b) (NE.toList xs)) (toCtx x t)
-  Subst x' t p' -> computeSpec x (substitutePred x' t p') -- NOTE: this is impossible as it should have gone away already
-  TruePred -> pure mempty
-  FalsePred es -> genErrorNE es
-  Let t b -> pure $ SuspendedSpec x (Let t b)
-  Exists k b -> pure $ SuspendedSpec x (Exists k b)
-  Assert (Lit True) -> pure mempty
-  Assert (Lit False) -> genError (show pred3)
-  Assert t -> propagateSpecM (equalSpec True) (toCtx x t)
-  ForAll (Lit s) b -> fold <$> mapM (\val -> computeSpec x $ unBind val b) (forAllToList s)
-  ForAll t b -> do
-    bSpec <- computeSpecBinderSimplified b
-    propagateSpecM (fromForAllSpec bSpec) (toCtx x t)
-  Case (Lit val) as bs -> runCaseOn val as bs $ \va vaVal psa -> computeSpec x (substPred (Env.singleton va vaVal) psa)
-  Case t as bs -> do
-    simpAs <- computeSpecBinderSimplified as
-    simpBs <- computeSpecBinderSimplified bs
-    propagateSpecM (typeSpec (SumSpec simpAs simpBs)) (toCtx x t)
-  -- Impossible cases that should be ruled out by the dependency analysis and linearizer
-  DependsOn {} ->
-    fatalErrorNE $
-      NE.fromList
-        [ "The impossible happened in computeSpec: DependsOn"
-        , "  " ++ show x
-        , show $ indent 2 (pretty pred3)
-        ]
-  where
-    -- We want `genError` to turn into `ErrorSpec` and we want `FatalError` to turn into `FatalError`
-    localGESpec ge = case ge of
-      (GenError xs) -> Result $ ErrorSpec (catMessageList xs)
-      (FatalError es) -> FatalError es
-      (Result v) -> Result v
-
--- | Precondition: the `Pred fn` defines the `Var a`.
---   Runs in `GE` in order for us to have detailed context on failure.
-computeSpec ::
-  forall a. (HasSpec a, HasCallStack) => Var a -> Pred -> GE (Spec a)
-computeSpec x p = computeSpecSimplified x (simplifyPred p)
-
-computeSpecBinder :: Binder a -> GE (Spec a)
-computeSpecBinder (x :-> p) = computeSpec x p
-
-computeSpecBinderSimplified :: Binder a -> GE (Spec a)
-computeSpecBinderSimplified (x :-> p) = computeSpecSimplified x p
-
--- ---------------------- Building a plan -----------------------------------
-
-substStage :: Env -> SolverStage -> SolverStage
-substStage env (SolverStage y ps spec) = normalizeSolverStage $ SolverStage y (substPred env <$> ps) spec
-
-normalizeSolverStage :: SolverStage -> SolverStage
-normalizeSolverStage (SolverStage x ps spec) = SolverStage x ps'' (spec <> spec')
-  where
-    (ps', ps'') = partition ((1 ==) . Set.size . freeVarSet) ps
-    spec' = fromGESpec $ computeSpec x (And ps')
-
-type Hints = DependGraph
-
-type DependGraph = Graph.Graph Name
-
-dependency :: HasVariables t => Name -> t -> DependGraph
-dependency x (freeVarSet -> xs) = Graph.dependency x xs
-
-irreflexiveDependencyOn ::
-  forall t t'. (HasVariables t, HasVariables t') => t -> t' -> DependGraph
-irreflexiveDependencyOn (freeVarSet -> xs) (freeVarSet -> ys) = Graph.irreflexiveDependencyOn xs ys
-
-noDependencies :: HasVariables t => t -> DependGraph
-noDependencies (freeVarSet -> xs) = Graph.noDependencies xs
-
-respecting :: Hints -> DependGraph -> DependGraph
-respecting hints g = g `Graph.subtractGraph` Graph.opGraph hints
-
-solvableFrom :: Name -> Set Name -> DependGraph -> Bool
-solvableFrom x s g =
-  let less = Graph.dependencies x g
-   in s `Set.isSubsetOf` less && not (x `Set.member` less)
-
--- TODO: here we can compute both the explicit hints (i.e. constraints that
--- define the order of two variables) and any whole-program smarts.
-computeHints :: [Pred] -> Hints
-computeHints ps =
-  Graph.transitiveClosure $ fold [x `irreflexiveDependencyOn` y | DependsOn x y <- ps]
-
-saturatePred :: Pred -> [Pred]
-saturatePred p = [p]
-
--- | Linearize a predicate, turning it into a list of variables to solve and
--- their defining constraints such that each variable can be solved independently.
-prepareLinearization :: Pred -> GE SolverPlan
-prepareLinearization p = do
-  let preds = concatMap saturatePred $ flattenPred p
-      hints = computeHints preds
-      graph = Graph.transitiveClosure $ hints <> respecting hints (foldMap computeDependencies preds)
-  plan <-
-    explainNE
-      ( NE.fromList
-          [ "Linearizing"
-          , show $ "  preds: " <> pretty preds
-          , show $ "  graph: " <> pretty graph
-          ]
-      )
-      $ linearize preds graph
-  pure $ backPropagation $ SolverPlan plan graph
-
--- | Flatten nested `Let`, `Exists`, and `And` in a `Pred fn`. `Let` and
--- `Exists` bound variables become free in the result.
-flattenPred :: Pred -> [Pred]
-flattenPred pIn = go (freeVarNames pIn) [pIn]
-  where
-    go _ [] = []
-    go fvs (p : ps) = case p of
-      And ps' -> go fvs (ps' ++ ps)
-      -- NOTE: the order of the arguments to `==.` here are important.
-      -- The whole point of `Let` is that it allows us to solve all of `t`
-      -- before we solve the variables in `t`.
-      Let t b -> goBinder fvs b ps (\x -> (Assert (t ==. (V x)) :))
-      Exists _ b -> goBinder fvs b ps (const id)
-      _ -> p : go fvs ps
-
-    goBinder ::
-      Set Int ->
-      Binder a ->
-      [Pred] ->
-      (HasSpec a => Var a -> [Pred] -> [Pred]) ->
-      [Pred]
-    goBinder fvs (x :-> p) ps k = k x' $ go (Set.insert (nameOf x') fvs) (p' : ps)
-      where
-        (x', p') = freshen x p fvs
-
--- Consider: A + B = C + D
--- We want to fail if A and B are independent.
--- Consider: A + B = A + C, A <- B
--- Here we want to consider this constraint defining for A
-linearize ::
-  MonadGenError m => [Pred] -> DependGraph -> m [SolverStage]
-linearize preds graph = do
-  sorted <- case Graph.topsort graph of
-    Left cycleX ->
-      fatalError
-        ( show $
-            "linearize: Dependency cycle in graph:"
-              /> vsep'
-                [ "cycle:" /> pretty cycleX
-                , "graph:" /> pretty graph
-                ]
-        )
-    Right sorted -> pure sorted
-  go sorted [(freeVarSet ps, ps) | ps <- filter isRelevantPred preds]
-  where
-    isRelevantPred TruePred = False
-    isRelevantPred DependsOn {} = False
-    isRelevantPred (Assert (Lit True)) = False
-    isRelevantPred _ = True
-
-    go [] [] = pure []
-    go [] ps
-      | null $ foldMap fst ps =
-          case checkPredsE (pure "Linearizing fails") mempty (map snd ps) of
-            Nothing -> pure []
-            Just msgs -> genErrorNE msgs
-      | otherwise =
-          fatalErrorNE $
-            NE.fromList
-              [ "Dependency error in `linearize`: "
-              , show $ indent 2 $ "graph: " /> pretty graph
-              , show $
-                  indent 2 $
-                    "the following left-over constraints are not defining constraints for a unique variable:"
-                      /> vsep' (map (pretty . snd) ps)
-              ]
-    go (n@(Name x) : ns) ps = do
-      let (nps, ops) = partition (isLastVariable n . fst) ps
-      (normalizeSolverStage (SolverStage x (map snd nps) mempty) :) <$> go ns ops
-
-    isLastVariable n set = n `Set.member` set && solvableFrom n (Set.delete n set) graph
-
--- =================================
--- Operations on Stages and Plans
-
--- | Does nothing if the variable is not in the plan already.
-mergeSolverStage :: SolverStage -> [SolverStage] -> [SolverStage]
-mergeSolverStage (SolverStage x ps spec) plan =
-  [ case eqVar x y of
-      Just Refl ->
-        SolverStage
-          y
-          (ps ++ ps')
-          ( addToErrorSpec
-              ( NE.fromList
-                  ( [ "Solving var " ++ show x ++ " fails."
-                    , "Merging the Specs"
-                    , "   1. " ++ show spec
-                    , "   2. " ++ show spec'
-                    ]
-                  )
-              )
-              (spec <> spec')
-          )
-      Nothing -> stage
-  | stage@(SolverStage y ps' spec') <- plan
-  ]
-
-prettyPlan :: HasSpec a => Spec a -> Doc ann
-prettyPlan (simplifySpec -> spec)
-  | SuspendedSpec _ p <- spec
-  , Result plan <- prepareLinearization p =
-      vsep'
-        [ "Simplified spec:" /> pretty spec
-        , pretty plan
-        ]
-  | otherwise = "Simplfied spec:" /> pretty spec
-
-printPlan :: HasSpec a => Spec a -> IO ()
-printPlan = print . prettyPlan
-
-isEmptyPlan :: SolverPlan -> Bool
-isEmptyPlan (SolverPlan plan _) = null plan
-
-stepPlan :: MonadGenError m => Env -> SolverPlan -> GenT m (Env, SolverPlan)
-stepPlan env plan@(SolverPlan [] _) = pure (env, plan)
-stepPlan env p@(SolverPlan (SolverStage x ps spec : pl) gr) = do
-  (spec', specs) <- runGE
-    $ explain
-      (show (pretty env) ++ "\nStep " ++ show x ++ show (pretty p))
-    $ do
-      ispecs <- mapM (computeSpec x) ps
-      pure $ (fold ispecs, ispecs)
-  val <-
-    genFromSpecT
-      ( addToErrorSpec
-          ( NE.fromList
-              ( ( "\nStepPlan for variable: "
-                    ++ show x
-                    ++ " fails to produce Specification, probably overconstrained."
-                    ++ "PS = "
-                    ++ unlines (map show ps)
-                )
-                  : ("Original spec " ++ show spec)
-                  : "Predicates"
-                  : zipWith
-                    (\pred1 specx -> "  pred " ++ show pred1 ++ " -> " ++ show specx)
-                    ps
-                    specs
-              )
-          )
-          (spec <> spec')
-      )
-  let env1 = Env.extend x val env
-  pure (env1, backPropagation $ SolverPlan (substStage env1 <$> pl) (Graph.deleteNode (Name x) gr))
-
-computeDependencies :: Pred -> DependGraph
-computeDependencies = \case
-  ElemPred _bool term _xs -> computeTermDependencies term
-  Subst x t p -> computeDependencies (substitutePred x t p)
-  Assert t -> computeTermDependencies t
-  ForAll set b ->
-    let innerG = computeBinderDependencies b
-     in innerG <> set `irreflexiveDependencyOn` Graph.nodes innerG
-  DependsOn x y -> x `irreflexiveDependencyOn` y
-  Case t as bs -> noDependencies t <> computeBinderDependencies as <> computeBinderDependencies bs
-  TruePred -> mempty
-  FalsePred {} -> mempty
-  And ps -> foldMap computeDependencies ps
-  Exists _ b -> computeBinderDependencies b
-  Let t b -> noDependencies t <> computeBinderDependencies b
-
-computeBinderDependencies :: Binder a -> DependGraph
-computeBinderDependencies (x :-> p) =
-  Graph.deleteNode (Name x) $ computeDependencies p
-
-computeTermDependencies :: Term a -> DependGraph
-computeTermDependencies = fst . computeTermDependencies'
-
-computeTermDependencies' :: Term a -> (DependGraph, Set Name)
-computeTermDependencies' = \case
-  (App _ args) -> go args
-  Lit {} -> (mempty, mempty)
-  (V x) -> (noDependencies (Name x), Set.singleton (Name x))
-  where
-    go :: List Term as -> (DependGraph, Set Name)
-    go Nil = (mempty, mempty)
-    go (t :> ts) =
-      let (gr, ngr) = go ts
-          (tgr, ntgr) = computeTermDependencies' t
-       in (ntgr `irreflexiveDependencyOn` ngr <> tgr <> gr, ngr <> ntgr)
-
--- | Push as much information we can backwards through the plan.
-backPropagation :: SolverPlan -> SolverPlan
--- backPropagation (SolverPlan _plan _graph) =
-backPropagation (SolverPlan initplan graph) = SolverPlan (go [] (reverse initplan)) graph
-  where
-    go acc [] = acc
-    go acc (s@(SolverStage (x :: Var a) ps spec) : plan) = go (s : acc) plan'
-      where
-        newStages = concatMap (newStage spec) ps
-        plan' = foldr mergeSolverStage plan newStages
-        -- Note use of the Term Pattern Equal
-        newStage specl (Assert (Equal (V x') t)) =
-          termVarEqCases specl x' t
-        newStage specr (Assert (Equal t (V x'))) =
-          termVarEqCases specr x' t
-        newStage _ _ = []
-
-        termVarEqCases :: HasSpec b => Spec a -> Var b -> Term b -> [SolverStage]
-        termVarEqCases (MemberSpec vs) x' t
-          | Set.singleton (Name x) == freeVarSet t =
-              [SolverStage x' [] $ MemberSpec (NE.nub (fmap (\v -> errorGE $ runTerm (Env.singleton x v) t) vs))]
-        termVarEqCases specx x' t
-          | Just Refl <- eqVar x x'
-          , [Name y] <- Set.toList $ freeVarSet t
-          , Result ctx <- toCtx y t =
-              [SolverStage y [] (propagateSpec ctx specx)]
-        termVarEqCases _ _ _ = []
-
-spec9 :: Spec (Set Integer)
-spec9 = constrained $ \x -> Assert $ (size_ x +. Lit 3) <=. Lit 12
diff --git a/libs/constrained-generators/testlib/Test/Minimal/Syntax.hs b/libs/constrained-generators/testlib/Test/Minimal/Syntax.hs
deleted file mode 100644
index d76433ecee8..00000000000
--- a/libs/constrained-generators/testlib/Test/Minimal/Syntax.hs
+++ /dev/null
@@ -1,1023 +0,0 @@
-{-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE ImportQualifiedPost #-}
-{-# LANGUAGE KindSignatures #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE PatternSynonyms #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE ViewPatterns #-}
--- Monoid Pred and Spec, Pretty and ReName instances
-{-# OPTIONS_GHC -Wno-orphans #-}
-
--- Syntactic operations on types: Term, Pred, Spec, Ctx, etc.
-module Test.Minimal.Syntax where
-
-import Constrained.Core (
-  Evidence (..),
-  Rename (rename),
-  Value (..),
-  Var (..),
-  eqVar,
-  freshen,
-  unValue,
- )
-import Constrained.Env (Env)
-import Constrained.Env qualified as Env
-import Constrained.GenT
-import Constrained.Graph
-import Constrained.List hiding (ListCtx)
-import Control.Monad.Identity
-import Control.Monad.Writer (Writer, runWriter, tell)
-import Data.Foldable qualified as Foldable (fold, toList)
-import Data.Kind
-import Data.List (intersect, nub)
-import Data.List.NonEmpty (NonEmpty (..))
-import Data.List.NonEmpty qualified as NE
-import Data.Map.Strict (Map)
-import Data.Map.Strict qualified as Map
-import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, listToMaybe)
-import Data.Monoid qualified as Monoid
-import Data.Semigroup (Any (..), sconcat)
-import Data.Set (Set)
-import Data.Set qualified as Set
-import Data.String (fromString)
-import Data.Typeable
-import Prettyprinter
-import Test.Minimal.Base
-
--- =======================================
--- Tools for building Spec
-
-forAll :: (Container t a, HasSpec t, HasSpec a) => Term t -> (Term a -> Pred) -> Pred
-forAll tm = mkForAll tm . bind
-
--- forSome :: (Container t a, HasSpec t, HasSpec a) => Term t -> (Term a -> Pred) -> Pred
--- forSome tm = mkForSome tm . bind
-
-mkForAll ::
-  (Container t a, HasSpec t, HasSpec a) =>
-  Term t -> Binder a -> Pred
-mkForAll (Lit (forAllToList -> [])) _ = TruePred
-mkForAll _ (_ :-> TruePred) = TruePred
-mkForAll tm binder = ForAll tm binder
-
-exists ::
-  forall a.
-  HasSpec a =>
-  ((forall b. Term b -> b) -> GE a) ->
-  (Term a -> Pred) ->
-  Pred
-exists sem k =
-  Exists sem $ bind k
-
-unsafeExists ::
-  forall a.
-  HasSpec a =>
-  (Term a -> Pred) ->
-  Pred
-unsafeExists = exists (\_ -> fatalError "unsafeExists")
-
-notMemberSpec :: forall a f. (HasSpec a, Foldable f) => f a -> Spec a
-notMemberSpec x = TypeSpec (anySpec @a) (Foldable.toList x)
-
-isErrorLike :: forall a. Spec a -> Bool
-isErrorLike spec = isJust (hasError spec)
-
-hasError :: forall a. Spec a -> Maybe (NonEmpty String)
-hasError (ErrorSpec ss) = Just ss
-hasError (TypeSpec x _) =
-  case guardTypeSpec @a x of
-    ErrorSpec ss -> Just ss
-    _ -> Nothing
-hasError _ = Nothing
-
--- | Given two 'Spec', return an 'ErrorSpec' if one or more is an 'ErrorSpec'
---   If neither is an 'ErrorSpec' apply the continuation 'f'
-handleErrors :: Spec a -> Spec b -> (Spec a -> Spec b -> Spec c) -> Spec c
-handleErrors spec1 spec2 f = case (hasError spec1, hasError spec2) of
-  (Just m1, Just m2) -> ErrorSpec (m1 <> m2)
-  (Just m1, _) -> ErrorSpec m1
-  (_, Just m2) -> ErrorSpec m2
-  (Nothing, Nothing) -> f spec1 spec2
-
--- =========================================================
--- Conformance of Pred and Spec
-
--- | Add the explanations, if it's an ErrorSpec, else drop them
-addToErrorSpec :: NE.NonEmpty String -> Spec a -> Spec a
-addToErrorSpec es (ErrorSpec es') = ErrorSpec (es <> es')
-addToErrorSpec _ s = s
-
--- | return a MemberSpec or ans ErrorSpec depending on if 'xs' the null list or not
-memberSpec :: [a] -> NE.NonEmpty String -> Spec a
-memberSpec xs messages =
-  case NE.nonEmpty xs of
-    Nothing -> ErrorSpec messages
-    Just ys -> MemberSpec ys
-
-satisfies :: forall a. HasSpec a => Term a -> Spec a -> Pred
-satisfies _ TrueSpec = TruePred
-satisfies e (MemberSpec nonempty) = ElemPred True e nonempty
-satisfies t (SuspendedSpec x p) = Subst x t p
-satisfies e (TypeSpec s cant) = case cant of
-  [] -> toPreds e s
-  (c : cs) -> ElemPred False e (c :| cs) <> toPreds e s
-satisfies _ (ErrorSpec e) = FalsePred e
-
-runTermE :: forall a. Env -> Term a -> Either (NE.NonEmpty String) a
-runTermE env = \case
-  Lit a -> Right a
-  V v -> case Env.lookup env v of
-    Just a -> Right a
-    Nothing -> Left (pure ("Couldn't find " ++ show v ++ " in " ++ show env))
-  App f (ts :: List Term dom) -> do
-    vs <- mapMList (fmap Identity . runTermE env) ts
-    pure $ uncurryList_ runIdentity (semantics f) vs
-
-runTerm :: MonadGenError m => Env -> Term a -> m a
-runTerm env x = case runTermE env x of
-  Left msgs -> fatalErrorNE msgs
-  Right val -> pure val
-
-conformsToSpec :: forall a. HasSpec a => a -> Spec a -> Bool
-conformsToSpec _ TrueSpec = True
-conformsToSpec a (MemberSpec as) = elem a as
-conformsToSpec a (TypeSpec s cant) = notElem a cant && conformsTo a s
-conformsToSpec a (SuspendedSpec v ps) = case checkPredE (Env.singleton v a) (pure "checkPredE") ps of
-  Nothing -> True
-  Just _ -> False
-conformsToSpec _ (ErrorSpec _) = False
-
-checkPredE :: Env -> NonEmpty String -> Pred -> Maybe (NonEmpty String)
-checkPredE env msgs = \case
-  p@(ElemPred bool t xs) ->
-    case runTermE env t of
-      Left message -> Just (msgs <> message)
-      Right v -> case (elem v xs, bool) of
-        (True, True) -> Nothing
-        (True, False) -> Just ("notElemPred reduces to True" :| [show p])
-        (False, True) -> Just ("elemPred reduces to False" :| [show p])
-        (False, False) -> Nothing
-  Subst x t p -> checkPredE env msgs $ substitutePred x t p
-  Assert t -> case runTermE env t of
-    Right True -> Nothing
-    Right False ->
-      Just
-        (msgs <> pure ("Assert " ++ show t ++ " returns False") <> pure ("\nenv=\n" ++ show (pretty env)))
-    Left es -> Just (msgs <> es)
-  ForAll t (x :-> p) -> case runTermE env t of
-    Left es -> Just $ (msgs <> NE.fromList ["checkPredE: ForAll fails to run."] <> es)
-    Right set ->
-      let answers =
-            catMaybes
-              [ checkPredE env' (pure "Some items in ForAll fail") p
-              | v <- forAllToList set
-              , let env' = Env.extend x v env
-              ]
-       in case answers of
-            [] -> Nothing
-            (y : ys) -> Just (NE.nub (sconcat (y NE.:| ys)))
-  Case t a b -> case runTermE env t of
-    Right v -> runCaseOn v a b (\x val ps -> checkPredE (Env.extend x val env) msgs ps)
-    Left es -> Just (msgs <> pure "checkPredE: Case fails" <> es)
-  Let t (x :-> p) -> case runTermE env t of
-    Right val -> checkPredE (Env.extend x val env) msgs p
-    Left es -> Just (msgs <> pure "checkPredE: Let fails" <> es)
-  DependsOn {} -> Nothing
-  TruePred -> Nothing
-  FalsePred es -> Just (msgs <> pure "checkPredE: FalsePred" <> es)
-  And ps ->
-    case catMaybes (fmap (checkPredE env (pure "Some items in And  fail")) ps) of
-      [] -> Nothing
-      (x : xs) -> Just (msgs <> NE.nub (sconcat (x NE.:| xs)))
-  Exists k (x :-> p) ->
-    let eval :: forall b. Term b -> b
-        eval term = case runTermE env term of
-          Right v -> v
-          Left es -> error $ unlines $ NE.toList (msgs <> es)
-     in case k eval of
-          Result a -> checkPredE (Env.extend x a env) msgs p
-          FatalError es -> Just (msgs <> catMessageList es)
-          GenError es -> Just (msgs <> catMessageList es)
-
-runCaseOn ::
-  Either a b -> Binder a -> Binder b -> (forall x. HasSpec x => Var x -> x -> Pred -> r) -> r
-runCaseOn (Left a) (x :-> xps) (_ :-> _) f = f x a xps
-runCaseOn (Right b) (_ :-> _) (y :-> yps) f = f y b yps
-
--- | Like checkPred, But it takes [Pred] rather than a single Pred,
---   and it builds a much more involved explanation if it fails.
---   Does the Pred evaluate to True under the given Env?
---   If it doesn't, an involved explanation appears in the (Just message)
---   If it does, then it returns Nothing
-checkPredsE ::
-  NE.NonEmpty String ->
-  Env ->
-  [Pred] ->
-  Maybe (NE.NonEmpty String)
-checkPredsE msgs env ps =
-  case catMaybes (fmap (checkPredE env msgs) ps) of
-    [] -> Nothing
-    (x : xs) -> Just (NE.nub (sconcat (x NE.:| xs)))
-
--- ==========================================================
--- Semigroup and Monoid instances for Syntax Pred and Spec
-
-instance Semigroup Pred where
-  FalsePred xs <> FalsePred ys = FalsePred (xs <> ys)
-  FalsePred es <> _ = FalsePred es
-  _ <> FalsePred es = FalsePred es
-  TruePred <> p = p
-  p <> TruePred = p
-  p <> p' = And (unpackPred p ++ unpackPred p')
-    where
-      unpackPred (And ps) = ps
-      unpackPred x = [x]
-
-instance Monoid Pred where
-  mempty = TruePred
-
--- Spec instance
-
-instance HasSpec a => Semigroup (Spec a) where
-  TrueSpec <> s = s
-  s <> TrueSpec = s
-  ErrorSpec e <> ErrorSpec e' =
-    ErrorSpec
-      ( e
-          <> pure ("------ spec <> spec ------ @" ++ showType @a)
-          <> e'
-      )
-  ErrorSpec e <> _ = ErrorSpec e
-  _ <> ErrorSpec e = ErrorSpec e
-  MemberSpec as <> MemberSpec as' =
-    addToErrorSpec
-      ( NE.fromList
-          ["Intersecting: ", "  MemberSpec " ++ show (NE.toList as), "  MemberSpec " ++ show (NE.toList as')]
-      )
-      ( memberSpec
-          (nub $ intersect (NE.toList as) (NE.toList as'))
-          (pure "Empty intersection")
-      )
-  ms@(MemberSpec as) <> ts@TypeSpec {} =
-    memberSpec
-      (nub $ NE.filter (`conformsToSpec` ts) as)
-      ( NE.fromList
-          [ "The two " ++ showType @a ++ " Specs are inconsistent."
-          , "  " ++ show ms
-          , "  " ++ show ts
-          ]
-      )
-  TypeSpec s cant <> MemberSpec as = MemberSpec as <> TypeSpec s cant
-  SuspendedSpec v p <> SuspendedSpec v' p' = SuspendedSpec v (p <> rename v' v p')
-  SuspendedSpec v ps <> s = SuspendedSpec v (ps <> satisfies (V v) s)
-  s <> SuspendedSpec v ps = SuspendedSpec v (ps <> satisfies (V v) s)
-  TypeSpec s cant <> TypeSpec s' cant' = case combineSpec s s' of
-    -- NOTE: This might look like an unnecessary case, but doing
-    -- it like this avoids looping.
-    TypeSpec s'' cant'' -> TypeSpec s'' (cant <> cant' <> cant'')
-    s'' -> s'' <> notMemberSpec (cant <> cant')
-
-instance HasSpec a => Monoid (Spec a) where
-  mempty = TrueSpec
-
--- ==================================================
--- Syntactic operation Renaming
--- ==================================================
-
--- Name
-
-data Name where
-  Name :: HasSpec a => Var a -> Name
-
-deriving instance Show Name
-
-instance Eq Name where
-  Name v == Name v' = isJust $ eqVar v v'
-
--- Instances
-
-instance Pretty (Var a) where
-  pretty = fromString . show
-
-instance Pretty Name where
-  pretty (Name v) = pretty v
-
-instance Ord Name where
-  compare (Name v) (Name v') = compare (nameOf v, typeOf v) (nameOf v', typeOf v')
-
-instance Rename Name where
-  rename v v' (Name v'') = Name $ rename v v' v''
-
-instance Rename (Term a) where
-  rename v v'
-    | v == v' = id
-    | otherwise = \case
-        Lit l -> Lit l
-        V v'' -> V (rename v v' v'')
-        App f a -> App f (rename v v' a)
-
-instance Rename Pred where
-  rename v v'
-    | v == v' = id
-    | otherwise = \case
-        ElemPred bool t xs -> ElemPred bool (rename v v' t) xs
-        Subst x t p -> rename v v' $ substitutePred x t p
-        And ps -> And (rename v v' ps)
-        Exists k b -> Exists (\eval -> k $ eval . rename v v') (rename v v' b)
-        Let t b -> Let (rename v v' t) (rename v v' b)
-        DependsOn x y -> DependsOn (rename v v' x) (rename v v' y)
-        Assert t -> Assert (rename v v' t)
-        ForAll set b -> ForAll (rename v v' set) (rename v v' b)
-        Case t a b -> Case (rename v v' t) (rename v v' a) (rename v v' b)
-        TruePred -> TruePred
-        FalsePred es -> FalsePred es
-
-instance Rename (Binder a) where
-  rename v v' (va :-> psa) = va' :-> rename v v' psa'
-    where
-      (va', psa') = freshen va psa (Set.fromList [nameOf v, nameOf v'] <> Set.delete (nameOf va) (freeVarNames psa))
-
--- ============================================================
--- Syntactic operation: Free variables and variable names
--- ============================================================
-
-freeVarNames :: forall t. HasVariables t => t -> Set Int
-freeVarNames = Set.mapMonotonic (\(Name v) -> nameOf v) . freeVarSet
-
-newtype FreeVars = FreeVars {unFreeVars :: Map Name Int}
-  deriving (Show)
-
-restrictedTo :: FreeVars -> Set Name -> FreeVars
-restrictedTo (FreeVars m) nms = FreeVars $ Map.restrictKeys m nms
-
-memberOf :: Name -> FreeVars -> Bool
-memberOf n (FreeVars m) = Map.member n m
-
-count :: Name -> FreeVars -> Int
-count n (FreeVars m) = fromMaybe 0 $ Map.lookup n m
-
-instance Semigroup FreeVars where
-  FreeVars fv <> FreeVars fv' = FreeVars $ Map.unionWith (+) fv fv'
-
-instance Monoid FreeVars where
-  mempty = FreeVars mempty
-
-freeVar :: Name -> FreeVars
-freeVar n = singleton n 1
-
-singleton :: Name -> Int -> FreeVars
-singleton n k = FreeVars $ Map.singleton n k
-
-without :: Foldable t => FreeVars -> t Name -> FreeVars
-without (FreeVars m) remove = FreeVars $ foldr Map.delete m (Foldable.toList remove)
-
-class HasVariables a where
-  freeVars :: a -> FreeVars
-  freeVarSet :: a -> Set Name
-  freeVarSet = Map.keysSet . unFreeVars . freeVars
-  countOf :: Name -> a -> Int
-  countOf n = count n . freeVars
-  appearsIn :: Name -> a -> Bool
-  appearsIn n = (> 0) . count n . freeVars
-
-instance (HasVariables a, HasVariables b) => HasVariables (a, b) where
-  freeVars (a, b) = freeVars a <> freeVars b
-  freeVarSet (a, b) = freeVarSet a <> freeVarSet b
-  countOf n (a, b) = countOf n a + countOf n b
-  appearsIn n (a, b) = appearsIn n a || appearsIn n b
-
-instance HasVariables (List Term as) where
-  freeVars Nil = mempty
-  freeVars (x :> xs) = freeVars x <> freeVars xs
-  freeVarSet Nil = mempty
-  freeVarSet (x :> xs) = freeVarSet x <> freeVarSet xs
-  countOf _ Nil = 0
-  countOf n (x :> xs) = countOf n x + countOf n xs
-  appearsIn _ Nil = False
-  appearsIn n (x :> xs) = appearsIn n x || appearsIn n xs
-
-instance HasVariables Name where
-  freeVars = freeVar
-  freeVarSet = Set.singleton
-  countOf n n'
-    | n == n' = 1
-    | otherwise = 0
-  appearsIn n n' = n == n'
-
-instance HasVariables (Term a) where
-  freeVars = \case
-    Lit {} -> mempty
-    V x -> freeVar (Name x)
-    App _ ts -> freeVars ts
-  freeVarSet = \case
-    Lit {} -> mempty
-    V x -> freeVarSet (Name x)
-    App _ ts -> freeVarSet ts
-  countOf n = \case
-    Lit {} -> 0
-    V x -> countOf n (Name x)
-    App _ ts -> countOf n ts
-  appearsIn n = \case
-    Lit {} -> False
-    V x -> appearsIn n (Name x)
-    App _ ts -> appearsIn n ts
-
-instance HasVariables Pred where
-  freeVars = \case
-    ElemPred _ t _ -> freeVars t
-    -- GenHint _ t -> freeVars t
-    Subst x t p -> freeVars t <> freeVars p `without` [Name x]
-    And ps -> foldMap freeVars ps
-    Exists _ b -> freeVars b
-    Let t b -> freeVars t <> freeVars b
-    -- Exists _ b -> freeVars b
-    Assert t -> freeVars t
-    -- Reifies t' t _ -> freeVars t' <> freeVars t
-    DependsOn x y -> freeVars x <> freeVars y
-    ForAll set b -> freeVars set <> freeVars b
-    Case t as bs -> freeVars t <> freeVars as <> freeVars bs
-    -- When b p -> freeVars b <> freeVars p
-    TruePred -> mempty
-    FalsePred _ -> mempty
-
-  -- Monitor {} -> mempty
-  -- Explain _ p -> freeVars p
-  freeVarSet = \case
-    ElemPred _ t _ -> freeVarSet t
-    -- GenHint _ t -> freeVarSet t
-    Subst x t p -> freeVarSet t <> Set.delete (Name x) (freeVarSet p)
-    And ps -> foldMap freeVarSet ps
-    Exists _ b -> freeVarSet b
-    Let t b -> freeVarSet t <> freeVarSet b
-    -- Exists _ b -> freeVarSet b
-    Assert t -> freeVarSet t
-    -- Reifies t' t _ -> freeVarSet t' <> freeVarSet t
-    DependsOn x y -> freeVarSet x <> freeVarSet y
-    ForAll set b -> freeVarSet set <> freeVarSet b
-    Case t a b -> freeVarSet t <> freeVarSet a <> freeVarSet b
-    -- When b p -> freeVarSet b <> freeVarSet p
-    -- Explain _ p -> freeVarSet p
-    TruePred -> mempty
-    FalsePred _ -> mempty
-
-  -- Monitor {} -> mempty
-  countOf n = \case
-    ElemPred _ t _ -> countOf n t
-    -- GenHint _ t -> countOf n t
-    Subst x t p
-      | n == Name x -> countOf n t
-      | otherwise -> countOf n t + countOf n p
-    And ps -> sum $ map (countOf n) ps
-    Let t b -> countOf n t + countOf n b
-    Exists _ b -> countOf n b
-    Assert t -> countOf n t
-    -- Reifies t' t _ -> countOf n t' + countOf n t
-    DependsOn x y -> countOf n x + countOf n y
-    ForAll set b -> countOf n set + countOf n b
-    Case t a b -> countOf n t + countOf n a + countOf n b
-    -- When b p -> countOf n b + countOf n p
-    -- Explain _ p -> countOf n p
-    TruePred -> 0
-    FalsePred _ -> 0
-
-  -- Monitor {} -> 0
-  appearsIn n = \case
-    ElemPred _ t _ -> appearsIn n t
-    -- GenHint _ t -> appearsIn n t
-    Subst x t p
-      | n == Name x -> appearsIn n t
-      | otherwise -> appearsIn n t || appearsIn n p
-    And ps -> any (appearsIn n) ps
-    Let t b -> appearsIn n t || appearsIn n b
-    Exists _ b -> appearsIn n b
-    Assert t -> appearsIn n t
-    -- Reifies t' t _ -> appearsIn n t' || appearsIn n t
-    DependsOn x y -> appearsIn n x || appearsIn n y
-    ForAll set b -> appearsIn n set || appearsIn n b
-    Case t a b -> appearsIn n t || appearsIn n a || appearsIn n b
-    -- When b p -> appearsIn n b || appearsIn n p
-    -- Explain _ p -> appearsIn n p
-    TruePred -> False
-    FalsePred _ -> False
-
--- Monitor {} -> False
-
-instance HasVariables (Binder a) where
-  freeVars (x :-> p) = freeVars p `without` [Name x]
-  freeVarSet (x :-> p) = Set.delete (Name x) (freeVarSet p)
-  countOf n (x :-> p)
-    | Name x == n = 0
-    | otherwise = countOf n p
-  appearsIn n (x :-> p)
-    | Name x == n = False
-    | otherwise = appearsIn n p
-
-instance {-# OVERLAPPABLE #-} (Foldable t, HasVariables a) => HasVariables (t a) where
-  freeVars = foldMap freeVars
-  freeVarSet = foldMap freeVarSet
-  countOf n = Monoid.getSum . foldMap (Monoid.Sum . countOf n)
-  appearsIn n = any (appearsIn n)
-
-instance HasVariables a => HasVariables (Set a) where
-  freeVars = foldMap freeVars
-  freeVarSet = foldMap freeVarSet
-  countOf n = sum . Set.map (countOf n)
-  appearsIn n = any (appearsIn n)
-
--- =========================================================
--- Helpers
-
-fromLits :: List Term as -> Maybe (List Value as)
-fromLits = mapMList fromLit
-
-fromLit :: Term a -> Maybe (Value a)
-fromLit (Lit l) = pure $ Value l
--- fromLit (To x) = (Value . toSimpleRep . unValue) <$> fromLit x -- MAYBE we don't want to do this?
--- fromLit (From x) = (Value . fromSimpleRep . unValue) <$> fromLit x -- Why not apply unary functions to Lit ?
-fromLit _ = Nothing
-
-isLit :: Term a -> Bool
-isLit = isJust . fromLit
-
--- =================================================================
--- Syntactic operations Substitutions
--- ============================================================
-
-type Subst = [SubstEntry]
-
-data SubstEntry where
-  (:=) :: HasSpec a => Var a -> Term a -> SubstEntry
-
-backwardsSubstitution :: forall a. HasSpec a => Subst -> Term a -> Term a
-backwardsSubstitution sub0 t =
-  case findMatch sub0 t of
-    -- TODO: what about multiple matches??
-    Just x -> V x
-    Nothing -> case t of
-      Lit a -> Lit a
-      V x -> V x
-      App f ts -> App f (mapListC @HasSpec (backwardsSubstitution sub0) ts)
-  where
-    findMatch :: Subst -> Term a -> Maybe (Var a)
-    findMatch [] _ = Nothing
-    findMatch (x := t' : sub1) t1
-      | fastInequality t1 t' = findMatch sub1 t1
-      | Just (x', t'') <- cast (x, t')
-      , t == t'' =
-          Just x'
-      | otherwise = findMatch sub1 t1
-
--- | Sound but not complete inequality on terms
-fastInequality :: Term a -> Term b -> Bool
-fastInequality (V (Var i _)) (V (Var j _)) = i /= j
-fastInequality Lit {} Lit {} = False
-fastInequality (App _ as) (App _ bs) = go as bs
-  where
-    go :: List Term as -> List Term bs -> Bool
-    go Nil Nil = False
-    go (a :> as') (b :> bs') = fastInequality a b || go as' bs'
-    go _ _ = True
-fastInequality _ _ = True
-
--- ===================================================================
-
-substituteTerm :: forall a. Subst -> Term a -> Term a
-substituteTerm sub = \case
-  Lit a -> Lit a
-  V x -> substVar sub x
-  App f (mapList (substituteTerm sub) -> (ts :: List Term dom)) ->
-    case fromLits ts of
-      Just vs -> Lit (uncurryList_ unValue (semantics f) vs)
-      _ -> App f ts
-  where
-    substVar :: HasSpec a => Subst -> Var a -> Term a
-    substVar [] x = V x
-    substVar (y := t : sub1) x
-      | Just Refl <- eqVar x y = t
-      | otherwise = substVar sub1 x
-
-substituteTerm' :: forall a. Subst -> Term a -> Writer Any (Term a)
-substituteTerm' sub = \case
-  Lit a -> pure $ Lit a
-  V x -> substVar sub x
-  App f ts ->
-    App f <$> mapMList (substituteTerm' sub) ts
-  where
-    substVar :: HasSpec a => Subst -> Var a -> Writer Any (Term a)
-    substVar [] x = pure $ V x
-    substVar (y := t : sub1) x
-      | Just Refl <- eqVar x y = t <$ tell (Any True)
-      | otherwise = substVar sub1 x
-
-substituteBinder :: HasSpec a => Var a -> Term a -> Binder b -> Binder b
-substituteBinder x tm (y :-> p) = y' :-> substitutePred x tm p'
-  where
-    (y', p') =
-      freshen y p (Set.singleton (nameOf x) <> freeVarNames tm <> Set.delete (nameOf y) (freeVarNames p))
-
-substitutePred :: HasSpec a => Var a -> Term a -> Pred -> Pred
-substitutePred x tm = \case
-  ElemPred bool t xs -> ElemPred bool (substituteTerm [x := tm] t) xs
-  -- GenHint h t -> GenHint h (substituteTerm [x := tm] t)
-  Subst x' t p -> substitutePred x tm $ substitutePred x' t p
-  Assert t -> Assert (substituteTerm [x := tm] t)
-  And ps -> Foldable.fold (substitutePred x tm <$> ps)
-  Exists k b -> Exists (\eval -> k (eval . substituteTerm [x := tm])) (substituteBinder x tm b)
-  Let t b -> Let (substituteTerm [x := tm] t) (substituteBinder x tm b)
-  ForAll t b -> ForAll (substituteTerm [x := tm] t) (substituteBinder x tm b)
-  Case t as bs -> Case (substituteTerm [x := tm] t) (substituteBinder x tm as) (substituteBinder x tm bs)
-  -- When b p -> When (substituteTerm [x := tm] b) (substitutePred x tm p)
-  -- Reifies t' t f -> Reifies (substituteTerm [x := tm] t') (substituteTerm [x := tm] t) f
-  DependsOn t t' -> DependsOn (substituteTerm [x := tm] t) (substituteTerm [x := tm] t')
-  TruePred -> TruePred
-  FalsePred es -> FalsePred es
-
--- Monitor m -> Monitor (\eval -> m (eval . substituteTerm [x := tm]))
--- Explain es p -> Explain es $ substitutePred x tm p
-
--- =====================================================
--- Substituion under an Env, rather than a single Var
--- It takes Values in the Env, and makes them Literals in the Term.
-
-substTerm :: Env -> Term a -> Term a
-substTerm env = \case
-  Lit a -> Lit a
-  V v
-    | Just a <- Env.lookup env v -> Lit a
-    | otherwise -> V v
-  App f (mapList (substTerm env) -> ts) ->
-    case fromLits ts of
-      Just vs -> Lit (uncurryList_ unValue (semantics f) vs)
-      _ -> App f ts
-
-substBinder :: Env -> Binder a -> Binder a
-substBinder env (x :-> p) = x :-> substPred (Env.remove x env) p
-
-substPred :: Env -> Pred -> Pred
-substPred env = \case
-  ElemPred bool t xs -> ElemPred bool (substTerm env t) xs
-  -- GenHint h t -> GenHint h (substTerm env t)
-  Subst x t p -> substPred env $ substitutePred x t p
-  Assert t -> Assert (substTerm env t)
-  -- Reifies t' t f -> Reifies (substTerm env t') (substTerm env t) f
-  ForAll set b -> ForAll (substTerm env set) (substBinder env b)
-  Case t as bs -> Case (substTerm env t) (substBinder env as) (substBinder env bs)
-  -- When b p -> When (substTerm env b) (substPred env p)
-  DependsOn x y -> DependsOn (substTerm env x) (substTerm env y)
-  TruePred -> TruePred
-  FalsePred es -> FalsePred es
-  And ps -> Foldable.fold (substPred env <$> ps)
-  Exists k b -> Exists (\eval -> k $ eval . substTerm env) (substBinder env b)
-  Let t b -> Let (substTerm env t) (substBinder env b)
-
-substSpec :: Env -> Spec a -> Spec a
-substSpec env (SuspendedSpec v p) = SuspendedSpec v (substPred env p)
-substSpec _ spec = spec
-
-substSolverStage :: Env -> SolverStage -> SolverStage
-substSolverStage env (SolverStage var preds spec) = SolverStage var (map (substPred env) preds) (substSpec env spec)
-
-substPlan :: Env -> SolverPlan -> SolverPlan
-substPlan env (SolverPlan stages deps) = SolverPlan (map (substSolverStage env) stages) deps
-
--- Monitor m -> Monitor m
--- Explain es p -> Explain es $ substPred env p
-
-unBind :: a -> Binder a -> Pred
-unBind a (x :-> p) = substPred (Env.singleton x a) p
-
--- ==================================================
--- Syntactic operation Regularizing
--- ==================================================
-
-liftNameHintToBinder :: HasVariables t => Var a -> t -> Var a
-liftNameHintToBinder v t =
-  case [nameHint v' | Name v' <- Set.toList $ freeVarSet t, nameOf v' == nameOf v, nameHint v' /= "v"] of
-    [] -> v
-    nh : _ -> v {nameHint = nh}
-
-liftNameHintToBinderBinder :: Binder a -> Binder a
-liftNameHintToBinderBinder (x :-> p) = x' :-> substitutePred x (V x') (applyNameHintsPred p)
-  where
-    x' = liftNameHintToBinder x p
-
-applyNameHintsPred :: Pred -> Pred
-applyNameHintsPred pred0 = case pred0 of
-  ElemPred {} -> pred0
-  And ps -> And $ map applyNameHintsPred ps
-  Exists k b -> Exists k (liftNameHintToBinderBinder b)
-  Subst v t p -> applyNameHintsPred (substitutePred v t p)
-  Let t b -> Let t (liftNameHintToBinderBinder b)
-  Assert {} -> pred0
-  ForAll t b -> ForAll t (liftNameHintToBinderBinder b)
-  Case t as bs -> Case t (liftNameHintToBinderBinder as) (liftNameHintToBinderBinder bs)
-  TruePred {} -> pred0
-  FalsePred {} -> pred0
-  DependsOn {} -> pred0
-
--- Explain es p' -> Explain es (applyNameHintsPred p')
-
-applyNameHints :: Spec a -> Spec a
-applyNameHints (SuspendedSpec x p) = SuspendedSpec x' p'
-  where
-    x' :-> p' = liftNameHintToBinderBinder (x :-> p)
-applyNameHints spec = spec
-
--- ======================================================
--- Simplify
-
--- | Apply a substitution and simplify the resulting term if the
--- substitution changed the term.
-substituteAndSimplifyTerm :: Subst -> Term a -> Term a
-substituteAndSimplifyTerm sub t =
-  case runWriter $ substituteTerm' sub t of
-    (t', Any b)
-      | b -> simplifyTerm t'
-      | otherwise -> t'
-
--- | Simplify a Term, if the Term is an 'App', apply the rewrite rules
---   chosen by the (Semantics t)  instance attached to the App
---   to the function witness 'f'
-simplifyTerm :: forall a. Term a -> Term a
-simplifyTerm = \case
-  V v -> V v
-  Lit l -> Lit l
-  App (f :: t bs a) (mapList simplifyTerm -> ts)
-    | Just vs <- fromLits ts -> Lit $ uncurryList_ unValue (semantics f) vs
-    | Just t <- rewriteRules f ts (Evidence @(Typeable a, Eq a, Show a)) -> simplifyTerm t
-    | otherwise -> App f ts
-
-simplifyPred :: Pred -> Pred
-simplifyPred = \case
-  -- If the term simplifies away to a literal, that means there is no
-  -- more generation to do so we can get rid of `GenHint`
-  p@(ElemPred bool t xs) -> case simplifyTerm t of
-    Lit x -> case (elem x xs, bool) of
-      (True, True) -> TruePred
-      (True, False) -> FalsePred ("notElemPred reduces to True" :| [show p])
-      (False, True) -> FalsePred ("elemPred reduces to False" :| [show p])
-      (False, False) -> TruePred
-    t' -> ElemPred bool t' xs
-  Subst x t p -> simplifyPred $ substitutePred x t p
-  Assert t -> Assert $ simplifyTerm t
-  ForAll (ts :: Term t) (b :: Binder a) -> case simplifyTerm ts of
-    Lit as -> foldMap (`unBind` b) (forAllToList as)
-    set' -> case simplifyBinder b of
-      (_ :-> TruePred) -> TruePred
-      b' -> ForAll set' b'
-  Case t as@(_ :-> _) bs@(_ :-> _) -> mkCase (simplifyTerm t) (simplifyBinder as) (simplifyBinder bs)
-  TruePred -> TruePred
-  FalsePred es -> FalsePred es
-  And ps -> Foldable.fold (simplifyPreds ps)
-  Let t b -> case simplifyTerm t of
-    t'@App {} -> Let t' (simplifyBinder b)
-    -- Variable or literal
-    t' | x :-> p <- b -> simplifyPred $ substitutePred x t' p
-  Exists k b -> case simplifyBinder b of
-    _ :-> TruePred -> TruePred
-    -- This is to get rid of exisentials like:
-    -- `constrained $ \ x -> exists $ \ y -> [x ==. y, y + 2 <. 10]`
-    x :-> p | Just t <- pinnedBy x p -> simplifyPred $ substitutePred x t p
-    b' -> Exists k b'
-  DependsOn _ Lit {} -> TruePred
-  DependsOn Lit {} _ -> TruePred
-  DependsOn x y -> DependsOn x y
-
-mkCase ::
-  HasSpec (Either a b) => Term (Either a b) -> Binder a -> Binder b -> Pred
-mkCase tm as bs
-  -- TODO: all equal maybe?
-  | isTrueBinder as && isTrueBinder bs = TruePred
-  | isFalseBinder as && isFalseBinder bs = FalsePred (pure "mkCase on all False")
-  | Lit a <- tm = runCaseOn a as bs (\x val p -> substPred (Env.singleton x val) p)
-  | otherwise = Case tm as bs
-  where
-    isTrueBinder (_ :-> TruePred) = True
-    isTrueBinder (_ :-> _) = False
-
-    isFalseBinder (_ :-> FalsePred {}) = True
-    isFalseBinder (_ :-> _) = False
-
-simplifyPreds :: [Pred] -> [Pred]
-simplifyPreds = go [] . map simplifyPred
-  where
-    go acc [] = reverse acc
-    go _ (FalsePred err : _) = [FalsePred err]
-    go acc (TruePred : ps) = go acc ps
-    go acc (p : ps) = go (p : acc) ps
-
-simplifyBinder :: Binder a -> Binder a
-simplifyBinder (x :-> p) = x :-> simplifyPred p
-
-toPred :: Bool -> Pred
-toPred True = TruePred
-toPred False = FalsePred (pure "toPred False")
-
--- =================================================================
-
--- TODO: this can probably be cleaned up and generalized along with generalizing
--- to make sure we float lets in some missing cases.
-letFloating :: Pred -> Pred
-letFloating = Foldable.fold . go []
-  where
-    goBlock ctx ps = goBlock' (freeVarNames ctx <> freeVarNames ps) ctx ps
-
-    goBlock' _ ctx [] = ctx
-    goBlock' fvs ctx (Let t (x :-> p) : ps) =
-      -- We can do `goBlock'` here because we've already done let floating
-      -- on the inner `p`
-      [Let t (x' :-> Foldable.fold (goBlock' (Set.insert (nameOf x') fvs) ctx (p' : ps)))]
-      where
-        (x', p') = freshen x p fvs
-    goBlock' fvs ctx (And ps : ps') = goBlock' fvs ctx (ps ++ ps')
-    goBlock' fvs ctx (p : ps) = goBlock' fvs (p : ctx) ps
-
-    go ctx = \case
-      ElemPred bool t xs -> ElemPred bool t xs : ctx
-      And ps0 -> goBlock ctx (map letFloating ps0)
-      Exists k (x :-> p) -> goExists ctx (Exists k) x (letFloating p)
-      Let t (x :-> p) -> goBlock ctx [Let t (x :-> letFloating p)]
-      Subst x t p -> go ctx (substitutePred x t p)
-      ForAll t (x :-> p) -> ForAll t (x :-> letFloating p) : ctx
-      Case t (x :-> px) (y :-> py) -> Case t (x :-> letFloating px) (y :-> letFloating py) : ctx
-      Assert t -> Assert t : ctx
-      TruePred -> TruePred : ctx
-      FalsePred es -> FalsePred es : ctx
-      DependsOn t t' -> DependsOn t t' : ctx
-
-    goExists :: HasSpec a => [Pred] -> (Binder a -> Pred) -> Var a -> Pred -> [Pred]
-    goExists ctx ex x (Let t (y :-> p))
-      | not $ Name x `appearsIn` t =
-          let (y', p') = freshen y p (Set.insert (nameOf x) $ freeVarNames p <> freeVarNames t)
-           in go ctx (Let t (y' :-> ex (x :-> p')))
-    goExists ctx ex x p = ex (x :-> p) : ctx
-
--- Common subexpression elimination but only on terms that are already let-bound.
-letSubexpressionElimination :: HasSpec Bool => Pred -> Pred
-letSubexpressionElimination = go []
-  where
-    adjustSub x sub =
-      [ x' := t
-      | x' := t <- sub
-      , isNothing $ eqVar x x'
-      , -- TODO: possibly freshen the binder where
-      -- `x` appears instead?
-      not $ Name x `appearsIn` t
-      ]
-
-    goBinder :: Subst -> Binder a -> Binder a
-    goBinder sub (x :-> p) = x :-> go (adjustSub x sub) p
-
-    go sub = \case
-      ElemPred bool t xs -> ElemPred bool (backwardsSubstitution sub t) xs
-      And ps -> And (go sub <$> ps)
-      Exists k b -> Exists k (goBinder sub b)
-      Let t (x :-> p) -> Let t' (x :-> go (x := t' : sub') p)
-        where
-          t' = backwardsSubstitution sub t
-          sub' = adjustSub x sub
-      Subst x t p -> go sub (substitutePred x t p)
-      Assert t -> Assert (backwardsSubstitution sub t)
-      ForAll t b -> ForAll (backwardsSubstitution sub t) (goBinder sub b)
-      Case t as bs -> Case (backwardsSubstitution sub t) (goBinder sub as) (goBinder sub bs)
-      TruePred -> TruePred
-      FalsePred es -> FalsePred es
-      DependsOn t t' -> DependsOn (backwardsSubstitution sub t) (backwardsSubstitution sub t')
-
--- ===============================================================================
--- Syntax for Solving : stages and plans
--- ===============================================================================
-
-data SolverStage where
-  SolverStage ::
-    HasSpec a =>
-    { stageVar :: Var a
-    , stagePreds :: [Pred]
-    , stageSpec :: Spec a
-    } ->
-    SolverStage
-
-instance Pretty SolverStage where
-  pretty SolverStage {..} =
-    (viaShow stageVar <+> "<-")
-      /> vsep'
-        ( [pretty stageSpec | not $ isTrueSpec stageSpec]
-            ++ (map pretty stagePreds)
-            ++ ["---"]
-        )
-
-data SolverPlan = SolverPlan
-  { solverPlan :: [SolverStage]
-  , solverDependencies :: Graph Name
-  }
-
-instance Pretty SolverPlan where
-  pretty SolverPlan {..} =
-    "\nSolverPlan"
-      /> vsep'
-        [ -- "\nDependencies:" /> pretty solverDependencies, -- Might be usefull someday
-          "Linearization:" /> prettyLinear solverPlan
-        ]
-
-isTrueSpec :: Spec a -> Bool
-isTrueSpec TrueSpec = True
-isTrueSpec _ = False
-
-prettyLinear :: [SolverStage] -> Doc ann
-prettyLinear = vsep' . map pretty
-
--- ==========================================================
--- The equality function symbol (==.)
-
-data EqSym :: [Type] -> Type -> Type where
-  EqualW :: (Eq a, HasSpec a) => EqSym '[a, a] Bool
-
-deriving instance Eq (EqSym dom rng)
-
-instance Show (EqSym d r) where
-  show EqualW = "==."
-
-instance Syntax EqSym where
-  inFix EqualW = True
-  name EqualW = "==."
-
-instance Semantics EqSym where
-  semantics EqualW = (==)
-
-  rewriteRules EqualW (t :> t' :> Nil) Evidence
-    | t == t' = Just $ Lit True
-  rewriteRules t@EqualW l Evidence = Lit <$> (applyFunSym @EqSym (semantics t) l)
-
--- We don't need a HasSpec instance, since we can make equality specs at any type
--- using just MemberSpec and TypeSpec
-
-equalSpec :: a -> Spec a
-equalSpec = MemberSpec . pure
-
-notEqualSpec :: forall a. HasSpec a => a -> Spec a
-notEqualSpec n = TypeSpec (anySpec @a) [n]
-
-caseBoolSpec :: (HasSpec Bool, HasSpec a) => Spec Bool -> (Bool -> Spec a) -> Spec a
-caseBoolSpec spec cont = case possibleValues spec of
-  [] -> ErrorSpec (NE.fromList ["No possible values in caseBoolSpec"])
-  [b] -> cont b
-  _ -> mempty
-  where
-    possibleValues s = filter (flip conformsToSpec s) [True, False]
-
-instance Logic EqSym where
-  propagate tag ctx spec = case (tag, ctx, spec) of
-    (_, _, TrueSpec) -> TrueSpec
-    (_, _, ErrorSpec msgs) -> ErrorSpec msgs
-    (f, context, SuspendedSpec v ps) -> constrained $ \v' -> Let (App f (fromListCtx context v')) (v :-> ps)
-    (EqualW, HOLE :<| s, bspec) -> caseBoolSpec bspec $ \case
-      True -> equalSpec s
-      False -> notEqualSpec s
-    (EqualW, s :|> HOLE, bspec) -> caseBoolSpec bspec $ \case
-      True -> equalSpec s
-      False -> notEqualSpec s
-
-infix 4 ==.
-
-(==.) :: (HasSpec Bool, HasSpec a) => Term a -> Term a -> Term Bool
-(==.) x y = App EqualW (x :> y :> Nil)
-
-getWitness :: forall t t' d r. (AppRequires t d r, Typeable t') => t d r -> Maybe (t' d r)
-getWitness = cast
-
-pattern Equal ::
-  forall b.
-  () =>
-  forall a.
-  (b ~ Bool, Eq a, HasSpec a) =>
-  Term a ->
-  Term a ->
-  Term b
-pattern Equal x y <-
-  ( App
-      (getWitness -> Just EqualW)
-      (x :> y :> Nil)
-    )
-
--- | Is the variable x pinned to some free term in p? (free term
--- meaning that all the variables in the term are free in p).
---
--- TODO: complete this with more cases!
-pinnedBy :: forall a. HasSpec a => Var a -> Pred -> Maybe (Term a)
--- pinnedBy x (Assert (App (extractFn @EqFn @fn -> Just EqualW) (t :> t' :> Nil)))
-pinnedBy x (Assert (Equal t t'))
-  | V x' <- t, Just Refl <- eqVar x x' = Just t'
-  | V x' <- t', Just Refl <- eqVar x x' = Just t
-pinnedBy x (And ps) = listToMaybe $ catMaybes $ map (pinnedBy x) ps
-pinnedBy _ _ = Nothing
diff --git a/libs/constrained-generators/testlib/Test/Minimal/Tuple.hs b/libs/constrained-generators/testlib/Test/Minimal/Tuple.hs
deleted file mode 100644
index b2e7bc63c11..00000000000
--- a/libs/constrained-generators/testlib/Test/Minimal/Tuple.hs
+++ /dev/null
@@ -1,356 +0,0 @@
-{-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DerivingVia #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE ViewPatterns #-}
--- HasSpec instances for known types such as (a,b,c), (a,b,c,d) i.e. tuples.
-{-# OPTIONS_GHC -Wno-orphans #-}
-
-module Test.Minimal.Tuple where
-
-import Constrained.GenT
-import Constrained.List hiding (ListCtx)
-import Data.Kind
-import qualified Data.List.NonEmpty as NE
-import Data.Set (Set)
-import Test.Minimal.Base
-import Test.Minimal.Model
-import Test.Minimal.Syntax
-
--- import Data.Coerce
--- import Data.Typeable
-
--- =======================================================
--- Experiment to see if we can build tuples, using only the binary tuple
--- as the base case.  The only compilcated part is the `combineSpec` which
--- uses `guardTypeSpec` to merge the simple sub cases on smaller tuples.
-
-instance (HasSpec a, HasSpec b, HasSpec c) => HasSpec (a, b, c) where
-  type TypeSpec (a, b, c) = (Spec a, Spec (b, c))
-
-  anySpec = (mempty @(Spec a), mempty @(Spec (b, c)))
-
-  combineSpec (a, b) (a', b') = guardTypeSpec (a <> a', b <> b')
-
-  conformsTo (a, b, c) (sa, sbc) = conformsToSpec a sa && conformsToSpec (b, c) sbc
-
-  guardTypeSpec (a, bc) =
-    handleErrors
-      a
-      bc
-      ( \x y -> case (x :: Spec a, y :: Spec (b, c)) of
-          (MemberSpec xs, MemberSpec ys) ->
-            -- Given two MemberSpec, build one MemberSpec, by joining all combinations
-            MemberSpec
-              ( NE.fromList
-                  [ (a', b', c')
-                  | a' <- NE.toList xs
-                  , (b', c') <- NE.toList ys
-                  ]
-              )
-          (specA, specBC) -> constrained $ \p -> And [satisfies (head3_ p) specA, satisfies (tail3_ p) specBC]
-      )
-
-  genFromTypeSpec (a, bc) = f <$> genFromSpecT a <*> genFromSpecT bc
-    where
-      f a' (b', c') = (a', b', c')
-
-  toPreds x (a, bc) = satisfies (head3_ x) a <> satisfies (tail3_ x) bc
-
-head3_ :: All HasSpec '[a, b, c] => Term (a, b, c) -> Term a
-head3_ x = App Head3W (x :> Nil)
-
-tail3_ :: All HasSpec '[a, b, c] => Term (a, b, c) -> Term (b, c)
-tail3_ x = App Tail3W (x :> Nil)
-
--- =======================================================
-
-instance (HasSpec a, HasSpec b, HasSpec c, HasSpec d) => HasSpec (a, b, c, d) where
-  type TypeSpec (a, b, c, d) = (Spec a, Spec (b, c, d))
-
-  anySpec = (mempty @(Spec a), mempty @(Spec (b, c, d)))
-
-  combineSpec (a, bcd) (a', bcd') = guardTypeSpec (a <> a', bcd <> bcd')
-
-  conformsTo (a, b, c, d) (sA, sBCD) = conformsToSpec a sA && conformsToSpec (b, c, d) sBCD
-
-  guardTypeSpec (a, bcd) =
-    handleErrors
-      a
-      bcd
-      ( \x y -> case (x, y) of
-          (MemberSpec xs, MemberSpec ys) ->
-            MemberSpec
-              ( NE.fromList
-                  [ (s, b, c, d)
-                  | s <- NE.toList xs
-                  , (b, c, d) <- NE.toList ys
-                  ]
-              )
-          (specA, specBCD) -> constrained $ \ps -> And [satisfies (head4_ ps) specA, satisfies (tail4_ ps) specBCD]
-      )
-
-  genFromTypeSpec (a, bcd) = f <$> genFromSpecT a <*> genFromSpecT bcd
-    where
-      f a' (b, c, d) = (a', b, c, d)
-
-  toPreds x (a, bcd) = satisfies (head4_ x) a <> satisfies (tail4_ x) bcd
-
-head4_ :: All HasSpec '[a, b, c, d] => Term (a, b, c, d) -> Term a
-head4_ x = App Head4W (x :> Nil)
-
-tail4_ :: All HasSpec '[a, b, c, d] => Term (a, b, c, d) -> Term (b, c, d)
-tail4_ x = App Tail4W (x :> Nil)
-
--- ======================================================================
--- We need some function symbols, to break Bigger tuples into sub-tuples
-
-data TupleSym (ds :: [Type]) r where
-  Head3W :: All HasSpec '[a, b, c] => TupleSym '[(a, b, c)] a
-  Tail3W :: All HasSpec '[a, b, c] => TupleSym '[(a, b, c)] (b, c)
-  Head4W :: All HasSpec '[a, b, c, d] => TupleSym '[(a, b, c, d)] a
-  Tail4W :: All HasSpec '[a, b, c, d] => TupleSym '[(a, b, c, d)] (b, c, d)
-
-deriving instance Eq (TupleSym ds r)
-
-instance Show (TupleSym ds r) where show = name
-
-instance Syntax TupleSym where
-  inFix _ = False
-  name Head3W = "head3_"
-  name Tail3W = "tail3_"
-  name Head4W = "head4_"
-  name Tail4W = "tail4_"
-
-instance Semantics TupleSym where
-  semantics Head3W = \(a, _b, _c) -> a
-  semantics Tail3W = \(_a, b, c) -> (b, c)
-  semantics Head4W = \(a, _b, _c, _d) -> a
-  semantics Tail4W = \(_a, b, c, d) -> (b, c, d)
-
-instance Logic TupleSym where
-  propagate _ _ TrueSpec = TrueSpec
-  propagate _ _ (ErrorSpec msgs) = ErrorSpec msgs
-  propagate symW (Unary HOLE) (SuspendedSpec v ps) =
-    constrained $ \v' -> Let (App symW (v' :> Nil)) (v :-> ps)
-  propagate Head3W (Unary HOLE) specA = anyTail3 specA
-  propagate Tail3W (Unary HOLE) specBC = anyHead3 specBC
-  propagate Head4W (Unary HOLE) specA = anyTail4 specA
-  propagate Tail4W (Unary HOLE) specBCD = anyHead4 specBCD
-
-anyHead3 :: forall a b c. (HasSpec a, HasSpec b, HasSpec c) => Spec (b, c) -> Spec (a, b, c)
-anyHead3 specBC = typeSpec @(a, b, c) (mempty @(Spec a), specBC)
-
-anyTail3 :: forall a b c. (HasSpec a, HasSpec b, HasSpec c) => Spec a -> Spec (a, b, c)
-anyTail3 specA = typeSpec (specA, mempty @(Spec (b, c)))
-
-anyHead4 ::
-  forall a b c d. (HasSpec a, HasSpec b, HasSpec c, HasSpec d) => Spec (b, c, d) -> Spec (a, b, c, d)
-anyHead4 specBCD = typeSpec (mempty @(Spec a), specBCD)
-
-anyTail4 ::
-  forall a b c d. (HasSpec a, HasSpec b, HasSpec c, HasSpec d) => Spec a -> Spec (a, b, c, d)
-anyTail4 specA = typeSpec (specA, mempty @(Spec (b, c, d)))
-
--- ======================================================================
--- The Match class, with function `match` makes using all tuples uniform
--- For any n-tuple, supply `match` with an n-ary function to bring into
--- scope 'n' variables with type Term, which can be used to make Pred
--- Note how the binary case is the inductive step, and the others just
--- call the `match` with one less item in the tuple.
-
-class Match t (ts :: [Type]) | t -> ts where
-  match :: All HasSpec ts => Term t -> FunTy (MapList Term ts) Pred -> Pred
-
--- Base case where binary tuple.
-instance Match (a, b) '[a, b] where
-  match ab f =
-    Let
-      (fst_ ab)
-      ( bind $ \ft ->
-          Let (snd_ ab) (bind $ \st -> f ft st)
-      )
-
--- Inductive case for ternary tuple, calls 'match' for binary tuple.
-instance Match (a, b, c) '[a, b, c] where
-  match abc f =
-    Let
-      (head3_ abc)
-      ( bind $ \a ->
-          Let
-            (tail3_ abc)
-            (bind $ \bc -> match @(b, c) bc (f a))
-      )
-
--- Inductive case for quadary tuple, calls 'match' for ternary tuple.
-instance Match (a, b, c, d) '[a, b, c, d] where
-  match abcd f =
-    Let
-      (head4_ abcd)
-      ( bind $ \a ->
-          Let
-            (tail4_ abcd)
-            (bind $ \bcd -> match @(b, c, d) bcd (f a))
-      )
-
--- =========================================================
--- Here are some examples, Notice how the arity of the function
--- passed to `match` changes as the width of the tuples changes.
-
-spec2 :: Spec (Integer, Integer)
-spec2 = constrained $ \x ->
-  match x $ \a b -> Assert $ a <=. b
-
-spec3 :: Spec (Integer, Integer, Integer)
-spec3 = constrained $ \v4 ->
-  match v4 $ \v3 v1 v0 -> And [Assert $ v3 <=. v1, Assert $ v1 <=. v0]
-
-spec4 :: Spec (Integer, Integer, Integer, Integer)
-spec4 = constrained $ \x ->
-  match x $ \a b c d -> And [Assert $ a <=. b, Assert $ b <=. c, Assert $ c <=. d]
-
--- ========================================================
-
-{-
-class TypeList ts where
-  uncurryList :: FunTy (MapList f ts) r -> List f ts -> r
-  uncurryList_ :: (forall a. f a -> a)
-                  -> FunTy ts r -> List f ts -> r
-  curryList :: (List f ts -> r) -> FunTy (MapList f ts) r
-  curryList_ :: (forall a. a -> f a)
-                -> (List f ts -> r) -> FunTy ts r
-  unfoldList :: (forall a (as :: [*]). List f as -> f a) -> List f ts
--}
-
--- | Fold over a (List Term ts) with 'getTermsize' which consumes a Term component for each element of the list
-ex1 :: Maybe Int
-ex1 = uncurryList getTermsize1 args1
-  where
-    args1 :: List Term '[Int, Bool, String]
-    args1 = Lit 5 :> Lit True :> Lit "abc" :> Nil
-    getTermsize1 :: Term Int -> Term Bool -> Term String -> Maybe Int
-    getTermsize1 (Lit n) (Lit b) (Lit s) = Just $ if b then n else length s
-    getTermsize1 _ _ _ = Nothing
-
--- Fold over a list with two parts 'unLit' and 'getSize'
-ex2 :: Int
-ex2 = uncurryList_ unLit getsize2 args2
-  where
-    unLit :: forall a. Term a -> a
-    unLit (Lit n) = n
-    unLit _ = error "unLit on non literal"
-    getsize2 :: Int -> Bool -> String -> Int
-    getsize2 n b s = if b then n else length s
-    args2 :: List Term '[Int, Bool, String]
-    args2 = Lit 5 :> Lit True :> Lit "abc" :> Nil
-
--- Construct a function from a List and function on that list.
-ex3 :: Term a -> Term b -> Term c -> String
-ex3 = curryList crush
-  where
-    crush :: (List Term '[a, b, c] -> String)
-    crush (a :> b :> c :> Nil) = show a ++ show b ++ show c
-
--- Construct a function over from a
-ex4 :: Int -> Bool -> String -> Int
-ex4 = curryList_ one totalLength
-  where
-    totalLength :: List [] '[Int, Bool, String] -> Int
-    totalLength (n :> b :> s :> Nil) = length n + length b + length s
-    one :: a -> [a]
-    one x = [x]
-
-ex5 :: Spec (Set Integer)
-ex5 = constrained $ \s -> Assert (size_ s ==. Lit 104)
-
--- ==========================================================================
-
-data Sum3 a b c where
-  Inj3_1 :: a -> Sum3 a b c
-  Inj3_2 :: b -> Sum3 a b c
-  Inj3_3 :: c -> Sum3 a b c
-
-deriving instance (Show a, Show b, Show c) => Show (Sum3 a b c)
-
-deriving instance (Eq a, Eq b, Eq c) => Eq (Sum3 a b c)
-
-foo_ :: Term (Sum3 a b c) -> Term a
-foo_ = undefined
-
-bar_ = undefined
-
-bar_ :: Term (Sum3 a b c) -> Term (Either b c)
-guardSum3 ::
-  forall a b c. (HasSpec a, HasSpec b, HasSpec c) => Spec a -> Spec (Either b c) -> Spec (Sum3 a b c)
-guardSum3 (ErrorSpec es) (ErrorSpec fs) = ErrorSpec (es <> fs)
-guardSum3 (ErrorSpec es) _ = ErrorSpec (NE.cons "Sum3 error on left" es)
-guardSum3 _ (ErrorSpec es) = ErrorSpec (NE.cons "Sum3 error on right" es)
-guardSum3 s s' = typeSpec $ SumSpec s s'
-
-instance (HasSpec a, HasSpec b, HasSpec c) => HasSpec (Sum3 a b c) where
-  type TypeSpec (Sum3 a b c) = SumSpec (Spec a) (Spec (Either b c))
-
-  anySpec = SumSpec TrueSpec TrueSpec
-
-  combineSpec (SumSpec x y) (SumSpec a b) = guardSum3 (x <> a) (y <> b)
-
-  conformsTo (Inj3_1 a) (SumSpec as _) = conformsToSpec a as
-  conformsTo (Inj3_2 b) (SumSpec _ es) = conformsToSpec (Left b) es
-  conformsTo (Inj3_3 c) (SumSpec _ es) = conformsToSpec (Right c) es
-
-  toPreds x (SumSpec a es) = satisfies (foo_ x) a <> satisfies (bar_ x) es
-
-  genFromTypeSpec (SumSpec (simplifySpec -> sa) (simplifySpec -> sb))
-    | emptyA, emptyB = genError "genFromTypeSpec @SumSpec: empty"
-    | emptyA = Inj3_1 <$> genFromSpecT sa
-    | emptyB = select <$> genFromSpecT sb
-    | otherwise = oneofT [Inj3_1 <$> genFromSpecT sa, select <$> genFromSpecT sb]
-    where
-      emptyA = isErrorLike sa
-      emptyB = isErrorLike sb
-      select :: Either b c -> Sum3 a b c
-      select (Left x) = Inj3_2 x
-      select (Right x) = Inj3_3 x
-
--- ====================================================
-
-coerce_ :: Term (E3 a b c) -> Term (Either a (Either b c))
-coerce_ = undefined
-
-newtype E3 a b c = E3 (Either a (Either b c))
-  deriving (Eq, Show) via Either a (Either b c)
-
-{-
-instance (HasSpec a, HasSpec b, HasSpec c) => HasSpec (E3 a b c) where
-   type TypeSpec (E3 a b c) = TypeSpec (Either a (Either b c))
-
-   anySpec = SumSpec TrueSpec TrueSpec
-
-   combineSpec (SumSpec x y) (SumSpec a b) = typeSpec (SumSpec (x <> a) (y <> b))
-
-   conformsTo (E3 (Left x)) (SumSpec a b) = conformsToSpec x a
-   conformsTo (E3 (Right x)) (SumSpec a b) = conformsToSpec x b
-
-   toPreds x (SumSpec a b) = Case (coerce_ x)
-                                  (bind $ \y -> satisfies y a)
-                                  (bind $ \y -> satisfies y b)
-
-flipp :: (Eq b, Typeable b, Show b, HasSpec b, Coercible a b) => Term a -> Term b
-flipp (Lit x) = Lit (coerce x)
-flipp (V x) = V (coerce x)
--- flipp (App c xs) = App (coerce c) xs
--}