From 4dc702e4e78fbe254cd6e4b09cd3114cb9654063 Mon Sep 17 00:00:00 2001
From: Dan Doel <dan.doel@gmail.com>
Date: Thu, 27 Oct 2022 13:07:55 -0400
Subject: [PATCH 01/41] Add Scheme libraries

---
 chez-libs/unison/boot.ss       | 130 +++++++++++++++++++++
 chez-libs/unison/bytevector.ss |  35 ++++++
 chez-libs/unison/cont.ss       |  47 ++++++++
 chez-libs/unison/core.ss       |  43 +++++++
 chez-libs/unison/primops.ss    | 205 +++++++++++++++++++++++++++++++++
 chez-libs/unison/string.ss     |  60 ++++++++++
 6 files changed, 520 insertions(+)
 create mode 100644 chez-libs/unison/boot.ss
 create mode 100644 chez-libs/unison/bytevector.ss
 create mode 100644 chez-libs/unison/cont.ss
 create mode 100644 chez-libs/unison/core.ss
 create mode 100644 chez-libs/unison/primops.ss
 create mode 100644 chez-libs/unison/string.ss

diff --git a/chez-libs/unison/boot.ss b/chez-libs/unison/boot.ss
new file mode 100644
index 000000000..96ab92f76
--- /dev/null
+++ b/chez-libs/unison/boot.ss
@@ -0,0 +1,130 @@
+; This library implements various syntactic constructs and functions
+; that are used in the compilation of unison (intermediate) source to
+; scheme. The intent is to provide for writing scheme definitions that
+; more directly match the source, so that the compiler doesn't need to
+; emit all the code necessary to fix up the difference itself.
+;
+; Probably the best example of this is the define-unison macro, which
+; looks similar to scheme's define, but the function being defined is
+; allowed to be under/over applied similar to a unison function. It
+; has an 'arity' at which computation happens, but the function
+; automatically handles being applied to fewer or more arguments than
+; that arity appropriately.
+(library (unison boot)
+  (export
+    name
+    define-unison
+    func-wrap
+    handle
+    request
+    unison-force)
+
+  (import (chezscheme)
+          (unison cont))
+
+  ; Helper function. Turns a list of syntax objects into a list-syntax object.
+  (meta define (list->syntax l) #`(#,@l))
+
+  ; Concatenates 
+  (meta define fun-sym
+    (case-lambda
+      [(pfx sfx) (string->symbol (string-append pfx "-" sfx))]
+      [(pfx ifx sfx)
+       (string->symbol (string-append pfx "-" ifx "-" sfx))]))
+
+  ; Computes a symbol for automatically generated partial application
+  ; cases, based on number of arguments applied. The partial
+  ; application of `f` is (locally) named `f-partial-N`
+  (meta define (partial-symbol name m)
+    (fun-sym (symbol->string name) "partial" (number->string m)))
+
+  ; As above, but takes a syntactic object representing the arguments
+  ; rather than their count.
+  (meta define (partial-name name us)
+    (datum->syntax name (syntax->datum name)))
+
+  (define-syntax with-name
+    (syntax-rules ()
+      [(with-name name e) (let ([name e]) name)]))
+
+  ; Builds partial application cases for unison functions. It seems
+  ; most efficient to have a case for each posible under-application.
+  (meta define (build-partials name formals)
+    (let rec ([us formals] [acc '()])
+      (syntax-case us ()
+        [() (list->syntax (cons #`[() #,name] acc))]
+        [(a ... z)
+         (rec #'(a ...)
+              (cons
+                #`[(a ... z)
+                   (with-name
+                     #,(partial-name name us)
+                     (lambda r (apply #,name a ... z r)))]
+                acc))])))
+
+  ; Given an overall function name, a fast path name, and a list of arguments,
+  ; builds the case-lambda body of a unison function that enables applying to
+  ; arbitrary numbers of arguments.
+  (meta define (func-cases name fast args)
+    (syntax-case args ()
+      [() #`(case-lambda
+              [() (#,fast)]
+              [r (apply (#,fast) r)])]
+      [(a ... z)
+       #`(case-lambda
+           #,@(build-partials name #'(a ...))
+           [(a ... z) (#,fast a ... z)]
+           [(a ... z . r) (apply (#,fast a ... z) r)])]))
+
+  (meta define (func-wrap name args body)
+    #`(let ([fast-path (lambda (#,@args) #,@body)])
+        #,(func-cases name #'fast-path args)))
+
+  ; function definition with slow/fast path. Slow path allows for
+  ; under/overapplication. Fast path is exact application.
+  ;
+  ; The intent is for the scheme compiler to be able to recognize and
+  ; optimize static, fast path calls itself, while still supporting
+  ; unison-like automatic partial application and such.
+  (define-syntax (define-unison x)
+    (syntax-case x ()
+      [(define-unison (name a ...) e ...)
+       #`(define name
+           #,(func-wrap #'name #'(a ...) #'(e ...)))]))
+
+  ; call-by-name bindings
+  (define-syntax name
+    (syntax-rules ()
+      ((name ([v (f . args)] ...) body)
+       (let ([v (lambda r (apply f (append (list . args) r)))]
+             ...)
+         body))))
+
+  ; wrapper that more closely matches `handle` constructs
+  (define-syntax handle
+    (syntax-rules ()
+      [(handle [r ...] h e ...)
+       (prompt p (fluid-let ([r (cons p h)] ...) e ...))]))
+
+  ; wrapper that more closely matches ability requests
+  (define-syntax request
+    (syntax-rules ()
+      [(request r t . args)
+       ((cdr r) (list (quote r) t . args))]))
+
+  (define-record-type
+    data
+    (fields type-ref payload))
+
+  (define-syntax data-case
+    (syntax-rules ()
+      [(data-case scrut c ...)
+       (record-case (data-payload scrut) c ...)]))
+
+  ; forces something that is expected to be a thunk, defined with
+  ; e.g. `name` above. In some cases, we might have a normal value,
+  ; so just do nothing in that case.
+  (define (unison-force x)
+    (if (procedure? x) (x) x))
+
+  )
diff --git a/chez-libs/unison/bytevector.ss b/chez-libs/unison/bytevector.ss
new file mode 100644
index 000000000..be58f9540
--- /dev/null
+++ b/chez-libs/unison/bytevector.ss
@@ -0,0 +1,35 @@
+; This library implements missing bytevector functionality for unison
+; builtins. The main missing bits are better support for immutable
+; bytevectors. Chez does provide a way to make an immutable
+; bytevector, but it copies its input, so implementing things that way
+; would make many unncessary copies. This library instead implements
+; functions on immutable bytevectors by directly freezing the newly
+; created mutable vector. It also provides the freezing function,
+; which is itself a unison builtin.
+(library (unison bytevector)
+  (export
+    freeze-bv!
+    ibytevector-drop
+    ibytevector-take
+    u8-list->ibytevector)
+
+  (import (chezscheme))
+
+  (define (freeze-bv! bs)
+    (($primitive $bytevector-set-immutable!) bs)
+    bs)
+
+  (define (ibytevector-drop n bs)
+    (let* ([l (bytevector-length bs)]
+           [k (max 0 (- l n))]
+           [br (make-bytevector k)])
+      (bytevector-copy! bs n br 0 k)
+      (freeze-bv! br)))
+
+  (define (ibytevector-take n bs)
+    (let* ([sz (min n (bytevector-length bs))]
+           [br (make-bytevector sz)])
+      (bytevector-copy! bs 0 br 0 sz)
+      (freeze-bv! br)))
+
+  (define (u8-list->ibytevector l) (freeze-bv! (u8-list->bytevector l))))
diff --git a/chez-libs/unison/cont.ss b/chez-libs/unison/cont.ss
new file mode 100644
index 000000000..7656c21f4
--- /dev/null
+++ b/chez-libs/unison/cont.ss
@@ -0,0 +1,47 @@
+; This library is intended to contain the implementation of
+; delimited continuations used in the semantics of abilities.
+;
+; Currently, it is a somewhat naive implementation based on call/cc.
+; This has known issues that seem to still be in force even though a
+; tweak has been applied that should fix certain space leaks. So, in
+; the future it will likely need to be rewritten using some
+; implementation specific machinery (possibly making use of
+; continuation attachments as in the Racket implementation).
+;
+; Also, although the API includes prompts, they are currently ignored
+; in `control` and `prompt` always uses the same prompt (0). This
+; means that nesting handlers will not work in general, since requests
+; will not be able to jump over an inner handler of unrelated
+; abilities. It should be sufficient for testing simple examples in
+; the mean time, though.
+(library (unison cont)
+  (export prompt control)
+
+  (import (chezscheme))
+
+  (define mk (lambda (x) (raise "fell off end")))
+
+  (define (prompt-impl h)
+    ((call/cc
+       (lambda (k)
+         (let ([ok mk])
+           (set! mk (lambda (x) (set! mk ok) (k x)))
+           ; (h 0) <-- prompt = 0
+           (mk (let ([v (h 0)]) (lambda () v))))))))
+
+  (define-syntax prompt
+    (syntax-rules ()
+      [(prompt p e ...)
+       (prompt-impl (lambda (p) e ...))]))
+
+  (define (control-impl h)
+    (call/cc
+      (lambda (k)
+        (let* ([g (lambda () (prompt p (h k)))])
+          (mk g)))))
+
+  (define-syntax control
+    (syntax-rules ()
+      [(control p k e ...)
+       (control-impl (lambda (k) e ...))])))
+
diff --git a/chez-libs/unison/core.ss b/chez-libs/unison/core.ss
new file mode 100644
index 000000000..474b37cc6
--- /dev/null
+++ b/chez-libs/unison/core.ss
@@ -0,0 +1,43 @@
+(library (unison core)
+  (export
+    identity
+
+    describe-value
+    decode-value)
+
+  (import (chezscheme))
+
+  (define (identity x) x)
+  
+  ; Recovers the original function name from the partial
+  ; application name.
+  (define (extract-name i)
+    (string->symbol ((i 'code) 'name)))
+
+  (define (describe-value x)
+    (let explain ([i (inspect/object x)])
+      (case (i 'type)
+        [(simple) (i 'value)]
+        [(variable) (explain (i 'ref))]
+        [(procedure)
+         (let explain-args ([j (- (i 'length) 1)] [args '()])
+           (if (< j 0)
+             (cons (extract-name i) args)
+             (explain-args
+               (- j 1)
+               (cons (explain (i 'ref j)) args))))])))
+
+  ; partial, data, cont, lit
+  (define (decode-value x)
+    (let reify ([i (inspect/object x)])
+      (case (i 'type)
+        [(simple) (list 3 (i 'value))]
+        [(variable) (reify (i 'ref))]
+        [(procedure)
+         (let reify-args ([j (- (i 'length) 1)] [args '()])
+           (if (< j 0)
+             (cons* 0 (extract-name i) args)
+             (reify-args
+               (- j 1)
+               (cons (reify (i 'ref j)) args))))])))
+  )
diff --git a/chez-libs/unison/primops.ss b/chez-libs/unison/primops.ss
new file mode 100644
index 000000000..9b7965ff3
--- /dev/null
+++ b/chez-libs/unison/primops.ss
@@ -0,0 +1,205 @@
+; This library implements pimitive operations that are used in
+; builtins. There are two different sorts of primitive operations, but
+; the difference is essentially irrelevant except for naming schemes.
+;
+; POps are part of a large enumeration of 'instructions' directly
+; implemented in the Haskell runtime. These are referred to using the
+; naming scheme `unison-POp-INST` where `INST` is the name of the
+; instruction, which is (at the time of this writing) 4 letters.
+;
+; FOps are 'foreign' functons, which are allowed to be declared more
+; flexibly in the Haskell runtime. Each such declaration associates a
+; builtin to a Haskell function. For these, the naming shceme is
+; `unison-FOp-NAME` where `NAME` is the name of the unison builtin
+; associated to the declaration.
+;
+; Both POps and FOps are always called with exactly the right number
+; of arguments, so they may be implemented as ordinary scheme
+; definitions with a fixed number of arguments. By implementing the
+; POp/FOp, you are expecting the associated unison function(s) to be
+; implemented by code generation from the wrappers in
+; Unison.Runtime.Builtin, so the POp/FOp implementation must
+; take/return arguments that match what is expected in those wrappers.
+
+(library (unison primops)
+  (export
+    ; unison-FOp-Bytes.decodeNat16be
+    ; unison-FOp-Bytes.decodeNat32be
+    ; unison-FOp-Bytes.decodeNat64be
+    unison-FOp-Char.toText
+    ; unison-FOp-Code.dependencies
+    ; unison-FOp-Code.serialize
+    unison-FOp-IO.closeFile.impl.v3
+    unison-FOp-IO.openFile.impl.v3
+    unison-FOp-IO.putBytes.impl.v3
+    ; unison-FOp-Text.fromUtf8.impl.v3
+    unison-FOp-Text.repeat
+    unison-FOp-Text.toUtf8
+    ; unison-FOp-Value.serialize
+    unison-FOp-IO.stdHandle
+
+    unison-FOp-ImmutableByteArray.copyTo!
+    unison-FOp-ImmutableByteArray.read8
+
+    unison-FOp-MutableByteArray.freeze!
+    unison-FOp-MutableByteArray.write8
+
+    unison-FOp-Scope.bytearray
+
+    unison-POp-ADDN
+    unison-POp-ANDN
+    unison-POp-BLDS
+    unison-POp-CATS
+    unison-POp-CATT
+    unison-POp-CMPU
+    unison-POp-COMN
+    unison-POp-CONS
+    unison-POp-DECI
+    unison-POp-DIVN
+    unison-POp-DRPB
+    unison-POp-DRPS
+    unison-POp-EQLN
+    unison-POp-EQLT
+    unison-POp-EQLU
+    unison-POp-EROR
+    unison-POp-FTOT
+    unison-POp-IDXB
+    unison-POp-IDXS
+    unison-POp-IORN
+    unison-POp-ITOT
+    unison-POp-LEQN
+    ; unison-POp-LKUP
+    unison-POp-MULN
+    unison-POp-NTOT
+    unison-POp-PAKT
+    unison-POp-SHLI
+    unison-POp-SHLN
+    unison-POp-SHRI
+    unison-POp-SHRN
+    unison-POp-SIZS
+    unison-POp-SIZT
+    unison-POp-SNOC
+    unison-POp-SUBN
+    unison-POp-TAKS
+    unison-POp-TAKT
+    unison-POp-TRCE
+    unison-POp-UPKT
+    unison-POp-VALU
+    unison-POp-VWLS
+
+    )
+
+  (import (chezscheme)
+          (unison core)
+          (unison string)
+          (unison bytevector))
+
+  ; Core implemented primops, upon which primops-in-unison can be built.
+  (define (unison-POp-ADDN m n) (fx+ m n))
+  (define (unison-POp-ANDN m n) (fxlogand m n))
+  (define unison-POp-BLDS list)
+  (define (unison-POp-CATS l r) (append l r))
+  (define (unison-POp-CATT l r) (istring-append l r))
+  (define (unison-POp-CMPU l r) (equal? l r))
+  (define (unison-POp-COMN n) (fxlognot n))
+  (define (unison-POp-CONS x xs) (cons x xs))
+  (define (unison-POp-DECI n) (+ n 1))
+  (define (unison-POp-DIVN m n) (fxdiv m n))
+  (define (unison-POp-DRPB n bs) (ibytevector-drop n bs))
+  (define (unison-POp-DRPS n l)
+    (let ([m (max 0 (min n (length l)))]) (list-tail l m)))
+  (define (unison-POp-DRPT n t) (istring-drop n t))
+  (define (unison-POp-EQLN m n) (if (fx= m n) 1 0))
+  (define (unison-POp-EQLT s t) (if (string=? s t) 1 0))
+  (define (unison-POp-EQLU x y) (equal? x y))
+  (define (unison-POp-EROR fnm x) (raise fnm))
+  (define (unison-POp-FTOT f) (number->istring f))
+  (define (unison-POp-IDXB n bs) (bytevector-u8-ref bs n))
+  (define (unison-POp-IDXS n l) (list-ref l n))
+  (define (unison-POp-IORN m n) (fxlogior m n))
+  (define (unison-POp-ITOT i) (signed-number->istring i))
+  (define (unison-POp-LEQN m n) (if (fx< m n) 1 0))
+  (define (unison-POp-MULN m n) (* m n))
+  (define (unison-POp-NTOT m) (number->istring m))
+  (define (unison-POp-PAKB l) (u8-list->ibytevector l))
+  (define (unison-POp-PAKT l) (list->istring l))
+  (define (unison-POp-SHLI i k) (fxarithmetic-shift-left i k))
+  (define (unison-POp-SHLN n k) (fxarithmetic-shift-left n k))
+  (define (unison-POp-SHRI i k) (fxarithmetic-shift-right i k))
+  (define (unison-POp-SHRN n k) (fxarithmetic-shift-right n k))
+  (define (unison-POp-SIZS l) (length l))
+  (define (unison-POp-SIZT t) (string-length t))
+  (define (unison-POp-SNOC xs x) (append xs (list x)))
+  (define (unison-POp-SUBN m n) (fx- m n))
+  (define (unison-POp-TAKS n s) (list-head s n))
+  (define (unison-POp-TAKT n t) (istring-take n t))
+  (define (unison-POp-TRCE x) (display (describe-value x)))
+  (define (unison-POp-UPKT t) (string->list t))
+  (define (unison-POp-VWLS l)
+    (if (null? l)
+      (list 0)
+      (list 1 (car l) (cdr l))))
+  (define (unison-POp-VALU c) (decode-value c))
+
+  (define (unison-FOp-IO.putBytes.impl.v3 p bs)
+    (begin
+      (put-bytevector p bs)
+      (flush-output-port p)
+      (list 1 #f)))
+
+  (define (unison-FOp-Char.toText c) (istring c))
+
+  (define stdin (standard-input-port))
+  (define stdout (standard-output-port))
+  (define stderr (standard-error-port))
+
+  (define (unison-FOp-IO.stdHandle n)
+    (case n
+      [(0) stdin]
+      [(1) stdout]
+      [(2) stderr]))
+
+  (define (unison-FOp-Text.toUtf8 s)
+    (string->bytevector s utf-8-transcoder))
+
+  (define (unison-FOp-IO.closeFile.impl.v3 h)
+    (close-input-port h))
+
+  (define (unison-FOp-IO.openFile.impl.v3 fn mode)
+    (case mode
+      [(0) (open-file-input-port fn)]
+      [(1) (open-file-output-port fn)]
+      [(2) (open-file-output-port fn 'no-truncate)]
+      [else (open-file-input/output-port fn)]))
+
+  (define (unison-FOp-Text.repeat n t) (istring-repeat n t))
+
+  (define (catch-array thunk)
+    (with-exception-handler
+      (lambda (e) (list 0 '() "array index out of boudns" e))
+      thunk))
+
+  (define (unison-FOp-ImmutableByteArray.copyTo! dst doff src soff n)
+    (catch-array
+      (lambda ()
+        (bytevector-copy! src soff dst doff n)
+        (list 1))))
+
+  (define (unison-FOp-ImmutableByteArray.read8 arr i)
+    (catch-array
+      (lambda ()
+        (list 1 (bytevector-u8-ref arr i)))))
+
+  (define (unison-FOp-MutableByteArray.freeze! arr)
+    (freeze-bv! arr))
+
+  (define (unison-FOp-MutableByteArray.write8 arr i b)
+    (catch-array
+      (lambda ()
+        (bytevector-u8-set! arr i b)
+        (list 1))))
+
+  (define (unison-FOp-Scope.bytearray n) (make-bytevector n))
+
+  )
+
diff --git a/chez-libs/unison/string.ss b/chez-libs/unison/string.ss
new file mode 100644
index 000000000..7df0502ad
--- /dev/null
+++ b/chez-libs/unison/string.ss
@@ -0,0 +1,60 @@
+; This library wraps some chez functionality to provide immutable
+; strings. There is a wrapper for making immutable strings in chez,
+; but it copies its input, so relying on that would involve every
+; string operation building a fresh mutable string, then making an
+; immutable copy. This library instead directly freezes the newly
+; created mutable strings.
+(library (unison string)
+  (export
+    istring
+    istring-append
+    istring-drop
+    istring-take
+    istring-repeat
+    list->istring
+    make-istring
+    number->istring
+    signed-number->istring
+    utf8-bytevector->istring
+    utf-8-transcoder)
+
+  (import (chezscheme))
+
+  (define (freeze-s! s)
+    (($primitive $string-set-immutable!) s)
+    s)
+
+  (define istring (lambda l (freeze-s! (apply string l))))
+
+  (define (make-istring n c) (freeze-s! (make-string n c)))
+
+  (define (istring-repeat n s)
+    (let* ([k (string-length s)]
+           [t (make-string (* k n))])
+      (let loop ([i 0])
+        (if (< i n)
+          (begin
+            (string-copy! s 0 t (* i k) k)
+            (loop (+ i 1)))
+          (freeze-s! t)))))
+
+  (define istring-append (lambda l (freeze-s! (apply string-append l))))
+
+  (define (istring-drop n s) (freeze-s! (substring s n (- (string-length s) n))))
+
+  (define (number->istring n) (freeze-s! (number->string n)))
+
+  (define (signed-number->istring n)
+    (freeze-s!
+      (if (>= n 0)
+        (string-append "+" (number->string n))
+        (number->string n))))
+
+  (define (list->istring l) (freeze-s! (list->string l)))
+
+  (define (istring-take n s) (freeze-s! (substring s 0 n)))
+
+  (define utf-8-transcoder (make-transcoder (utf-8-codec)))
+
+  (define (utf8-bytevector->istring bs)
+    (freeze-s! (bytevector->string bs utf-8-transcoder))))

From 03926bd34efb83041a2c414f97e813bb28e2656b Mon Sep 17 00:00:00 2001
From: Dan Doel <dan.doel@gmail.com>
Date: Thu, 27 Oct 2022 13:10:13 -0400
Subject: [PATCH 02/41] Add a new input handling module for resolving terms

---
 .../Editor/HandleInput/TermResolution.hs      | 111 ++++++++++++++++++
 unison-cli/unison-cli.cabal                   |   1 +
 2 files changed, 112 insertions(+)
 create mode 100644 unison-cli/src/Unison/Codebase/Editor/HandleInput/TermResolution.hs

diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/TermResolution.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/TermResolution.hs
new file mode 100644
index 000000000..11a4111ff
--- /dev/null
+++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/TermResolution.hs
@@ -0,0 +1,111 @@
+
+module Unison.Codebase.Editor.HandleInput.TermResolution
+  ( lookupTermRefs
+  , lookupTermRefWithType
+  , resolveCon
+  , resolveTermRef
+  , resolveMainRef
+  ) where
+
+import Control.Lens ((<&>))
+import Control.Monad.Trans (liftIO)
+import Control.Monad.Reader (ask)
+import Data.Maybe (catMaybes, fromJust)
+import Data.Set (toList, fromList)
+
+import qualified Unison.HashQualified as HQ
+import Unison.ConstructorReference
+import Unison.Name (Name)
+import Unison.Names (Names)
+import Unison.NamesWithHistory
+  (NamesWithHistory(..), lookupHQTerm)
+import Unison.Reference (Reference)
+import Unison.Referent (Referent, pattern Ref, pattern Con)
+import Unison.Codebase.Path (hqSplitFromName')
+import Unison.Cli.Monad (Cli)
+import Unison.Cli.NamesUtils (basicParseNames,basicPrettyPrintNamesA)
+import Unison.Parser.Ann (Ann)
+import Unison.PrettyPrintEnv (PrettyPrintEnv)
+import Unison.PrettyPrintEnv.Names (fromSuffixNames)
+import qualified Unison.Codebase as Codebase
+import Unison.Codebase.Editor.Output (Output(..))
+import qualified Unison.Codebase.Runtime as Runtime
+import qualified Unison.Typechecker as Typechecker
+import qualified Unison.Cli.Monad as Cli
+import Unison.Symbol (Symbol)
+import Unison.Type (Type)
+
+addHistory names = NamesWithHistory names mempty
+
+lookupTerm :: HQ.HashQualified Name -> Names -> [Referent]
+lookupTerm hq parseNames = toList (lookupHQTerm hq hnames)
+  where
+    hnames = addHistory parseNames
+
+lookupCon
+  :: HQ.HashQualified Name
+  -> Names
+  -> ([ConstructorReference], [Referent])
+lookupCon hq parseNames =
+  unzip . catMaybes . fmap extract $ lookupTerm hq parseNames
+  where
+    extract rt@(Con rf _) = Just (rf, rt)
+    extract _ = Nothing
+
+lookupTermRefs
+  :: HQ.HashQualified Name -> Names -> ([Reference], [Referent])
+lookupTermRefs hq parseNames =
+  unzip . catMaybes . fmap extract $ lookupTerm hq parseNames
+  where
+    extract rt@(Ref rf) = Just (rf, rt)
+    extract _ = Nothing
+
+lookupTermRefWithType
+  :: Codebase.Codebase IO Symbol Ann
+  -> HQ.HashQualified Name
+  -> Cli [(Reference,Type Symbol Ann)]
+lookupTermRefWithType codebase name = do
+  nms <- basicParseNames
+  fmap catMaybes . traverse annot . fst $ lookupTermRefs name nms
+  where
+    annot tm =
+      fmap ((,) tm) <$> liftIO (Codebase.getTypeOfTerm codebase tm)
+
+resolveTerm :: HQ.HashQualified Name -> Cli Referent
+resolveTerm name = basicParseNames >>= \nms ->
+  case lookupTerm name nms of
+    [] -> Cli.returnEarly (TermNotFound $ fromJust parsed)
+      where parsed = hqSplitFromName' =<< HQ.toName name
+    [rf] -> pure rf
+    rfs -> Cli.returnEarly (TermAmbiguous name (fromList rfs))
+
+resolveCon :: HQ.HashQualified Name -> Cli ConstructorReference
+resolveCon name = basicParseNames >>= \nms ->
+  case lookupCon name nms of
+    ([], _) -> Cli.returnEarly (TermNotFound $ fromJust parsed)
+      where parsed = hqSplitFromName' =<< HQ.toName name
+    ([co], _) -> pure co
+    (_, rfts) -> Cli.returnEarly (TermAmbiguous name (fromList rfts))
+
+resolveTermRef :: HQ.HashQualified Name -> Cli Reference
+resolveTermRef name = basicParseNames >>= \nms ->
+  case lookupTermRefs name nms of
+    ([], _) -> Cli.returnEarly (TermNotFound $ fromJust parsed)
+      where parsed = hqSplitFromName' =<< HQ.toName name
+    ([rf], _) -> pure rf
+    (_, rfts) -> Cli.returnEarly (TermAmbiguous name (fromList rfts))
+
+resolveMainRef :: HQ.HashQualified Name -> Cli (Reference, PrettyPrintEnv)
+resolveMainRef main = do
+  Cli.Env {codebase, runtime} <- ask
+  let mainType = Runtime.mainType runtime
+      smain = HQ.toString main
+  parseNames <- basicPrettyPrintNamesA
+  k <- liftIO (Codebase.hashLength codebase)
+  let ppe = fromSuffixNames k (addHistory parseNames)
+  lookupTermRefWithType codebase main >>= \case
+    [(rf, ty)]
+      | Typechecker.fitsScheme ty mainType -> pure (rf, ppe)
+      | otherwise -> Cli.returnEarly (BadMainFunction smain ty ppe [mainType])
+    _ -> Cli.returnEarly (NoMainFunction smain ppe [mainType])
+
diff --git a/unison-cli/unison-cli.cabal b/unison-cli/unison-cli.cabal
index 278ff98e6..22a16743a 100644
--- a/unison-cli/unison-cli.cabal
+++ b/unison-cli/unison-cli.cabal
@@ -43,6 +43,7 @@ library
       Unison.Codebase.Editor.HandleInput.MoveBranch
       Unison.Codebase.Editor.HandleInput.NamespaceDependencies
       Unison.Codebase.Editor.HandleInput.NamespaceDiffUtils
+      Unison.Codebase.Editor.HandleInput.TermResolution
       Unison.Codebase.Editor.HandleInput.Update
       Unison.Codebase.Editor.Input
       Unison.Codebase.Editor.Output

From 1c414174013b19a75dd7ce51fc3633887ce2dd56 Mon Sep 17 00:00:00 2001
From: Dan Doel <dan.doel@gmail.com>
Date: Thu, 27 Oct 2022 13:11:06 -0400
Subject: [PATCH 03/41] Add input handling for typechecking individual terms

---
 unison-cli/src/Unison/Cli/TypeCheck.hs | 46 +++++++++++++++++++++-----
 1 file changed, 38 insertions(+), 8 deletions(-)

diff --git a/unison-cli/src/Unison/Cli/TypeCheck.hs b/unison-cli/src/Unison/Cli/TypeCheck.hs
index 67eb203f4..c5ecc624f 100644
--- a/unison-cli/src/Unison/Cli/TypeCheck.hs
+++ b/unison-cli/src/Unison/Cli/TypeCheck.hs
@@ -2,11 +2,13 @@ module Unison.Cli.TypeCheck
   ( typecheck,
     typecheckHelper,
     typecheckFile,
+    typecheckTerm
   )
 where
 
 import Control.Monad.Reader (ask)
 import qualified Data.Text as Text
+import qualified Data.Map as Map
 import qualified Unison.Builtin as Builtin
 import Unison.Cli.Monad (Cli)
 import qualified Unison.Cli.Monad as Cli
@@ -18,10 +20,12 @@ import Unison.NamesWithHistory (NamesWithHistory (..))
 import Unison.Parser.Ann (Ann (..))
 import Unison.Prelude
 import qualified Unison.Result as Result
-import Unison.Symbol (Symbol)
+import Unison.Symbol (Symbol(Symbol))
 import qualified Unison.Syntax.Lexer as L
 import qualified Unison.Syntax.Parser as Parser
 import Unison.Type (Type)
+import Unison.Term (Term)
+import qualified Unison.Var as Var
 import qualified Unison.UnisonFile as UF
 
 typecheck ::
@@ -69,6 +73,38 @@ typecheckHelper codebase generateUniqueName ambient names sourceName source = do
       (Text.unpack sourceName)
       (fst source)
 
+typecheckTerm ::
+  Term Symbol Ann ->
+  Cli
+    ( Result.Result
+        (Seq (Result.Note Symbol Ann))
+        (Type Symbol Ann))
+typecheckTerm tm = do
+  Cli.Env { generateUniqueName } <- ask
+  un <- liftIO generateUniqueName
+  let v = Symbol 0 (Var.Inference Var.Other)
+  fmap extract <$>
+    typecheckFile' [] (UF.UnisonFileId mempty mempty [(v, tm)] mempty)
+  where
+    extract tuf
+      | [[(_,_,ty)]] <- UF.topLevelComponents' tuf = ty
+      | otherwise = error "internal error: typecheckTerm"
+
+typecheckFile' ::
+  [Type Symbol Ann] ->
+  UF.UnisonFile Symbol Ann ->
+  Cli
+    ( Result.Result
+        (Seq (Result.Note Symbol Ann))
+        (UF.TypecheckedUnisonFile Symbol Ann))
+typecheckFile' ambient file = do
+  Cli.Env {codebase} <- ask
+  typeLookup <-
+    liftIO $
+      (<> Builtin.typeLookup)
+        <$> Codebase.typeLookupForDependencies codebase (UF.dependencies file)
+  pure $ synthesizeFile' ambient typeLookup file
+
 typecheckFile ::
   [Type Symbol Ann] ->
   UF.UnisonFile Symbol Ann ->
@@ -77,10 +113,4 @@ typecheckFile ::
         (Seq (Result.Note Symbol Ann))
         (Either Names (UF.TypecheckedUnisonFile Symbol Ann))
     )
-typecheckFile ambient file = do
-  Cli.Env {codebase} <- ask
-  typeLookup <-
-    liftIO $
-      (<> Builtin.typeLookup)
-        <$> Codebase.typeLookupForDependencies codebase (UF.dependencies file)
-  pure . fmap Right $ synthesizeFile' ambient typeLookup file
+typecheckFile ambient file = fmap Right <$> typecheckFile' ambient file

From 48489a3ba61091b64e5749256b900f5860830f9b Mon Sep 17 00:00:00 2001
From: Dan Doel <dan.doel@gmail.com>
Date: Thu, 27 Oct 2022 13:15:44 -0400
Subject: [PATCH 04/41] Add a command for compiling to scheme

- I can't easily put the implementation in a separate module because
  it would require more significant refactoring of HandleInput.hs
---
 .../src/Unison/Codebase/Editor/HandleInput.hs | 209 +++++++++++++-----
 .../src/Unison/Codebase/Editor/Input.hs       |   2 +
 .../src/Unison/CommandLine/InputPatterns.hs   |  22 ++
 3 files changed, 175 insertions(+), 58 deletions(-)

diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs
index e4fb6f5f7..ebaa92539 100644
--- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs
+++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs
@@ -19,7 +19,7 @@ import qualified Data.List as List
 import Data.List.Extra (nubOrd)
 import qualified Data.List.NonEmpty as Nel
 import qualified Data.Map as Map
-import Unison.Cli.TypeCheck (typecheck)
+import Unison.Cli.TypeCheck (typecheck, typecheckTerm)
 import qualified Data.Sequence as Seq
 import qualified Data.Set as Set
 import Data.Set.NonEmpty (NESet)
@@ -63,6 +63,8 @@ import Unison.Codebase.Editor.HandleInput.MetadataUtils (addDefaultMetadata, man
 import Unison.Codebase.Editor.HandleInput.MoveBranch (doMoveBranch)
 import qualified Unison.Codebase.Editor.HandleInput.NamespaceDependencies as NamespaceDependencies
 import Unison.Codebase.Editor.HandleInput.NamespaceDiffUtils (diffHelper)
+import Unison.Codebase.Editor.HandleInput.TermResolution
+  (resolveTermRef, resolveMainRef, resolveCon)
 import Unison.Codebase.Editor.HandleInput.Update (doSlurpAdds, handleUpdate)
 import Unison.Codebase.Editor.Input
 import qualified Unison.Codebase.Editor.Input as Input
@@ -102,6 +104,7 @@ import qualified Unison.Codebase.Runtime as Runtime
 import qualified Unison.Codebase.ShortBranchHash as SBH
 import qualified Unison.Codebase.SqliteCodebase.Conversions as Cv
 import qualified Unison.Codebase.SyncMode as SyncMode
+import qualified Unison.Syntax.TermPrinter as TP
 import Unison.Codebase.TermEdit (TermEdit (..))
 import qualified Unison.Codebase.TermEdit.Typing as TermEdit
 import Unison.Codebase.Type (GitPushBehavior (..))
@@ -1173,23 +1176,11 @@ loop e = do
               Cli.respond (RunResult ppe mainRes)
             MakeStandaloneI output main -> do
               Cli.Env {codebase, runtime} <- ask
-              let mainType = Runtime.mainType runtime
-              parseNames <-
-                flip NamesWithHistory.NamesWithHistory mempty <$> basicPrettyPrintNamesA
-              ppe <- suffixifiedPPE parseNames
-              let resolved = toList $ NamesWithHistory.lookupHQTerm main parseNames
-                  smain = HQ.toString main
-              filtered <-
-                catMaybes
-                  <$> traverse (\r -> fmap (r,) <$> liftIO (loadTypeOfTerm codebase r)) resolved
-              case filtered of
-                [(Referent.Ref ref, ty)]
-                  | Typechecker.fitsScheme ty mainType -> do
-                      let codeLookup = () <$ Codebase.toCodeLookup codebase
-                      whenJustM (liftIO (Runtime.compileTo runtime codeLookup ppe ref (output <> ".uc"))) \err ->
-                        Cli.returnEarly (EvaluationFailure err)
-                  | otherwise -> Cli.returnEarly (BadMainFunction smain ty ppe [mainType])
-                _ -> Cli.returnEarly (NoMainFunction smain ppe [mainType])
+              (ref, ppe) <- resolveMainRef main
+              let codeLookup = () <$ Codebase.toCodeLookup codebase
+              whenJustM (liftIO (Runtime.compileTo runtime codeLookup ppe ref (output <> ".uc"))) \err ->
+                Cli.returnEarly (EvaluationFailure err)
+            CompileSchemeI output main -> doCompileScheme output main
             IOTestI main -> do
               Cli.Env {codebase, runtime} <- ask
               -- todo - allow this to run tests from scratch file, using addRunMain
@@ -1275,46 +1266,9 @@ loop e = do
               patch <- Cli.getPatchAt (fromMaybe Cli.defaultPatchPath maybePath)
               ppe <- suffixifiedPPE =<< makePrintNamesFromLabeled' (Patch.labeledDependencies patch)
               Cli.respondNumbered $ ListEdits patch ppe
-            PullRemoteBranchI mayRepo path syncMode pullMode verbosity -> do
-              Cli.Env {codebase} <- ask
-              let preprocess = case pullMode of
-                    Input.PullWithHistory -> Unmodified
-                    Input.PullWithoutHistory -> Preprocessed $ pure . Branch.discardHistory
-              ns <- maybe (writePathToRead <$> resolveConfiguredUrl Pull path) pure mayRepo
-              remoteBranch <- case ns of
-                ReadRemoteNamespaceGit repo ->
-                  Cli.ioE (Codebase.importRemoteBranch codebase repo syncMode preprocess) \err ->
-                    Cli.returnEarly (Output.GitError err)
-                ReadRemoteNamespaceShare repo -> importRemoteShareBranch repo
-              description <- inputDescription input
-              let unchangedMsg = PullAlreadyUpToDate ns path
-              destAbs <- Cli.resolvePath' path
-              let printDiffPath = if Verbosity.isSilent verbosity then Nothing else Just path
-              case pullMode of
-                Input.PullWithHistory -> do
-                  destBranch <- Cli.getBranch0At destAbs
-                  if Branch.isEmpty0 destBranch
-                    then do
-                      void $ Cli.updateAtM description destAbs (const $ pure remoteBranch)
-                      Cli.respond $ MergeOverEmpty path
-                    else
-                      mergeBranchAndPropagateDefaultPatch
-                        Branch.RegularMerge
-                        description
-                        (Just unchangedMsg)
-                        remoteBranch
-                        printDiffPath
-                        destAbs
-                Input.PullWithoutHistory -> do
-                  didUpdate <-
-                    Cli.updateAtM
-                      description
-                      destAbs
-                      (\destBranch -> pure $ remoteBranch `Branch.consBranchSnapshot` destBranch)
-                  Cli.respond
-                    if didUpdate
-                      then PullSuccessful ns path
-                      else unchangedMsg
+            PullRemoteBranchI mRepo path sMode pMode verbosity ->
+              inputDescription input >>=
+                doPullRemoteBranch mRepo path sMode pMode verbosity
             PushRemoteBranchI pushRemoteBranchInput -> handlePushRemoteBranch pushRemoteBranchInput
             ListDependentsI hq -> handleDependents hq
             ListDependenciesI hq -> do
@@ -1451,6 +1405,26 @@ loop e = do
 magicMainWatcherString :: String
 magicMainWatcherString = "main"
 
+-- resolveMain
+--   :: HQ.HashQualified Name -> Cli (Reference, PPE.PrettyPrintEnv)
+-- resolveMain main = do
+--   Cli.Env {codebase, runtime} <- ask
+--   let mainType = Runtime.mainType runtime
+--   parseNames <-
+--     flip NamesWithHistory.NamesWithHistory mempty
+--       <$> basicPrettyPrintNamesA
+--   ppe <- suffixifiedPPE parseNames
+--   let resolved = toList $ NamesWithHistory.lookupHQTerm main parseNames
+--       smain = HQ.toString main
+--   filtered <-
+--     catMaybes
+--       <$> traverse (\r -> fmap (r,) <$> liftIO (loadTypeOfTerm codebase r)) resolved
+--   case filtered of
+--     [(Referent.Ref ref, ty)]
+--       | Typechecker.fitsScheme ty mainType -> pure (ref, ppe)
+--       | otherwise -> Cli.returnEarly (BadMainFunction smain ty ppe [mainType])
+--     _ -> Cli.returnEarly (NoMainFunction smain ppe [mainType])
+
 inputDescription :: Input -> Cli Text
 inputDescription input =
   case input of
@@ -2505,6 +2479,125 @@ mergeBranchAndPropagateDefaultPatch mode inputDescription unchangedMessage srcb
           Cli.respondNumbered (ShowDiffAfterMerge dest0 dest ppe diff)
         pure b
 
+compilerPath :: Path.Path'
+compilerPath = Path.Path' { Path.unPath' = Left abs }
+  where
+  segs = NameSegment <$> ["unison", "internal"]
+  rootPath = Path.Path { Path.toSeq = Seq.fromList segs }
+  abs = Path.Absolute { Path.unabsolute = rootPath }
+
+doFetchCompiler :: Cli ()
+doFetchCompiler =
+  inputDescription pullInput >>=
+    doPullRemoteBranch
+      repo compilerPath
+      SyncMode.Complete
+      Input.PullWithoutHistory
+      Verbosity.Silent
+  where
+  -- fetching info
+  ns = ReadShareRemoteNamespace
+     { server = RemoteRepo.DefaultCodeserver
+     , repo = "dolio"
+     , path =
+         Path.fromList $ NameSegment <$> ["public", "internal", "trunk"]
+     }
+  repo = Just $ ReadRemoteNamespaceShare ns
+
+  pullInput =
+    PullRemoteBranchI
+      repo
+      compilerPath
+      SyncMode.Complete
+      Input.PullWithoutHistory
+      Verbosity.Silent
+
+doCompileScheme :: String -> HQ.HashQualified Name -> Cli ()
+doCompileScheme (Text.pack -> output) main = do
+  Cli.Env {codebase, runtime} <- ask
+  haveCompiler <- Cli.branchExistsAtPath' compilerPath
+  when (not haveCompiler) doFetchCompiler
+  (comp, ppe) <- resolveMainRef main
+  -- Term.termLink rf
+  sscm <- Term.ref a <$> resolveTermRef saveNm
+  fprf <- resolveCon filePathNm
+  let toCmp = Term.termLink a (Referent.Ref comp)
+      outTm = Term.text a (output <> ".scm")
+      fpc = Term.constructor a fprf
+      fp = Term.app a fpc outTm
+      mty = Runtime.mainType runtime
+      tm :: Term Symbol Ann
+      tm = Term.apps' sscm [toCmp, fp]
+      rendered = P.toPlainUnbroken $ TP.pretty ppe tm
+  tcRes <- typecheckTerm (Term.delay a tm)
+  case tcRes of
+    -- Type checking succeeded
+    Result.Result _ (Just ty)
+      | Typechecker.fitsScheme ty mty ->
+        () <$ evalUnisonTerm False ppe False tm
+      | otherwise ->
+        Cli.returnEarly $ BadMainFunction rendered ty ppe [mty]
+    Result.Result notes Nothing -> do
+      currentPath <- Cli.getCurrentPath
+      let tes = [ err | Result.TypeError err <- toList notes ]
+      Cli.respond (TypeErrors currentPath (Text.pack rendered) ppe tes)
+  where
+  a = External
+  hq nm
+    | Just hqn <- HQ.fromString nm = hqn
+    | otherwise = error $ "internal error: cannot hash qualify: " ++ nm
+
+  saveNm = hq ".unison.internal.compiler.saveScheme"
+  filePathNm = hq "FilePath.FilePath"
+
+doPullRemoteBranch
+  :: Maybe ReadRemoteNamespace
+  -> Path'
+  -> SyncMode.SyncMode
+  -> PullMode
+  -> Verbosity.Verbosity
+  -> Text
+  -> Cli ()
+doPullRemoteBranch mayRepo path syncMode pullMode verbosity description = do
+  Cli.Env {codebase} <- ask
+  let preprocess = case pullMode of
+        Input.PullWithHistory -> Unmodified
+        Input.PullWithoutHistory -> Preprocessed $ pure . Branch.discardHistory
+  ns <- maybe (writePathToRead <$> resolveConfiguredUrl Pull path) pure mayRepo
+  remoteBranch <- case ns of
+    ReadRemoteNamespaceGit repo ->
+      Cli.ioE (Codebase.importRemoteBranch codebase repo syncMode preprocess) \err ->
+        Cli.returnEarly (Output.GitError err)
+    ReadRemoteNamespaceShare repo -> importRemoteShareBranch repo
+  let unchangedMsg = PullAlreadyUpToDate ns path
+  destAbs <- Cli.resolvePath' path
+  let printDiffPath = if Verbosity.isSilent verbosity then Nothing else Just path
+  case pullMode of
+    Input.PullWithHistory -> do
+      destBranch <- Cli.getBranch0At destAbs
+      if Branch.isEmpty0 destBranch
+        then do
+          void $ Cli.updateAtM description destAbs (const $ pure remoteBranch)
+          Cli.respond $ MergeOverEmpty path
+        else
+          mergeBranchAndPropagateDefaultPatch
+            Branch.RegularMerge
+            description
+            (Just unchangedMsg)
+            remoteBranch
+            printDiffPath
+            destAbs
+    Input.PullWithoutHistory -> do
+      didUpdate <-
+        Cli.updateAtM
+          description
+          destAbs
+          (\destBranch -> pure $ remoteBranch `Branch.consBranchSnapshot` destBranch)
+      Cli.respond
+        if didUpdate
+          then PullSuccessful ns path
+          else unchangedMsg
+
 loadPropagateDiffDefaultPatch ::
   Text ->
   Maybe Path.Path' ->
diff --git a/unison-cli/src/Unison/Codebase/Editor/Input.hs b/unison-cli/src/Unison/Codebase/Editor/Input.hs
index 36da48fb1..1a2673eaa 100644
--- a/unison-cli/src/Unison/Codebase/Editor/Input.hs
+++ b/unison-cli/src/Unison/Codebase/Editor/Input.hs
@@ -150,6 +150,8 @@ data Input
     IOTestI (HQ.HashQualified Name)
   | -- make a standalone binary file
     MakeStandaloneI String (HQ.HashQualified Name)
+  | -- compile to a scheme file
+    CompileSchemeI String (HQ.HashQualified Name)
   | TestI TestInput
   | -- metadata
     -- `link metadata definitions` (adds metadata to all of `definitions`)
diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs
index ed78c1f37..c4c12b7ce 100644
--- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs
+++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs
@@ -2138,6 +2138,27 @@ makeStandalone =
         _ -> Left $ showPatternHelp makeStandalone
     )
 
+compileScheme :: InputPattern
+compileScheme =
+  InputPattern
+    "compile.scheme"
+    ["compile.scheme"]
+    I.Visible
+    [(Required, exactDefinitionTermQueryArg), (Required, noCompletionsArg)]
+    ( P.wrapColumn2
+        [ ( "`compile.scheme main file`",
+            "Creates stand alone executable via compilation to"
+              <> "scheme. The created executable will have the effect"
+              <> "of running `!main`."
+          )
+        ]
+    )
+    ( \case
+        [main, file] ->
+          Input.CompileSchemeI file <$> parseHashQualifiedName main
+        _ -> Left $ showPatternHelp compileScheme
+    )
+
 createAuthor :: InputPattern
 createAuthor =
   InputPattern
@@ -2310,6 +2331,7 @@ validInputs =
       quit,
       updateBuiltins,
       makeStandalone,
+      compileScheme,
       mergeBuiltins,
       mergeIOBuiltins,
       dependents,

From de6481b00fec0e5661564a09b8a4b0bed38e4239 Mon Sep 17 00:00:00 2001
From: Mitchell Rosen <mitchellwrosen@gmail.com>
Date: Sun, 6 Nov 2022 11:06:35 +0530
Subject: [PATCH 05/41] ignore "lib" namespace during patch propagation

---
 .../src/Unison/Codebase/Editor/Propagate.hs   | 53 +++++++++------
 unison-core/src/Unison/Name.hs                | 16 ++++-
 .../update-ignores-lib-namespace.md           | 25 +++++++
 .../update-ignores-lib-namespace.output.md    | 66 +++++++++++++++++++
 4 files changed, 140 insertions(+), 20 deletions(-)
 create mode 100644 unison-src/transcripts/update-ignores-lib-namespace.md
 create mode 100644 unison-src/transcripts/update-ignores-lib-namespace.output.md

diff --git a/unison-cli/src/Unison/Codebase/Editor/Propagate.hs b/unison-cli/src/Unison/Codebase/Editor/Propagate.hs
index 6177b12e8..90fb233a4 100644
--- a/unison-cli/src/Unison/Codebase/Editor/Propagate.hs
+++ b/unison-cli/src/Unison/Codebase/Editor/Propagate.hs
@@ -36,13 +36,14 @@ import qualified Unison.DataDeclaration as Decl
 import Unison.FileParsers (synthesizeFile')
 import Unison.Hash (Hash)
 import qualified Unison.Hashing.V2.Convert as Hashing
+import Unison.Name (Name)
 import qualified Unison.Name as Name
 import Unison.NameSegment (NameSegment)
 import Unison.Names (Names)
 import qualified Unison.Names as Names
 import Unison.Parser.Ann (Ann (..))
 import Unison.Prelude
-import Unison.Reference (Reference (..))
+import Unison.Reference (Reference (..), TermReference, TypeReference)
 import qualified Unison.Reference as Reference
 import Unison.Referent (Referent)
 import qualified Unison.Referent as Referent
@@ -58,6 +59,7 @@ import Unison.UnisonFile (UnisonFile (..))
 import qualified Unison.UnisonFile as UF
 import Unison.Util.Monoid (foldMapM)
 import qualified Unison.Util.Relation as R
+import qualified Unison.Util.Set as Set
 import qualified Unison.Util.Star3 as Star3
 import Unison.Util.TransitiveClosure (transitiveClosure)
 import Unison.Var (Var)
@@ -240,14 +242,7 @@ propagate patch b = case validatePatch patch of
     -- TODO: this can be removed once patches have term replacement of type `Referent -> Referent`
     rootNames <- Branch.toNames <$> Cli.getRootBranch0
 
-    let entireBranch =
-          Set.union
-            (Branch.deepTypeReferences b)
-            ( Set.fromList
-                [r | Referent.Ref r <- Set.toList $ Branch.deepReferents b]
-            )
-
-        -- TODO: these are just used for tracing, could be deleted if we don't care
+    let -- TODO: these are just used for tracing, could be deleted if we don't care
         -- about printing meaningful names for definitions during propagation, or if
         -- we want to just remove the tracing.
         refName r =
@@ -270,7 +265,8 @@ propagate patch b = case validatePatch patch of
         computeDirty
           (Codebase.dependents codebase Queries.ExcludeOwnComponent)
           patch
-          (Names.contains names0)
+          -- Dirty reference predicate: does the reference have a name in this branch that isn't in the "lib" namespace?
+          (Names.contains (Names.filter nameNotInLibNamespace (Branch.toNames b)))
 
       let initialTypeReplacements = Map.mapMaybe TypeEdit.toReference initialTypeEdits
       -- TODO: once patches can directly contain constructor replacements, this
@@ -278,7 +274,17 @@ propagate patch b = case validatePatch patch of
       -- in the patch which have a `Referent.Con` as their LHS.
       initialCtorMappings <- genInitialCtorMapping codebase rootNames initialTypeReplacements
 
-      order <- sortDependentsGraph codebase initialDirty entireBranch
+      order <-
+        let restrictToTypes :: Set TypeReference
+            restrictToTypes =
+              R.dom (R.filterRan nameNotInLibNamespace (Branch.deepTypes b))
+            restrictToTerms :: Set TermReference
+            restrictToTerms =
+              Set.mapMaybe Referent.toTermReference (R.dom (R.filterRan nameNotInLibNamespace (Branch.deepTerms b)))
+         in sortDependentsGraph
+              codebase
+              initialDirty
+              (Set.union restrictToTypes restrictToTerms)
 
       let getOrdered :: Set Reference -> Map Int Reference
           getOrdered rs =
@@ -477,7 +483,6 @@ propagate patch b = case validatePatch patch of
           (zip (view _1 . getReference <$> Graph.topSort graph) [0 ..])
     -- vertex i precedes j whenever i has an edge to j and not vice versa.
     -- vertex i precedes j when j is a dependent of i.
-    names0 = Branch.toNames b
     validatePatch ::
       Patch -> Maybe (Map Reference TermEdit, Map Reference TypeEdit)
     validatePatch p =
@@ -599,12 +604,20 @@ applyDeprecations patch =
 -- | Things in the patch are not marked as propagated changes, but every other
 -- definition that is created by the `Edits` which is passed in is marked as
 -- a propagated change.
-applyPropagate :: Applicative m => Patch -> Edits Symbol -> Branch0 m -> Branch0 m
+applyPropagate :: forall m. Applicative m => Patch -> Edits Symbol -> Branch0 m -> Branch0 m
 applyPropagate patch Edits {..} = do
   let termTypes = Map.map (Hashing.typeToReference . snd) newTerms
   -- recursively update names and delete deprecated definitions
-  Branch.stepEverywhere (updateLevel termReplacements typeReplacements termTypes)
+  stepEverywhereButLib (updateLevel termReplacements typeReplacements termTypes)
   where
+    -- Like Branch.stepEverywhere, but don't step the child named "lib"
+    stepEverywhereButLib :: (Branch0 m -> Branch0 m) -> (Branch0 m -> Branch0 m)
+    stepEverywhereButLib f branch =
+      let children =
+            Map.mapWithKey
+              (\name child -> if name == "lib" then child else Branch.step (Branch.stepEverywhere f) child)
+              (branch ^. Branch.children)
+       in f (Branch.branch0 (branch ^. Branch.terms) (branch ^. Branch.types) children (branch ^. Branch.edits))
     isPropagated r = Set.notMember r allPatchTargets
     allPatchTargets = Patch.allReferenceTargets patch
     propagatedMd :: forall r. r -> (r, Metadata.Type, Metadata.Value)
@@ -681,11 +694,9 @@ applyPropagate patch Edits {..} = do
 
 -- | Compute the set of "dirty" references. They each:
 --
---   1. Depend directly on some reference that was edited in the given patch
---   2. Have a name in the current namespace (the given Names)
---   3. Are not themselves edited in the given patch.
---
--- Note: computeDirty a b c = R.dom <$> computeFrontier a b c
+-- 1. Depend directly on some reference that was edited in the given patch
+-- 2. Are not themselves edited in the given patch.
+-- 3. Pass the given predicate.
 computeDirty ::
   Monad m =>
   (Reference -> m (Set Reference)) -> -- eg Codebase.dependents codebase
@@ -702,3 +713,7 @@ computeDirty getDependents patch shouldUpdate =
 
     edited :: Set Reference
     edited = R.dom (Patch._termEdits patch) <> R.dom (Patch._typeEdits patch)
+
+nameNotInLibNamespace :: Name -> Bool
+nameNotInLibNamespace name =
+  not (Name.beginsWithSegment name "lib")
diff --git a/unison-core/src/Unison/Name.hs b/unison-core/src/Unison/Name.hs
index 788a4f7c3..0e908f085 100644
--- a/unison-core/src/Unison/Name.hs
+++ b/unison-core/src/Unison/Name.hs
@@ -21,6 +21,7 @@ module Unison.Name
     countSegments,
     isAbsolute,
     isPrefixOf,
+    beginsWithSegment,
     endsWithReverseSegments,
     endsWithSegments,
     stripReversedPrefix,
@@ -164,6 +165,19 @@ countSegments :: Name -> Int
 countSegments (Name _ ss) =
   length ss
 
+-- | @beginsWithSegment name segment@ returns whether @name@'s first name segment is @segment@.
+--
+-- >>> beginsWithSegment "abc.def" "abc"
+-- True
+--
+-- >>> beginsWithSegment "abc.def" "ab"
+-- False
+--
+-- /O(n)/, where /n/ is the number of name segments.
+beginsWithSegment :: Name -> NameSegment -> Bool
+beginsWithSegment name segment =
+  segment == List.NonEmpty.head (segments name)
+
 -- | @endsWithSegments x y@ returns whether @x@ ends with @y@.
 --
 -- >>> endsWithSegments "a.b.c" ["b", "c"]
@@ -559,7 +573,7 @@ commonPrefix :: Name -> Name -> [NameSegment]
 commonPrefix x@(Name p1 _) y@(Name p2 _)
   | p1 /= p2 = []
   | otherwise =
-    commonPrefix' (toList $ segments x) (toList $ segments y)
+      commonPrefix' (toList $ segments x) (toList $ segments y)
   where
     commonPrefix' (a : as) (b : bs)
       | a == b = a : commonPrefix' as bs
diff --git a/unison-src/transcripts/update-ignores-lib-namespace.md b/unison-src/transcripts/update-ignores-lib-namespace.md
new file mode 100644
index 000000000..04498e48a
--- /dev/null
+++ b/unison-src/transcripts/update-ignores-lib-namespace.md
@@ -0,0 +1,25 @@
+`update` / `patch` (anything that a patch) ignores the namespace named "lib" at the location it's applied. This follows
+the project organization convention that dependencies are put in "lib"; it's much easier to apply a patch to all of
+one's own code if the "lib" namespace is simply ignored.
+
+```ucm:hide
+.> builtins.merge
+```
+
+```unison
+foo = 100
+lib.foo = 100
+```
+
+```ucm
+.> add
+```
+
+```unison
+foo = 200
+```
+
+```ucm
+.> update
+.> names foo
+```
diff --git a/unison-src/transcripts/update-ignores-lib-namespace.output.md b/unison-src/transcripts/update-ignores-lib-namespace.output.md
new file mode 100644
index 000000000..cf5d1cce1
--- /dev/null
+++ b/unison-src/transcripts/update-ignores-lib-namespace.output.md
@@ -0,0 +1,66 @@
+`update` / `patch` (anything that a patch) ignores the namespace named "lib" at the location it's applied. This follows
+the project organization convention that dependencies are put in "lib"; it's much easier to apply a patch to all of
+one's own code if the "lib" namespace is simply ignored.
+
+```unison
+foo = 100
+lib.foo = 100
+```
+
+```ucm
+
+  I found and typechecked these definitions in scratch.u. If you
+  do an `add` or `update`, here's how your codebase would
+  change:
+  
+    ⍟ These new definitions are ok to `add`:
+    
+      foo     : Nat
+      lib.foo : Nat
+
+```
+```ucm
+.> add
+
+  ⍟ I've added these definitions:
+  
+    foo     : Nat
+    lib.foo : Nat
+
+```
+```unison
+foo = 200
+```
+
+```ucm
+
+  I found and typechecked these definitions in scratch.u. If you
+  do an `add` or `update`, here's how your codebase would
+  change:
+  
+    ⍟ These names already exist. You can `update` them to your
+      new definition:
+    
+      foo : Nat
+        (The old definition is also named lib.foo. I'll update
+        this name too.)
+
+```
+```ucm
+.> update
+
+  ⍟ I've updated these names to your new definition:
+  
+    foo : Nat
+      (The old definition was also named lib.foo. I updated this
+      name too.)
+
+.> names foo
+
+  Term
+  Hash:   #9ntnotdp87
+  Names:  foo
+  
+  Tip: Use `names.global` to see more results.
+
+```

From 261e695cb52a4d1f0b217e4628bb7c0eedfce3a5 Mon Sep 17 00:00:00 2001
From: Mitchell Rosen <mitchellwrosen@gmail.com>
Date: Mon, 7 Nov 2022 23:11:55 +0530
Subject: [PATCH 06/41] make getWatch in Transaction, not IO

---
 parser-typechecker/src/Unison/Codebase.hs                | 2 +-
 parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs | 6 +++---
 parser-typechecker/src/Unison/Codebase/Type.hs           | 2 +-
 unison-cli/src/Unison/Codebase/Editor/HandleInput.hs     | 6 +++---
 unison-share-api/src/Unison/Server/Backend.hs            | 2 +-
 5 files changed, 9 insertions(+), 9 deletions(-)

diff --git a/parser-typechecker/src/Unison/Codebase.hs b/parser-typechecker/src/Unison/Codebase.hs
index f434602a1..e1224941a 100644
--- a/parser-typechecker/src/Unison/Codebase.hs
+++ b/parser-typechecker/src/Unison/Codebase.hs
@@ -328,7 +328,7 @@ getTypeOfConstructor codebase (ConstructorReference r0 cid) =
 --     MaybeT (getWatch codebase RegularWatch ref)
 --       <|> MaybeT (getWatch codebase TestWatch ref))
 -- @
-lookupWatchCache :: (Monad m) => Codebase m v a -> Reference.Id -> m (Maybe (Term v a))
+lookupWatchCache :: Codebase m v a -> Reference.Id -> Sqlite.Transaction (Maybe (Term v a))
 lookupWatchCache codebase h = do
   m1 <- getWatch codebase WK.RegularWatch h
   maybe (getWatch codebase WK.TestWatch h) (pure . Just) m1
diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs
index 6de36c602..a22b1569c 100644
--- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs
+++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs
@@ -314,9 +314,9 @@ sqliteCodebase debugName root localOrRemote migrationStrategy action = do
                     Sqlite.runWriteTransaction destConn \runDest -> do
                       syncInternal (syncProgress progressStateRef) runSrc runDest b
 
-            getWatch :: UF.WatchKind -> Reference.Id -> m (Maybe (Term Symbol Ann))
-            getWatch k r =
-              runTransaction (CodebaseOps.getWatch getDeclType k r)
+            getWatch :: UF.WatchKind -> Reference.Id -> Sqlite.Transaction (Maybe (Term Symbol Ann))
+            getWatch =
+              CodebaseOps.getWatch getDeclType
 
             termsOfTypeImpl :: Reference -> m (Set Referent.Id)
             termsOfTypeImpl r =
diff --git a/parser-typechecker/src/Unison/Codebase/Type.hs b/parser-typechecker/src/Unison/Codebase/Type.hs
index 8972bea33..36a7d9754 100644
--- a/parser-typechecker/src/Unison/Codebase/Type.hs
+++ b/parser-typechecker/src/Unison/Codebase/Type.hs
@@ -97,7 +97,7 @@ data Codebase m v a = Codebase
     -- | Push the given branch to the given repo, and optionally set it as the root branch.
     pushGitBranch :: forall e. WriteGitRepo -> PushGitBranchOpts -> (Branch m -> m (Either e (Branch m))) -> m (Either GitError (Either e (Branch m))),
     -- | @getWatch k r@ returns watch result @t@ that was previously put by @putWatch k r t@.
-    getWatch :: WK.WatchKind -> Reference.Id -> m (Maybe (Term v a)),
+    getWatch :: WK.WatchKind -> Reference.Id -> Sqlite.Transaction (Maybe (Term v a)),
     -- | Get the set of user-defined terms-or-constructors that have the given type.
     termsOfTypeImpl :: Reference -> m (Set Referent.Id),
     -- | Get the set of user-defined terms-or-constructors mention the given type anywhere in their signature.
diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs
index 16f824272..adfbf40c1 100644
--- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs
+++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs
@@ -2068,7 +2068,7 @@ handleTest TestInput {includeLibNamespace, showFailures, showSuccesses} = do
     fmap Map.fromList do
       Set.toList testRefs & wither \case
         Reference.Builtin _ -> pure Nothing
-        r@(Reference.DerivedId rid) -> liftIO (fmap (r,) <$> Codebase.getWatch codebase WK.TestWatch rid)
+        r@(Reference.DerivedId rid) -> fmap (r,) <$> Cli.runTransaction (Codebase.getWatch codebase WK.TestWatch rid)
   let stats = Output.CachedTests (Set.size testRefs) (Map.size cachedTests)
   names <-
     makePrintNamesFromLabeled' $
@@ -2974,7 +2974,7 @@ evalUnisonFile sandbox ppe unisonFile args = do
 
   let watchCache :: Reference.Id -> IO (Maybe (Term Symbol ()))
       watchCache ref = do
-        maybeTerm <- Codebase.lookupWatchCache codebase ref
+        maybeTerm <- Codebase.runTransaction codebase (Codebase.lookupWatchCache codebase ref)
         pure (Term.amap (\(_ :: Ann) -> ()) <$> maybeTerm)
 
   Cli.with_ (withArgs args) do
@@ -3000,7 +3000,7 @@ evalUnisonTermE sandbox ppe useCache tm = do
 
   let watchCache :: Reference.Id -> IO (Maybe (Term Symbol ()))
       watchCache ref = do
-        maybeTerm <- Codebase.lookupWatchCache codebase ref
+        maybeTerm <- Codebase.runTransaction codebase (Codebase.lookupWatchCache codebase ref)
         pure (Term.amap (\(_ :: Ann) -> ()) <$> maybeTerm)
 
   let cache = if useCache then watchCache else Runtime.noCache
diff --git a/unison-share-api/src/Unison/Server/Backend.hs b/unison-share-api/src/Unison/Server/Backend.hs
index 9f316733f..cceab8601 100644
--- a/unison-share-api/src/Unison/Server/Backend.hs
+++ b/unison-share-api/src/Unison/Server/Backend.hs
@@ -982,7 +982,7 @@ renderDoc ppe width rt codebase r = do
     eval (Term.amap (const mempty) -> tm) = do
       let ppes = PPED.suffixifiedPPE ppe
       let codeLookup = Codebase.toCodeLookup codebase
-      let cache r = fmap Term.unannotate <$> Codebase.lookupWatchCache codebase r
+      let cache r = fmap Term.unannotate <$> Codebase.runTransaction codebase (Codebase.lookupWatchCache codebase r)
       r <- fmap hush . liftIO $ Rt.evaluateTerm' codeLookup cache ppes rt tm
       case r of
         Just tmr ->

From 29ec3ab4106869594e8d74f1bcea803e3a6c62c1 Mon Sep 17 00:00:00 2001
From: Mitchell Rosen <mitchellwrosen@gmail.com>
Date: Tue, 8 Nov 2022 00:00:44 +0530
Subject: [PATCH 07/41] remove getShallowCausalByHash from Codebase record

---
 parser-typechecker/src/Unison/Codebase.hs     | 62 +++++++++--------
 .../src/Unison/Codebase/SqliteCodebase.hs     |  6 --
 .../src/Unison/Codebase/Type.hs               |  2 -
 unison-cli/src/Unison/Cli/MonadUtils.hs       | 10 +--
 .../src/Unison/Codebase/Editor/HandleInput.hs | 20 +++---
 .../src/Unison/CommandLine/Completion.hs      | 51 +++++---------
 .../src/Unison/CommandLine/InputPatterns.hs   | 15 ++--
 unison-share-api/src/Unison/Server/Backend.hs | 68 +++++++++++--------
 .../Server/Endpoints/DefinitionSummary.hs     |  7 +-
 .../src/Unison/Server/Endpoints/FuzzyFind.hs  | 12 ++--
 .../Server/Endpoints/NamespaceDetails.hs      |  9 ++-
 .../Server/Endpoints/NamespaceListing.hs      | 20 ++++--
 .../src/Unison/Server/Endpoints/Projects.hs   | 19 +++---
 13 files changed, 155 insertions(+), 146 deletions(-)

diff --git a/parser-typechecker/src/Unison/Codebase.hs b/parser-typechecker/src/Unison/Codebase.hs
index e1224941a..4ee5acf48 100644
--- a/parser-typechecker/src/Unison/Codebase.hs
+++ b/parser-typechecker/src/Unison/Codebase.hs
@@ -41,7 +41,7 @@ module Unison.Codebase
     SqliteCodebase.Operations.before,
     getShallowBranchAtPath,
     getShallowCausalAtPath,
-    getShallowCausalForHash,
+    Operations.expectCausalBranchByCausalHash,
     getShallowCausalFromRoot,
     getShallowRootBranch,
     getShallowRootCausal,
@@ -173,49 +173,53 @@ runTransaction Codebase {withConnection} action =
   withConnection \conn -> Sqlite.runTransaction conn action
 
 getShallowCausalFromRoot ::
-  MonadIO m =>
-  Codebase m v a ->
   -- Optional root branch, if Nothing use the codebase's root branch.
   Maybe V2.CausalHash ->
   Path.Path ->
-  m (V2Branch.CausalBranch m)
-getShallowCausalFromRoot codebase mayRootHash p = do
+  Sqlite.Transaction (V2Branch.CausalBranch Sqlite.Transaction)
+getShallowCausalFromRoot mayRootHash p = do
   rootCausal <- case mayRootHash of
-    Nothing -> getShallowRootCausal codebase
-    Just ch -> getShallowCausalForHash codebase ch
-  getShallowCausalAtPath codebase p (Just rootCausal)
+    Nothing -> getShallowRootCausal
+    Just ch -> Operations.expectCausalBranchByCausalHash ch
+  getShallowCausalAtPath p (Just rootCausal)
 
 -- | Get the shallow representation of the root branches without loading the children or
 -- history.
-getShallowRootBranch :: MonadIO m => Codebase m v a -> m (V2.Branch m)
-getShallowRootBranch codebase = do
-  getShallowRootCausal codebase >>= V2Causal.value
+getShallowRootBranch :: Sqlite.Transaction (V2.Branch Sqlite.Transaction)
+getShallowRootBranch = do
+  getShallowRootCausal >>= V2Causal.value
 
 -- | Get the shallow representation of the root branches without loading the children or
 -- history.
-getShallowRootCausal :: MonadIO m => Codebase m v a -> m (V2.CausalBranch m)
-getShallowRootCausal codebase = do
-  hash <- runTransaction codebase Operations.expectRootCausalHash
-  getShallowCausalForHash codebase hash
+getShallowRootCausal :: Sqlite.Transaction (V2.CausalBranch Sqlite.Transaction)
+getShallowRootCausal = do
+  hash <- Operations.expectRootCausalHash
+  Operations.expectCausalBranchByCausalHash hash
 
 -- | Recursively descend into causals following the given path,
 -- Use the root causal if none is provided.
-getShallowCausalAtPath :: MonadIO m => Codebase m v a -> Path -> Maybe (V2Branch.CausalBranch m) -> m (V2Branch.CausalBranch m)
-getShallowCausalAtPath codebase path mayCausal = do
-  causal <- whenNothing mayCausal (getShallowRootCausal codebase)
+getShallowCausalAtPath ::
+  Path ->
+  Maybe (V2Branch.CausalBranch Sqlite.Transaction) ->
+  Sqlite.Transaction (V2Branch.CausalBranch Sqlite.Transaction)
+getShallowCausalAtPath path mayCausal = do
+  causal <- whenNothing mayCausal getShallowRootCausal
   case path of
     Path.Empty -> pure causal
     (ns Path.:< p) -> do
       b <- V2Causal.value causal
       case (V2Branch.childAt (Cv.namesegment1to2 ns) b) of
         Nothing -> pure (Cv.causalbranch1to2 Branch.empty)
-        Just childCausal -> getShallowCausalAtPath codebase p (Just childCausal)
+        Just childCausal -> getShallowCausalAtPath p (Just childCausal)
 
 -- | Recursively descend into causals following the given path,
 -- Use the root causal if none is provided.
-getShallowBranchAtPath :: MonadIO m => Codebase m v a -> Path -> Maybe (V2Branch.Branch m) -> m (V2Branch.Branch m)
-getShallowBranchAtPath codebase path mayBranch = do
-  branch <- whenNothing mayBranch (getShallowRootCausal codebase >>= V2Causal.value)
+getShallowBranchAtPath ::
+  Path ->
+  Maybe (V2Branch.Branch Sqlite.Transaction) ->
+  Sqlite.Transaction (V2Branch.Branch Sqlite.Transaction)
+getShallowBranchAtPath path mayBranch = do
+  branch <- whenNothing mayBranch (getShallowRootCausal >>= V2Causal.value)
   case path of
     Path.Empty -> pure branch
     (ns Path.:< p) -> do
@@ -223,7 +227,7 @@ getShallowBranchAtPath codebase path mayBranch = do
         Nothing -> pure V2Branch.empty
         Just childCausal -> do
           childBranch <- V2Causal.value childCausal
-          getShallowBranchAtPath codebase p (Just childBranch)
+          getShallowBranchAtPath p (Just childBranch)
 
 -- | Get a branch from the codebase.
 getBranchForHash :: Monad m => Codebase m v a -> Branch.CausalHash -> m (Maybe (Branch m))
@@ -245,17 +249,15 @@ getBranchForHash codebase h =
 
 -- | Get the metadata attached to the term at a given path and name relative to the given branch.
 termMetadata ::
-  MonadIO m =>
-  Codebase m v a ->
   -- | The branch to search inside. Use the current root if 'Nothing'.
-  Maybe (V2Branch.Branch m) ->
+  Maybe (V2Branch.Branch Sqlite.Transaction) ->
   Split ->
   -- | There may be multiple terms at the given name. You can specify a Referent to
   -- disambiguate if desired.
   Maybe V2.Referent ->
-  m [Map V2Branch.MetadataValue V2Branch.MetadataType]
-termMetadata codebase mayBranch (path, nameSeg) ref = do
-  b <- getShallowBranchAtPath codebase path mayBranch
+  Sqlite.Transaction [Map V2Branch.MetadataValue V2Branch.MetadataType]
+termMetadata mayBranch (path, nameSeg) ref = do
+  b <- getShallowBranchAtPath path mayBranch
   V2Branch.termMetadata b (coerce @NameSegment.NameSegment nameSeg) ref
 
 -- | Get the lowest common ancestor of two branches, i.e. the most recent branch that is an ancestor of both branches.
@@ -265,7 +267,7 @@ lca code b1@(Branch.headHash -> h1) b2@(Branch.headHash -> h2) = do
     runTransaction code do
       eb1 <- SqliteCodebase.Operations.branchExists h1
       eb2 <- SqliteCodebase.Operations.branchExists h2
-      if eb1 && eb2 
+      if eb1 && eb2
         then do
           SqliteCodebase.Operations.sqlLca h1 h2 >>= \case
             Just h -> pure (getBranchForHash code h)
diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs
index a22b1569c..0b568ebd1 100644
--- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs
+++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs
@@ -25,7 +25,6 @@ import Data.Time (getCurrentTime)
 import qualified System.Console.ANSI as ANSI
 import qualified System.FilePath as FilePath
 import qualified System.FilePath.Posix as FilePath.Posix
-import qualified U.Codebase.Branch as V2Branch
 import U.Codebase.HashTags (BranchHash, CausalHash (CausalHash))
 import qualified U.Codebase.Reflog as Reflog
 import qualified U.Codebase.Sqlite.Operations as Ops
@@ -264,10 +263,6 @@ sqliteCodebase debugName root localOrRemote migrationStrategy action = do
             putTypeDeclarationComponent =
               CodebaseOps.putTypeDeclarationComponent termBuffer declBuffer
 
-            getShallowCausalForHash :: MonadIO m => V2Branch.CausalHash -> m (V2Branch.CausalBranch m)
-            getShallowCausalForHash bh =
-              V2Branch.hoistCausalBranch runTransaction <$> runTransaction (Ops.expectCausalBranchByCausalHash bh)
-
             getRootBranch :: TVar (Maybe (Sqlite.DataVersion, Branch Sqlite.Transaction)) -> m (Branch m)
             getRootBranch rootBranchCache =
               Branch.transform runTransaction <$> runTransaction (CodebaseOps.getRootBranch branchCache getDeclType rootBranchCache)
@@ -350,7 +345,6 @@ sqliteCodebase debugName root localOrRemote migrationStrategy action = do
                   getTermComponentWithTypes,
                   getRootBranch = getRootBranch rootBranchCache,
                   putRootBranch = putRootBranch rootBranchCache,
-                  getShallowCausalForHash,
                   getBranchForHashImpl = getBranchForHash,
                   putBranch,
                   syncFromDirectory,
diff --git a/parser-typechecker/src/Unison/Codebase/Type.hs b/parser-typechecker/src/Unison/Codebase/Type.hs
index 36a7d9754..1ea9b0be7 100644
--- a/parser-typechecker/src/Unison/Codebase/Type.hs
+++ b/parser-typechecker/src/Unison/Codebase/Type.hs
@@ -13,7 +13,6 @@ module Unison.Codebase.Type
   )
 where
 
-import qualified U.Codebase.Branch as V2
 import U.Codebase.HashTags (BranchHash)
 import qualified U.Codebase.Reference as V2
 import Unison.Codebase.Branch (Branch)
@@ -82,7 +81,6 @@ data Codebase m v a = Codebase
       Text -> -- Reason for the change, will be recorded in the reflog
       Branch m ->
       m (),
-    getShallowCausalForHash :: V2.CausalHash -> m (V2.CausalBranch m),
     getBranchForHashImpl :: Branch.CausalHash -> m (Maybe (Branch m)),
     -- | Put a branch into the codebase, which includes its children, its patches, and the branch itself, if they don't
     -- already exist.
diff --git a/unison-cli/src/Unison/Cli/MonadUtils.hs b/unison-cli/src/Unison/Cli/MonadUtils.hs
index 279a5e6c0..300e18ce1 100644
--- a/unison-cli/src/Unison/Cli/MonadUtils.hs
+++ b/unison-cli/src/Unison/Cli/MonadUtils.hs
@@ -251,11 +251,11 @@ assertNoBranchAtPath' path' = do
 branchExistsAtPath' :: Path' -> Cli Bool
 branchExistsAtPath' path' = do
   absPath <- resolvePath' path'
-  Cli.Env {codebase} <- ask
-  causal <- liftIO $ Codebase.getShallowCausalFromRoot codebase Nothing (Path.unabsolute absPath)
-  branch <- liftIO $ V2Causal.value causal
-  isEmpty <- Cli.runTransaction $ V2Branch.isEmpty branch
-  pure (not isEmpty)
+  Cli.runTransaction do
+    causal <- Codebase.getShallowCausalFromRoot Nothing (Path.unabsolute absPath)
+    branch <- V2Causal.value causal
+    isEmpty <- V2Branch.isEmpty branch
+    pure (not isEmpty)
 
 ------------------------------------------------------------------------------------------------------------------------
 -- Updating branches
diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs
index adfbf40c1..2eb078693 100644
--- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs
+++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs
@@ -373,7 +373,7 @@ loop e = do
               Cli.respond $ PrintMessage pretty
             ShowReflogI -> do
               let numEntriesToShow = 500
-              entries <- 
+              entries <-
                 Cli.runTransaction do
                   schLength <- Codebase.branchHashLength
                   Codebase.getReflog numEntriesToShow <&> fmap (first $ SCH.fromHash schLength)
@@ -1413,14 +1413,13 @@ loop e = do
                 traceM $ show name ++ ",Type," ++ Text.unpack (Reference.toText r)
               for_ (Relation.toList . Branch.deepTerms $ rootBranch0) \(r, name) ->
                 traceM $ show name ++ ",Term," ++ Text.unpack (Referent.toText r)
-            DebugClearWatchI {} -> 
+            DebugClearWatchI {} ->
               Cli.runTransaction Codebase.clearWatches
             DebugDoctorI {} -> do
               r <- Cli.runTransaction IntegrityCheck.integrityCheckFullCodebase
               Cli.respond (IntegrityCheck r)
             DebugNameDiffI fromSCH toSCH -> do
-              Cli.Env {codebase} <- ask
-              (schLen, fromCHs, toCHs) <- 
+              (schLen, fromCHs, toCHs) <-
                 Cli.runTransaction do
                   schLen <- Codebase.branchHashLength
                   fromCHs <- Codebase.causalHashesByPrefix fromSCH
@@ -1432,12 +1431,13 @@ loop e = do
                 (_, []) -> Cli.returnEarly $ Output.NoBranchWithHash toSCH
                 (_, (_ : _ : _)) -> Cli.returnEarly $ Output.BranchHashAmbiguous toSCH (Set.map (SCH.fromHash schLen) toCHs)
                 ([fromCH], [toCH]) -> pure (fromCH, toCH)
-              output <- liftIO do
-                fromBranch <- (Codebase.getShallowCausalForHash codebase $ Cv.causalHash1to2 fromCH) >>= V2Causal.value
-                toBranch <- (Codebase.getShallowCausalForHash codebase $ Cv.causalHash1to2 toCH) >>= V2Causal.value
-                treeDiff <- V2Branch.diffBranches fromBranch toBranch
-                let nameChanges = V2Branch.nameChanges Nothing treeDiff
-                pure (DisplayDebugNameDiff nameChanges)
+              output <-
+                Cli.runTransaction do
+                  fromBranch <- (Codebase.expectCausalBranchByCausalHash $ Cv.causalHash1to2 fromCH) >>= V2Causal.value
+                  toBranch <- (Codebase.expectCausalBranchByCausalHash $ Cv.causalHash1to2 toCH) >>= V2Causal.value
+                  treeDiff <- V2Branch.diffBranches fromBranch toBranch
+                  let nameChanges = V2Branch.nameChanges Nothing treeDiff
+                  pure (DisplayDebugNameDiff nameChanges)
               Cli.respond output
             DeprecateTermI {} -> Cli.respond NotImplemented
             DeprecateTypeI {} -> Cli.respond NotImplemented
diff --git a/unison-cli/src/Unison/CommandLine/Completion.hs b/unison-cli/src/Unison/CommandLine/Completion.hs
index e3018305a..09dfaeb43 100644
--- a/unison-cli/src/Unison/CommandLine/Completion.hs
+++ b/unison-cli/src/Unison/CommandLine/Completion.hs
@@ -57,6 +57,7 @@ import qualified Unison.Server.Endpoints.NamespaceListing as Server
 import qualified Unison.Server.Types as Server
 import qualified Unison.Share.Codeserver as Codeserver
 import qualified Unison.Share.Types as Share
+import qualified Unison.Sqlite as Sqlite
 import qualified Unison.Util.Pretty as P
 import qualified UnliftIO
 import Prelude hiding (readFile, writeFile)
@@ -131,18 +132,15 @@ noCompletions _ _ _ _ = pure []
 -- .> view base.List.map#<Tab>
 -- base.List.map#0q926sgnn6
 completeWithinNamespace ::
-  forall m v a.
-  MonadIO m =>
   -- | The types of completions to return
   NESet CompletionType ->
   -- | The portion of this are that the user has already typed.
   String ->
-  Codebase m v a ->
   Path.Absolute ->
-  m [System.Console.Haskeline.Completion.Completion]
-completeWithinNamespace compTypes query codebase currentPath = do
-  shortHashLen <- Codebase.runTransaction codebase Codebase.hashLength
-  b <- Codebase.getShallowBranchAtPath codebase (Path.unabsolute absQueryPath) Nothing
+  Sqlite.Transaction [System.Console.Haskeline.Completion.Completion]
+completeWithinNamespace compTypes query currentPath = do
+  shortHashLen <- Codebase.hashLength
+  b <- Codebase.getShallowBranchAtPath (Path.unabsolute absQueryPath) Nothing
   currentBranchSuggestions <- do
     nib <- namesInBranch shortHashLen b
     nib
@@ -162,9 +160,9 @@ completeWithinNamespace compTypes query codebase currentPath = do
     (queryPathPrefix, querySuffix) = parseLaxPath'Query (Text.pack query)
     absQueryPath :: Path.Absolute
     absQueryPath = Path.resolve currentPath queryPathPrefix
-    getChildSuggestions :: Int -> V2Branch.Branch m -> m [Completion]
+    getChildSuggestions :: Int -> V2Branch.Branch Sqlite.Transaction -> Sqlite.Transaction [Completion]
     getChildSuggestions shortHashLen b = do
-      nonEmptyChildren <- Codebase.runTransaction codebase (V2Branch.nonEmptyChildren b)
+      nonEmptyChildren <- V2Branch.nonEmptyChildren b
       case querySuffix of
         "" -> pure []
         suffix -> do
@@ -180,9 +178,9 @@ completeWithinNamespace compTypes query codebase currentPath = do
                 & filter (\(_isFinished, match) -> List.isPrefixOf query match)
                 & fmap (\(isFinished, match) -> prettyCompletionWithQueryPrefix isFinished query match)
                 & pure
-    namesInBranch :: Int -> V2Branch.Branch m -> m [(Bool, Text)]
+    namesInBranch :: Int -> V2Branch.Branch Sqlite.Transaction -> Sqlite.Transaction [(Bool, Text)]
     namesInBranch hashLen b = do
-      nonEmptyChildren <- Codebase.runTransaction codebase (V2Branch.nonEmptyChildren b)
+      nonEmptyChildren <- V2Branch.nonEmptyChildren b
       let textifyHQ :: (V2Branch.NameSegment -> r -> HQ'.HashQualified V2Branch.NameSegment) -> Map V2Branch.NameSegment (Map r metadata) -> [(Bool, Text)]
           textifyHQ f xs =
             xs
@@ -208,9 +206,9 @@ completeWithinNamespace compTypes query codebase currentPath = do
         qualifyRefs :: V2Branch.NameSegment -> (Map r metadata) -> [HQ'.HashQualified V2Branch.NameSegment]
         qualifyRefs n refs
           | ((Text.isInfixOf "#" . NameSegment.toText) querySuffix) || length refs > 1 =
-            refs
-              & Map.keys
-              <&> qualify n
+              refs
+                & Map.keys
+                <&> qualify n
           | otherwise = [HQ'.NameOnly n]
 
     -- If we're not completing namespaces, then all namespace completions should automatically
@@ -265,52 +263,37 @@ parseLaxPath'Query txt =
 
 -- | Completes a namespace argument by prefix-matching against the query.
 prefixCompleteNamespace ::
-  forall m v a.
-  (MonadIO m) =>
   String ->
-  Codebase m v a ->
   Path.Absolute -> -- Current path
-  m [Line.Completion]
+  Sqlite.Transaction [Line.Completion]
 prefixCompleteNamespace = completeWithinNamespace (NESet.singleton NamespaceCompletion)
 
 -- | Completes a term or type argument by prefix-matching against the query.
 prefixCompleteTermOrType ::
-  forall m v a.
-  MonadIO m =>
   String ->
-  Codebase m v a ->
   Path.Absolute -> -- Current path
-  m [Line.Completion]
+  Sqlite.Transaction [Line.Completion]
 prefixCompleteTermOrType = completeWithinNamespace (NESet.fromList (TermCompletion NE.:| [TypeCompletion]))
 
 -- | Completes a term argument by prefix-matching against the query.
 prefixCompleteTerm ::
-  forall m v a.
-  MonadIO m =>
   String ->
-  Codebase m v a ->
   Path.Absolute -> -- Current path
-  m [Line.Completion]
+  Sqlite.Transaction [Line.Completion]
 prefixCompleteTerm = completeWithinNamespace (NESet.singleton TermCompletion)
 
 -- | Completes a term or type argument by prefix-matching against the query.
 prefixCompleteType ::
-  forall m v a.
-  MonadIO m =>
   String ->
-  Codebase m v a ->
   Path.Absolute -> -- Current path
-  m [Line.Completion]
+  Sqlite.Transaction [Line.Completion]
 prefixCompleteType = completeWithinNamespace (NESet.singleton TypeCompletion)
 
 -- | Completes a patch argument by prefix-matching against the query.
 prefixCompletePatch ::
-  forall m v a.
-  MonadIO m =>
   String ->
-  Codebase m v a ->
   Path.Absolute -> -- Current path
-  m [Line.Completion]
+  Sqlite.Transaction [Line.Completion]
 prefixCompletePatch = completeWithinNamespace (NESet.singleton PatchCompletion)
 
 -- | Renders a completion option with the prefix matching the query greyed out.
diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs
index 324a009dd..62b92b288 100644
--- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs
+++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs
@@ -13,6 +13,7 @@ import qualified Data.Set as Set
 import qualified Data.Text as Text
 import System.Console.Haskeline.Completion (Completion (Completion))
 import qualified Text.Megaparsec as P
+import qualified Unison.Codebase as Codebase
 import qualified Unison.Codebase.Branch as Branch
 import qualified Unison.Codebase.Branch.Merge as Branch
 import Unison.Codebase.Editor.Input (Input)
@@ -2331,7 +2332,7 @@ exactDefinitionArg :: ArgumentType
 exactDefinitionArg =
   ArgumentType
     { typeName = "definition",
-      suggestions = \q cb _http p -> prefixCompleteTermOrType q cb p,
+      suggestions = \q cb _http p -> Codebase.runTransaction cb (prefixCompleteTermOrType q p),
       globTargets = Set.fromList [Globbing.Term, Globbing.Type]
     }
 
@@ -2339,7 +2340,7 @@ fuzzyDefinitionQueryArg :: ArgumentType
 fuzzyDefinitionQueryArg =
   ArgumentType
     { typeName = "fuzzy definition query",
-      suggestions = \q cb _http p -> prefixCompleteTermOrType q cb p,
+      suggestions = \q cb _http p -> Codebase.runTransaction cb (prefixCompleteTermOrType q p),
       globTargets = Set.fromList [Globbing.Term, Globbing.Type]
     }
 
@@ -2350,7 +2351,7 @@ exactDefinitionTypeQueryArg :: ArgumentType
 exactDefinitionTypeQueryArg =
   ArgumentType
     { typeName = "type definition query",
-      suggestions = \q cb _http p -> prefixCompleteType q cb p,
+      suggestions = \q cb _http p -> Codebase.runTransaction cb (prefixCompleteType q p),
       globTargets = Set.fromList [Globbing.Type]
     }
 
@@ -2358,7 +2359,7 @@ exactDefinitionTermQueryArg :: ArgumentType
 exactDefinitionTermQueryArg =
   ArgumentType
     { typeName = "term definition query",
-      suggestions = \q cb _http p -> prefixCompleteTerm q cb p,
+      suggestions = \q cb _http p -> Codebase.runTransaction cb (prefixCompleteTerm q p),
       globTargets = Set.fromList [Globbing.Term]
     }
 
@@ -2366,7 +2367,7 @@ patchArg :: ArgumentType
 patchArg =
   ArgumentType
     { typeName = "patch",
-      suggestions = \q cb _http p -> prefixCompletePatch q cb p,
+      suggestions = \q cb _http p -> Codebase.runTransaction cb (prefixCompletePatch q p),
       globTargets = Set.fromList []
     }
 
@@ -2374,7 +2375,7 @@ namespaceArg :: ArgumentType
 namespaceArg =
   ArgumentType
     { typeName = "namespace",
-      suggestions = \q cb _http p -> prefixCompleteNamespace q cb p,
+      suggestions = \q cb _http p -> Codebase.runTransaction cb (prefixCompleteNamespace q p),
       globTargets = Set.fromList [Globbing.Namespace]
     }
 
@@ -2386,7 +2387,7 @@ newNameArg :: ArgumentType
 newNameArg =
   ArgumentType
     { typeName = "new-name",
-      suggestions = \q cb _http p -> prefixCompleteNamespace q cb p,
+      suggestions = \q cb _http p -> Codebase.runTransaction cb (prefixCompleteNamespace q p),
       globTargets = mempty
     }
 
diff --git a/unison-share-api/src/Unison/Server/Backend.hs b/unison-share-api/src/Unison/Server/Backend.hs
index cceab8601..d039f3a28 100644
--- a/unison-share-api/src/Unison/Server/Backend.hs
+++ b/unison-share-api/src/Unison/Server/Backend.hs
@@ -338,12 +338,12 @@ lsAtPath ::
   MonadIO m =>
   Codebase m Symbol Ann ->
   -- The root to follow the path from.
-  Maybe (V2Branch.Branch m) ->
+  Maybe (V2Branch.Branch Sqlite.Transaction) ->
   -- Path from the root to the branch to 'ls'
   Path.Absolute ->
   m [ShallowListEntry Symbol Ann]
 lsAtPath codebase mayRootBranch absPath = do
-  b <- Codebase.getShallowBranchAtPath codebase (Path.unabsolute absPath) mayRootBranch
+  b <- Codebase.runTransaction codebase (Codebase.getShallowBranchAtPath (Path.unabsolute absPath) mayRootBranch)
   lsBranch codebase b
 
 findShallowReadmeInBranchAndRender ::
@@ -407,7 +407,7 @@ resultListType = Type.app mempty (Type.list mempty) (Type.ref mempty Decls.testR
 termListEntry ::
   MonadIO m =>
   Codebase m Symbol Ann ->
-  V2Branch.Branch m ->
+  V2Branch.Branch n ->
   ExactName NameSegment V2Referent.Referent ->
   m (TermEntry Symbol Ann)
 termListEntry codebase branch (ExactName nameSegment ref) = do
@@ -477,7 +477,7 @@ getTypeTag codebase r = do
 typeListEntry ::
   Var v =>
   Codebase m v Ann ->
-  V2Branch.Branch m ->
+  V2Branch.Branch n ->
   ExactName NameSegment Reference ->
   Sqlite.Transaction TypeEntry
 typeListEntry codebase b (ExactName nameSegment ref) = do
@@ -551,7 +551,7 @@ typeEntryToNamedType te@TypeEntry {typeEntryTag, typeEntryHash} =
 lsBranch ::
   MonadIO m =>
   Codebase m Symbol Ann ->
-  V2Branch.Branch m ->
+  V2Branch.Branch n ->
   m [ShallowListEntry Symbol Ann]
 lsBranch codebase b0 = do
   let flattenRefs :: Map V2Branch.NameSegment (Map ref v) -> [(ref, V2Branch.NameSegment)]
@@ -561,7 +561,7 @@ lsBranch codebase b0 = do
         pure (r, ns)
   termEntries <- for (flattenRefs $ V2Branch.terms b0) $ \(r, ns) -> do
     ShallowTermEntry <$> termListEntry codebase b0 (ExactName (coerce @V2Branch.NameSegment ns) r)
-  typeEntries <- 
+  typeEntries <-
     Codebase.runTransaction codebase do
       for (flattenRefs $ V2Branch.types b0) \(r, ns) -> do
         let v1Ref = Cv.reference2to1 r
@@ -796,13 +796,15 @@ expandShortCausalHash hash = do
       throwError . AmbiguousBranchHash hash $ Set.map (SCH.fromHash len) hashSet
 
 -- | Efficiently resolve a root hash and path to a shallow branch's causal.
-getShallowCausalAtPathFromRootHash :: MonadIO m => Codebase m v a -> Maybe Branch.CausalHash -> Path -> Backend m (V2Branch.CausalBranch m)
-getShallowCausalAtPathFromRootHash codebase mayRootHash path = do
+getShallowCausalAtPathFromRootHash ::
+  Maybe Branch.CausalHash ->
+  Path ->
+  Sqlite.Transaction (V2Branch.CausalBranch Sqlite.Transaction)
+getShallowCausalAtPathFromRootHash mayRootHash path = do
   shallowRoot <- case mayRootHash of
-    Nothing -> lift (Codebase.getShallowRootCausal codebase)
-    Just h -> do
-      lift $ Codebase.getShallowCausalForHash codebase (Cv.causalHash1to2 h)
-  lift $ Codebase.getShallowCausalAtPath codebase path (Just shallowRoot)
+    Nothing -> Codebase.getShallowRootCausal
+    Just h -> Codebase.expectCausalBranchByCausalHash (Cv.causalHash1to2 h)
+  Codebase.getShallowCausalAtPath path (Just shallowRoot)
 
 formatType' :: Var v => PPE.PrettyPrintEnv -> Width -> Type v a -> SyntaxText
 formatType' ppe w =
@@ -841,8 +843,11 @@ prettyDefinitionsForHQName ::
   HQ.HashQualified Name ->
   Backend IO DefinitionDisplayResults
 prettyDefinitionsForHQName path mayRoot renderWidth suffixifyBindings rt codebase query = do
-  shallowRoot <- resolveCausalHashV2 codebase (fmap Cv.causalHash1to2 mayRoot)
-  hqLength <- lift $ Codebase.runTransaction codebase Codebase.hashLength
+  (shallowRoot, hqLength) <-
+    (lift . Codebase.runTransaction codebase) do
+      shallowRoot <- resolveCausalHashV2 (fmap Cv.causalHash1to2 mayRoot)
+      hqLength <- Codebase.hashLength
+      pure (shallowRoot, hqLength)
   (localNamesOnly, unbiasedPPE) <- scopedNamesForBranchHash codebase (Just shallowRoot) path
   -- Bias towards both relative and absolute path to queries,
   -- This allows us to still bias towards definitions outside our perspective but within the
@@ -858,8 +863,10 @@ prettyDefinitionsForHQName path mayRoot renderWidth suffixifyBindings rt codebas
   let nameSearch :: NameSearch
       nameSearch = makeNameSearch hqLength (NamesWithHistory.fromCurrentNames localNamesOnly)
   DefinitionResults terms types misses <- lift (definitionsBySuffixes codebase nameSearch DontIncludeCycles [query])
-  causalAtPath <- lift $ Codebase.getShallowCausalAtPath codebase path (Just shallowRoot)
-  branchAtPath <- lift $ V2Causal.value causalAtPath
+  branchAtPath <- do
+    (lift . Codebase.runTransaction codebase) do
+      causalAtPath <- Codebase.getShallowCausalAtPath path (Just shallowRoot)
+      V2Causal.value causalAtPath
   let width = mayDefaultWidth renderWidth
       -- Return only references which refer to docs.
       filterForDocs :: [Referent] -> Sqlite.Transaction [TermReference]
@@ -1009,7 +1016,7 @@ docsInBranchToHtmlFiles runtime codebase root currentPath directory = do
   let allTerms = (R.toList . Branch.deepTerms . Branch.head) currentBranch
   -- ignores docs inside lib namespace, recursively
   let notLib (_, name) = "lib" `notElem` Name.segments name
-  (docTermsWithNames, hqLength) <- 
+  (docTermsWithNames, hqLength) <-
     Codebase.runTransaction codebase do
       docTermsWithNames <- filterM (isDoc codebase . fst) (filter notLib allTerms)
       hqLength <- Codebase.hashLength
@@ -1105,7 +1112,13 @@ bestNameForType ppe width =
 -- - 'local' includes ONLY the names within the provided path
 -- - 'ppe' is a ppe which searches for a name within the path first, but falls back to a global name search.
 --     The 'suffixified' component of this ppe will search for the shortest unambiguous suffix within the scope in which the name is found (local, falling back to global)
-scopedNamesForBranchHash :: forall m v a. MonadIO m => Codebase m v a -> Maybe (V2Branch.CausalBranch m) -> Path -> Backend m (Names, PPED.PrettyPrintEnvDecl)
+scopedNamesForBranchHash ::
+  forall m n v a.
+  MonadIO m =>
+  Codebase m v a ->
+  Maybe (V2Branch.CausalBranch n) ->
+  Path ->
+  Backend m (Names, PPED.PrettyPrintEnvDecl)
 scopedNamesForBranchHash codebase mbh path = do
   shouldUseNamesIndex <- asks useNamesIndex
   hashLen <- lift $ Codebase.runTransaction codebase Codebase.hashLength
@@ -1148,11 +1161,10 @@ resolveCausalHash h codebase = case h of
     mayBranch <- lift $ Codebase.getBranchForHash codebase bhash
     whenNothing mayBranch (throwError $ NoBranchForHash bhash)
 
-resolveCausalHashV2 ::
-  MonadIO m => Codebase m v a -> Maybe V2Branch.CausalHash -> Backend m (V2Branch.CausalBranch m)
-resolveCausalHashV2 codebase h = case h of
-  Nothing -> lift $ Codebase.getShallowRootCausal codebase
-  Just ch -> lift $ Codebase.getShallowCausalForHash codebase ch
+resolveCausalHashV2 :: Maybe V2Branch.CausalHash -> Sqlite.Transaction (V2Branch.CausalBranch Sqlite.Transaction)
+resolveCausalHashV2 h = case h of
+  Nothing -> Codebase.getShallowRootCausal
+  Just ch -> Codebase.expectCausalBranchByCausalHash ch
 
 resolveRootBranchHash ::
   MonadIO m => Maybe ShortCausalHash -> Codebase m v a -> Backend m (Branch m)
@@ -1164,12 +1176,12 @@ resolveRootBranchHash mayRoot codebase = case mayRoot of
     resolveCausalHash (Just h) codebase
 
 resolveRootBranchHashV2 ::
-  MonadIO m => Codebase m v a -> Maybe ShortCausalHash -> Backend m (V2Branch.CausalBranch m)
-resolveRootBranchHashV2 codebase mayRoot = case mayRoot of
-  Nothing -> lift (Codebase.getShallowRootCausal codebase)
+  Maybe ShortCausalHash -> Backend Sqlite.Transaction (V2Branch.CausalBranch Sqlite.Transaction)
+resolveRootBranchHashV2 mayRoot = case mayRoot of
+  Nothing -> lift Codebase.getShallowRootCausal
   Just sch -> do
-    h <- Cv.causalHash1to2 <$> hoistBackend (Codebase.runTransaction codebase) (expandShortCausalHash sch)
-    resolveCausalHashV2 codebase (Just h)
+    h <- Cv.causalHash1to2 <$> expandShortCausalHash sch
+    lift (resolveCausalHashV2 (Just h))
 
 -- | Determines whether we include full cycles in the results, (e.g. if I search for `isEven`, will I find `isOdd` too?)
 data IncludeCycles
diff --git a/unison-share-api/src/Unison/Server/Endpoints/DefinitionSummary.hs b/unison-share-api/src/Unison/Server/Endpoints/DefinitionSummary.hs
index 25d350f01..1aa7f60bc 100644
--- a/unison-share-api/src/Unison/Server/Endpoints/DefinitionSummary.hs
+++ b/unison-share-api/src/Unison/Server/Endpoints/DefinitionSummary.hs
@@ -90,8 +90,11 @@ serveTermSummary codebase referent mayName mayRoot relativeTo mayWidth = do
   let relativeToPath = fromMaybe Path.empty relativeTo
   let termReference = Referent.toReference referent
   let v2Referent = Cv.referent1to2 referent
-  root <- Backend.resolveRootBranchHashV2 codebase mayRoot
-  sig <- lift (Codebase.runTransaction codebase (Backend.loadReferentType codebase referent))
+  (root, sig) <-
+    Backend.hoistBackend (Codebase.runTransaction codebase) do
+      root <- Backend.resolveRootBranchHashV2 mayRoot
+      sig <- lift (Backend.loadReferentType codebase referent)
+      pure (root, sig)
   case sig of
     Nothing ->
       throwError (Backend.MissingSignatureForTerm termReference)
diff --git a/unison-share-api/src/Unison/Server/Endpoints/FuzzyFind.hs b/unison-share-api/src/Unison/Server/Endpoints/FuzzyFind.hs
index daa3afcd8..b6ef0fd3e 100644
--- a/unison-share-api/src/Unison/Server/Endpoints/FuzzyFind.hs
+++ b/unison-share-api/src/Unison/Server/Endpoints/FuzzyFind.hs
@@ -138,11 +138,15 @@ serveFuzzyFind ::
   Backend.Backend m [(FZF.Alignment, FoundResult)]
 serveFuzzyFind codebase mayRoot relativeTo limit typeWidth query = do
   let path = fromMaybe Path.empty relativeTo
-  rootHash <- traverse (Backend.hoistBackend (Codebase.runTransaction codebase) . Backend.expandShortCausalHash) mayRoot
-  rootCausal <- Backend.resolveCausalHashV2 codebase (Cv.causalHash1to2 <$> rootHash)
+  rootCausal <-
+    Backend.hoistBackend (Codebase.runTransaction codebase) do
+      rootHash <- traverse Backend.expandShortCausalHash mayRoot
+      lift (Backend.resolveCausalHashV2 (Cv.causalHash1to2 <$> rootHash))
   (localNamesOnly, ppe) <- Backend.scopedNamesForBranchHash codebase (Just rootCausal) path
-  relativeToCausal <- lift $ Codebase.getShallowCausalAtPath codebase path (Just rootCausal)
-  relativeToBranch <- lift $ V2Causal.value relativeToCausal
+  relativeToBranch <- do
+    (lift . Codebase.runTransaction codebase) do
+      relativeToCausal <- Codebase.getShallowCausalAtPath path (Just rootCausal)
+      V2Causal.value relativeToCausal
   let alignments ::
         ( [ ( FZF.Alignment,
               UnisonName,
diff --git a/unison-share-api/src/Unison/Server/Endpoints/NamespaceDetails.hs b/unison-share-api/src/Unison/Server/Endpoints/NamespaceDetails.hs
index bb1d4ac75..5d27be939 100644
--- a/unison-share-api/src/Unison/Server/Endpoints/NamespaceDetails.hs
+++ b/unison-share-api/src/Unison/Server/Endpoints/NamespaceDetails.hs
@@ -80,9 +80,12 @@ namespaceDetails ::
 namespaceDetails runtime codebase namespacePath maySCH mayWidth =
   let width = mayDefaultWidth mayWidth
    in do
-        rootCausal <- Backend.resolveRootBranchHashV2 codebase maySCH
-        namespaceCausal <- lift $ Codebase.getShallowCausalAtPath codebase namespacePath (Just rootCausal)
-        shallowBranch <- lift $ V2Causal.value namespaceCausal
+        (rootCausal, namespaceCausal, shallowBranch) <- 
+          Backend.hoistBackend (Codebase.runTransaction codebase) do
+            rootCausal <- Backend.resolveRootBranchHashV2 maySCH
+            namespaceCausal <- lift $ Codebase.getShallowCausalAtPath namespacePath (Just rootCausal)
+            shallowBranch <- lift $ V2Causal.value namespaceCausal
+            pure (rootCausal, namespaceCausal, shallowBranch)
         namespaceDetails <- do
           (_localNamesOnly, ppe) <- Backend.scopedNamesForBranchHash codebase (Just rootCausal) namespacePath
           readme <-
diff --git a/unison-share-api/src/Unison/Server/Endpoints/NamespaceListing.hs b/unison-share-api/src/Unison/Server/Endpoints/NamespaceListing.hs
index 4680407af..e5599aee3 100644
--- a/unison-share-api/src/Unison/Server/Endpoints/NamespaceListing.hs
+++ b/unison-share-api/src/Unison/Server/Endpoints/NamespaceListing.hs
@@ -171,7 +171,7 @@ serve ::
   Backend.Backend IO NamespaceListing
 serve codebase maySCH mayRelativeTo mayNamespaceName = do
   useIndex <- asks Backend.useNamesIndex
-  (mayRootHash, codebaseRootHash) <- 
+  (mayRootHash, codebaseRootHash) <-
     Backend.hoistBackend (Codebase.runTransaction codebase) do
       mayRootHash <- traverse Backend.expandShortCausalHash maySCH
       codebaseRootHash <- lift Operations.expectRootCausalHash
@@ -200,9 +200,9 @@ serve codebase maySCH mayRelativeTo mayNamespaceName = do
       serveFromIndex codebase mayRootHash path'
     (True, Just rh)
       | rh == causalHash2to1 codebaseRootHash ->
-        serveFromIndex codebase mayRootHash path'
+          serveFromIndex codebase mayRootHash path'
       | otherwise -> do
-        serveFromBranch codebase path' (Cv.causalHash1to2 rh)
+          serveFromBranch codebase path' (Cv.causalHash1to2 rh)
     (False, Just rh) -> do
       serveFromBranch codebase path' (Cv.causalHash1to2 rh)
     (False, Nothing) -> do
@@ -222,9 +222,12 @@ serveFromBranch codebase path' rootHash = do
   -- worth slowing down the request for this right now.
   let ppe = PPE.empty
   let listingFQN = Path.toText . Path.unabsolute . either id (Path.Absolute . Path.unrelative) $ Path.unPath' path'
-  causalAtPath <- liftIO $ Codebase.getShallowCausalFromRoot codebase (Just rootHash) (Path.unabsolute absPath)
+  (causalAtPath, branchAtPath) <-
+    (lift . Codebase.runTransaction codebase) do
+      causalAtPath <- Codebase.getShallowCausalFromRoot (Just rootHash) (Path.unabsolute absPath)
+      branchAtPath <- V2Causal.value causalAtPath
+      pure (causalAtPath, branchAtPath)
   let listingHash = v2CausalBranchToUnisonHash causalAtPath
-  branchAtPath <- liftIO $ V2Causal.value causalAtPath
   listingEntries <- liftIO $ Backend.lsBranch codebase branchAtPath
   makeNamespaceListing ppe listingFQN listingHash listingEntries
 
@@ -234,8 +237,11 @@ serveFromIndex ::
   Path.Path' ->
   Backend.Backend IO NamespaceListing
 serveFromIndex codebase mayRootHash path' = do
-  listingCausal <- Backend.getShallowCausalAtPathFromRootHash codebase mayRootHash (Path.fromPath' path')
-  listingBranch <- liftIO $ V2Causal.value listingCausal
+  (listingCausal, listingBranch) <-
+    (lift . Codebase.runTransaction codebase) do
+      listingCausal <- Backend.getShallowCausalAtPathFromRootHash mayRootHash (Path.fromPath' path')
+      listingBranch <- V2Causal.value listingCausal
+      pure (listingCausal, listingBranch)
   -- TODO: Currently the ppe is just used to render the types returned from the namespace
   -- listing, which are currently unused because we don't show types in the side-bar.
   -- If we ever show types on hover we need to build and use a proper PPE here, but it's not
diff --git a/unison-share-api/src/Unison/Server/Endpoints/Projects.hs b/unison-share-api/src/Unison/Server/Endpoints/Projects.hs
index 1f5e3a6f5..e3a8f3fc0 100644
--- a/unison-share-api/src/Unison/Server/Endpoints/Projects.hs
+++ b/unison-share-api/src/Unison/Server/Endpoints/Projects.hs
@@ -40,6 +40,7 @@ import Unison.Prelude
 import Unison.Server.Backend
 import qualified Unison.Server.Backend as Backend
 import Unison.Server.Types (APIGet, UnisonHash)
+import qualified Unison.Sqlite as Sqlite
 import Unison.Symbol (Symbol)
 import Unison.Util.Monoid (foldMapM)
 
@@ -133,13 +134,15 @@ serve codebase mayRoot mayOwner = projects
   where
     projects :: Backend m [ProjectListing]
     projects = do
-      shallowRootBranch <- case mayRoot of
-        Nothing -> lift (Codebase.getShallowRootBranch codebase)
-        Just sch -> do
-          h <- Backend.hoistBackend (Codebase.runTransaction codebase) (Backend.expandShortCausalHash sch)
-          -- TODO: can this ever be missing?
-          causal <- lift $ Codebase.getShallowCausalForHash codebase (Cv.causalHash1to2 h)
-          lift $ V2Causal.value causal
+      shallowRootBranch <-
+        Backend.hoistBackend (Codebase.runTransaction codebase) do
+          case mayRoot of
+            Nothing -> lift Codebase.getShallowRootBranch
+            Just sch -> do
+              h <- Backend.expandShortCausalHash sch
+              -- TODO: can this ever be missing?
+              causal <- lift $ Codebase.expectCausalBranchByCausalHash (Cv.causalHash1to2 h)
+              lift $ V2Causal.value causal
 
       ownerEntries <- lift $ Backend.lsBranch codebase shallowRootBranch
       -- If an owner is provided, we only want projects belonging to them
@@ -149,7 +152,7 @@ serve codebase mayRoot mayOwner = projects
               Nothing -> mapMaybe entryToOwner ownerEntries
       foldMapM (ownerToProjectListings shallowRootBranch) owners
 
-    ownerToProjectListings :: V2Branch.Branch m -> ProjectOwner -> Backend m [ProjectListing]
+    ownerToProjectListings :: V2Branch.Branch Sqlite.Transaction -> ProjectOwner -> Backend m [ProjectListing]
     ownerToProjectListings root owner = do
       let (ProjectOwner ownerName) = owner
       ownerPath' <- (parsePath . Text.unpack) ownerName

From 54257cc428c33718dec794eb737e99e079f50bab Mon Sep 17 00:00:00 2001
From: Dan Doel <dan.doel@gmail.com>
Date: Tue, 8 Nov 2022 15:51:29 -0500
Subject: [PATCH 08/41] Add immutable byte arrays to builtin serialization.

---
 parser-typechecker/src/Unison/Runtime/ANF.hs       |  2 ++
 .../src/Unison/Runtime/ANF/Serialize.hs            | 14 +++++++++++++-
 parser-typechecker/src/Unison/Runtime/Machine.hs   |  3 +++
 parser-typechecker/src/Unison/Runtime/Serialize.hs |  8 ++++++++
 4 files changed, 26 insertions(+), 1 deletion(-)

diff --git a/parser-typechecker/src/Unison/Runtime/ANF.hs b/parser-typechecker/src/Unison/Runtime/ANF.hs
index dba399808..8b467a500 100644
--- a/parser-typechecker/src/Unison/Runtime/ANF.hs
+++ b/parser-typechecker/src/Unison/Runtime/ANF.hs
@@ -76,6 +76,7 @@ import Control.Monad.State (MonadState (..), State, gets, modify, runState)
 import Data.Bifoldable (Bifoldable (..))
 import Data.Bifunctor (Bifunctor (..))
 import Data.Bits (shiftL, shiftR, (.&.), (.|.))
+import qualified Data.Primitive as PA
 import Data.Functor.Compose (Compose (..))
 import Data.List hiding (and, or)
 import qualified Data.Map as Map
@@ -1155,6 +1156,7 @@ data BLit
   | Bytes Bytes
   | Quote Value
   | Code (SuperGroup Symbol)
+  | BArr PA.ByteArray
   deriving (Show)
 
 groupVars :: ANFM v (Set v)
diff --git a/parser-typechecker/src/Unison/Runtime/ANF/Serialize.hs b/parser-typechecker/src/Unison/Runtime/ANF/Serialize.hs
index 9a9392db4..bb802362f 100644
--- a/parser-typechecker/src/Unison/Runtime/ANF/Serialize.hs
+++ b/parser-typechecker/src/Unison/Runtime/ANF/Serialize.hs
@@ -70,7 +70,15 @@ data LtTag
   | LMT
   | LYT
 
-data BLTag = TextT | ListT | TmLinkT | TyLinkT | BytesT | QuoteT | CodeT
+data BLTag
+  = TextT
+  | ListT
+  | TmLinkT
+  | TyLinkT
+  | BytesT
+  | QuoteT
+  | CodeT
+  | BArrT
 
 data VaTag = PartialT | DataT | ContT | BLitT
 
@@ -170,6 +178,7 @@ instance Tag BLTag where
     BytesT -> 4
     QuoteT -> 5
     CodeT -> 6
+    BArrT -> 7
 
   word2tag = \case
     0 -> pure TextT
@@ -179,6 +188,7 @@ instance Tag BLTag where
     4 -> pure BytesT
     5 -> pure QuoteT
     6 -> pure CodeT
+    7 -> pure BArrT
     t -> unknownTag "BLTag" t
 
 instance Tag VaTag where
@@ -579,6 +589,7 @@ putBLit (TyLink r) = putTag TyLinkT *> putReference r
 putBLit (Bytes b) = putTag BytesT *> putBytes b
 putBLit (Quote v) = putTag QuoteT *> putValue v
 putBLit (Code g) = putTag CodeT *> putGroup mempty g
+putBLit (BArr a) = putTag BArrT *> putByteArray a
 
 getBLit :: MonadGet m => Version -> m BLit
 getBLit v =
@@ -590,6 +601,7 @@ getBLit v =
     BytesT -> Bytes <$> getBytes
     QuoteT -> Quote <$> getValue v
     CodeT -> Code <$> getGroup
+    BArrT -> BArr <$> getByteArray
 
 putRefs :: MonadPut m => [Reference] -> m ()
 putRefs rs = putFoldable putReference rs
diff --git a/parser-typechecker/src/Unison/Runtime/Machine.hs b/parser-typechecker/src/Unison/Runtime/Machine.hs
index e2e9348a5..b406a76b7 100644
--- a/parser-typechecker/src/Unison/Runtime/Machine.hs
+++ b/parser-typechecker/src/Unison/Runtime/Machine.hs
@@ -1933,6 +1933,8 @@ reflectValue rty = goV
           pure (ANF.Quote v)
       | Just g <- maybeUnwrapForeign Rf.codeRef f =
           pure (ANF.Code g)
+      | Just a <- maybeUnwrapForeign Rf.ibytearrayRef f =
+          pure (ANF.BArr a)
       | otherwise = die $ err $ "foreign value: " <> (show f)
 
 reifyValue :: CCache -> ANF.Value -> IO (Either [Reference] Closure)
@@ -2005,6 +2007,7 @@ reifyValue0 (rty, rtm) = goV
     goL (ANF.Bytes b) = pure . Foreign $ Wrap Rf.bytesRef b
     goL (ANF.Quote v) = pure . Foreign $ Wrap Rf.valueRef v
     goL (ANF.Code g) = pure . Foreign $ Wrap Rf.codeRef g
+    goL (ANF.BArr a) = pure . Foreign $ Wrap Rf.ibytearrayRef a
 
 -- Universal comparison functions
 
diff --git a/parser-typechecker/src/Unison/Runtime/Serialize.hs b/parser-typechecker/src/Unison/Runtime/Serialize.hs
index 735f2a418..dfc8520ff 100644
--- a/parser-typechecker/src/Unison/Runtime/Serialize.hs
+++ b/parser-typechecker/src/Unison/Runtime/Serialize.hs
@@ -18,6 +18,7 @@ import Data.Map.Strict as Map (Map, fromList, toList)
 import Data.Text (Text)
 import Data.Text.Encoding (decodeUtf8, encodeUtf8)
 import qualified Data.Vector.Primitive as BA
+import qualified Data.Primitive as PA
 import Data.Word (Word64, Word8)
 import qualified U.Util.Hash as Hash
 import Unison.ConstructorReference (ConstructorReference, GConstructorReference (..))
@@ -34,6 +35,7 @@ import Unison.Runtime.MCode
   )
 import qualified Unison.Util.Bytes as Bytes
 import Unison.Util.EnumContainers as EC
+import GHC.Exts as IL (IsList(..))
 
 unknownTag :: MonadGet m => String -> Word8 -> m a
 unknownTag t w =
@@ -156,6 +158,12 @@ getBytes = Bytes.fromChunks <$> getList getBlock
 putBytes :: MonadPut m => Bytes.Bytes -> m ()
 putBytes = putFoldable putBlock . Bytes.chunks
 
+getByteArray :: MonadGet m => m PA.ByteArray
+getByteArray = PA.byteArrayFromList <$> getList getWord8
+
+putByteArray :: MonadPut m => PA.ByteArray -> m ()
+putByteArray a = putFoldable putWord8 (IL.toList a)
+
 getBlock :: MonadGet m => m Bytes.Chunk
 getBlock = getLength >>= fmap Bytes.byteStringToChunk . getByteString
 

From 19c4401a4483474d70455cfbc0b1cdce2e9c37bf Mon Sep 17 00:00:00 2001
From: Mitchell Rosen <mitchellwrosen@gmail.com>
Date: Wed, 9 Nov 2022 18:37:45 +0530
Subject: [PATCH 09/41] make tests compile

---
 unison-cli/tests/Unison/Test/GitSync.hs | 7 ++++---
 1 file changed, 4 insertions(+), 3 deletions(-)

diff --git a/unison-cli/tests/Unison/Test/GitSync.hs b/unison-cli/tests/Unison/Test/GitSync.hs
index 7acbfbad2..93bb5f285 100644
--- a/unison-cli/tests/Unison/Test/GitSync.hs
+++ b/unison-cli/tests/Unison/Test/GitSync.hs
@@ -513,9 +513,10 @@ test =
                     |]
                 )
                 ( \cb -> do
-                    void . fmap (fromJust . sequence) $
-                      traverse (Codebase.getWatch cb TestWatch)
-                        =<< Codebase.runTransaction cb (Codebase.watches TestWatch)
+                    Codebase.runTransaction cb do
+                      void . fmap (fromJust . sequence) $
+                        traverse (Codebase.getWatch cb TestWatch)
+                          =<< Codebase.watches TestWatch
                 ),
               gistTest fmt,
               pushPullBranchesTests fmt,

From 7591b90211b48e32bb412713b74c6ade170d1c5a Mon Sep 17 00:00:00 2001
From: Dan Doel <dan.doel@gmail.com>
Date: Wed, 9 Nov 2022 16:20:18 -0500
Subject: [PATCH 10/41] More work on scheme related commands

- Added dedicated commands for fetching the compiler and generating boot
  libraries. The dedicated commands will force the operation, for
  updates, while the main commands will only run them if the resources
  do not already exist.
- Factored part of the command into one that handles building the .scm
  file, which can then be consumed by running it or compiling it to a
  dedicated binary.
- Added a run-via-scheme command, because that is actually easier to
  accomplish via a shell call. The compile command is stubbed out until
  I can figure out the right sequence of commands to successfully build
  a standalone file.
---
 unison-cli/package.yaml                       |   1 +
 .../src/Unison/Codebase/Editor/HandleInput.hs | 142 +++++++++++++++---
 .../src/Unison/Codebase/Editor/Input.hs       |   6 +
 .../src/Unison/CommandLine/InputPatterns.hs   |  70 ++++++++-
 unison-cli/unison-cli.cabal                   |   3 +
 5 files changed, 202 insertions(+), 20 deletions(-)

diff --git a/unison-cli/package.yaml b/unison-cli/package.yaml
index cbe1d6868..cf55d3924 100644
--- a/unison-cli/package.yaml
+++ b/unison-cli/package.yaml
@@ -53,6 +53,7 @@ dependencies:
   - nonempty-containers
   - open-browser
   - pretty-simple
+  - process
   - random >= 1.2.0
   - regex-tdfa
   - semialign
diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs
index ebaa92539..872a27f5d 100644
--- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs
+++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs
@@ -28,7 +28,16 @@ import qualified Data.Text as Text
 import Data.Time (UTCTime)
 import Data.Tuple.Extra (uncurry3)
 import qualified System.Console.Regions as Console.Regions
+import System.Cmd (system)
 import System.Environment (withArgs)
+import System.Exit (ExitCode(..))
+import System.Directory
+  ( createDirectoryIfMissing,
+    doesFileExist,
+    XdgDirectory(..),
+    getXdgDirectory,
+  )
+import System.FilePath ((</>))
 import qualified Text.Megaparsec as P
 import U.Codebase.HashTags (CausalHash (..))
 import qualified U.Codebase.Reflog as Reflog
@@ -1181,6 +1190,9 @@ loop e = do
               whenJustM (liftIO (Runtime.compileTo runtime codeLookup ppe ref (output <> ".uc"))) \err ->
                 Cli.returnEarly (EvaluationFailure err)
             CompileSchemeI output main -> doCompileScheme output main
+            ExecuteSchemeI main -> doRunAsScheme main
+            GenSchemeLibsI -> doGenerateSchemeBoot True Nothing
+            FetchSchemeCompilerI -> doFetchCompiler
             IOTestI main -> do
               Cli.Env {codebase, runtime} <- ask
               -- todo - allow this to run tests from scratch file, using addRunMain
@@ -2479,6 +2491,13 @@ mergeBranchAndPropagateDefaultPatch mode inputDescription unchangedMessage srcb
           Cli.respondNumbered (ShowDiffAfterMerge dest0 dest ppe diff)
         pure b
 
+basicPPE :: Cli PPE.PrettyPrintEnv
+basicPPE = do
+  parseNames <- 
+    flip NamesWithHistory.NamesWithHistory mempty
+      <$> basicParseNames
+  suffixifiedPPE parseNames
+
 compilerPath :: Path.Path'
 compilerPath = Path.Path' { Path.unPath' = Left abs }
   where
@@ -2512,25 +2531,58 @@ doFetchCompiler =
       Input.PullWithoutHistory
       Verbosity.Silent
 
-doCompileScheme :: String -> HQ.HashQualified Name -> Cli ()
-doCompileScheme (Text.pack -> output) main = do
+ensureCompilerExists :: Cli ()
+ensureCompilerExists =
+  Cli.branchExistsAtPath' compilerPath >>=
+    flip unless doFetchCompiler
+
+getCacheDir :: Cli String
+getCacheDir = liftIO $ getXdgDirectory XdgCache "unisonlanguage"
+
+getSchemeGenLibDir :: Cli String
+getSchemeGenLibDir = Cli.getConfig "SchemeLibs.Generated" >>= \case
+  Just dir -> pure dir
+  Nothing -> (</> "scheme-libs") <$> getCacheDir
+
+getSchemeStaticLibDir :: Cli String
+getSchemeStaticLibDir = Cli.getConfig "SchemeLibs.Static" >>= \case
+  Just dir -> pure dir
+  Nothing -> liftIO $
+    getXdgDirectory XdgData ("unisonlanguage" </> "scheme-libs")
+
+doGenerateSchemeBoot :: Bool -> Maybe PPE.PrettyPrintEnv -> Cli ()
+doGenerateSchemeBoot force mppe = do
+  ppe <- maybe basicPPE pure mppe
   Cli.Env {codebase, runtime} <- ask
-  haveCompiler <- Cli.branchExistsAtPath' compilerPath
-  when (not haveCompiler) doFetchCompiler
-  (comp, ppe) <- resolveMainRef main
-  -- Term.termLink rf
-  sscm <- Term.ref a <$> resolveTermRef saveNm
-  fprf <- resolveCon filePathNm
-  let toCmp = Term.termLink a (Referent.Ref comp)
-      outTm = Term.text a (output <> ".scm")
-      fpc = Term.constructor a fprf
-      fp = Term.app a fpc outTm
-      mty = Runtime.mainType runtime
-      tm :: Term Symbol Ann
-      tm = Term.apps' sscm [toCmp, fp]
-      rendered = P.toPlainUnbroken $ TP.pretty ppe tm
-  tcRes <- typecheckTerm (Term.delay a tm)
-  case tcRes of
+  dir <- getSchemeGenLibDir
+  let bootf = dir </> "unison" </> "boot-generated.ss"
+      binf = dir </> "unison" </> "builtin-generated.ss"
+      dirTm = Term.text a (Text.pack dir)
+  liftIO $ createDirectoryIfMissing True dir
+  saveBase <- Term.ref a <$> resolveTermRef sbName
+  gen ppe saveBase bootf dirTm bootName
+  gen ppe saveBase binf dirTm builtinName
+  where
+  a = External
+  hq nm
+    | Just hqn <- HQ.fromString nm = hqn
+    | otherwise = error $ "internal error: cannot hash qualify: " ++ nm
+
+  sbName = hq ".unison.internal.compiler.scheme.saveBaseFile"
+  bootName = hq ".unison.internal.compiler.scheme.bootSpec"
+  builtinName = hq ".unison.internal.compiler.scheme.builtinSpec"
+
+  gen ppe save file dir nm =
+    liftIO (doesFileExist file) >>= \b -> when (not b || force) do
+      spec <- Term.ref a <$> resolveTermRef nm
+      let make = Term.apps' save [dir, spec]
+      typecheckAndEval ppe make
+
+typecheckAndEval :: PPE.PrettyPrintEnv -> Term Symbol Ann -> Cli ()
+typecheckAndEval ppe tm = do
+  Cli.Env {runtime} <- ask
+  let mty = Runtime.mainType runtime
+  typecheckTerm (Term.delay a tm) >>= \case
     -- Type checking succeeded
     Result.Result _ (Just ty)
       | Typechecker.fitsScheme ty mty ->
@@ -2540,7 +2592,59 @@ doCompileScheme (Text.pack -> output) main = do
     Result.Result notes Nothing -> do
       currentPath <- Cli.getCurrentPath
       let tes = [ err | Result.TypeError err <- toList notes ]
-      Cli.respond (TypeErrors currentPath (Text.pack rendered) ppe tes)
+      Cli.returnEarly (TypeErrors currentPath (Text.pack rendered) ppe tes)
+  where
+  a = External
+  rendered = P.toPlainUnbroken $ TP.pretty ppe tm
+
+runScheme :: String -> Cli ()
+runScheme file = do
+  gendir <- getSchemeGenLibDir
+  statdir <- getSchemeStaticLibDir
+  let includes = gendir ++ ":" ++ statdir
+      lib = "--libdirs " ++ includes
+      opt = "--optimize-level 3"
+      cmd = "scheme -q " ++ opt ++ " " ++ lib ++ " --script " ++ file
+  liftIO (system cmd) >>= \case
+    ExitSuccess -> pure ()
+    ExitFailure _ ->
+      Cli.returnEarly (PrintMessage "Scheme evaluation failed.")
+
+buildScheme :: String -> Cli ()
+buildScheme file = do
+  -- todo
+  Cli.returnEarly (PrintMessage "standalone scheme binary not yet implemented")
+
+doRunAsScheme :: HQ.HashQualified Name -> Cli ()
+doRunAsScheme main = do
+  fullpath <- generateSchemeFile (HQ.toString main) main
+  runScheme fullpath
+
+doCompileScheme :: String -> HQ.HashQualified Name -> Cli ()
+doCompileScheme out main =
+  generateSchemeFile out main >>= buildScheme
+
+generateSchemeFile :: String -> HQ.HashQualified Name -> Cli String
+generateSchemeFile out main = do
+  (comp, ppe) <- resolveMainRef main
+  ensureCompilerExists
+  Cli.Env {codebase} <- ask
+  doGenerateSchemeBoot False $ Just ppe
+  cacheDir <- getCacheDir
+  liftIO $ createDirectoryIfMissing True (cacheDir </> "scheme-tmp")
+  let scratch = out ++ ".scm"
+      fullpath = cacheDir </> "scheme-tmp" </> scratch
+      output = Text.pack fullpath
+  sscm <- Term.ref a <$> resolveTermRef saveNm
+  fprf <- resolveCon filePathNm
+  let toCmp = Term.termLink a (Referent.Ref comp)
+      outTm = Term.text a output
+      fpc = Term.constructor a fprf
+      fp = Term.app a fpc outTm
+      tm :: Term Symbol Ann
+      tm = Term.apps' sscm [toCmp, fp]
+  typecheckAndEval ppe tm
+  pure fullpath
   where
   a = External
   hq nm
diff --git a/unison-cli/src/Unison/Codebase/Editor/Input.hs b/unison-cli/src/Unison/Codebase/Editor/Input.hs
index 1a2673eaa..3183d109b 100644
--- a/unison-cli/src/Unison/Codebase/Editor/Input.hs
+++ b/unison-cli/src/Unison/Codebase/Editor/Input.hs
@@ -150,8 +150,14 @@ data Input
     IOTestI (HQ.HashQualified Name)
   | -- make a standalone binary file
     MakeStandaloneI String (HQ.HashQualified Name)
+  | -- execute an IO thunk using scheme
+    ExecuteSchemeI (HQ.HashQualified Name)
   | -- compile to a scheme file
     CompileSchemeI String (HQ.HashQualified Name)
+  | -- generate scheme libraries
+    GenSchemeLibsI
+  | -- fetch scheme compiler
+    FetchSchemeCompilerI
   | TestI TestInput
   | -- metadata
     -- `link metadata definitions` (adds metadata to all of `definitions`)
diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs
index c4c12b7ce..19fea82da 100644
--- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs
+++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs
@@ -2138,11 +2138,30 @@ makeStandalone =
         _ -> Left $ showPatternHelp makeStandalone
     )
 
+runScheme :: InputPattern
+runScheme =
+  InputPattern
+    "run.scheme"
+    []
+    I.Visible
+    [(Required, exactDefinitionTermQueryArg)]
+    ( P.wrapColumn2
+        [ ( "`run.scheme main`",
+            "Executes !main using compilation to scheme."
+          )
+        ]
+    )
+    ( \case
+        [main] ->
+          Input.ExecuteSchemeI <$> parseHashQualifiedName main
+        _ -> Left $ showPatternHelp runScheme
+    )
+
 compileScheme :: InputPattern
 compileScheme =
   InputPattern
     "compile.scheme"
-    ["compile.scheme"]
+    []
     I.Visible
     [(Required, exactDefinitionTermQueryArg), (Required, noCompletionsArg)]
     ( P.wrapColumn2
@@ -2159,6 +2178,52 @@ compileScheme =
         _ -> Left $ showPatternHelp compileScheme
     )
 
+schemeLibgen :: InputPattern
+schemeLibgen =
+  InputPattern
+    "compile.scheme.genlibs"
+    []
+    I.Visible
+    []
+    ( P.wrapColumn2
+        [ ( "`compile.scheme.genlibs`",
+            "Generates libraries necessary for scheme compilation.\n\n\
+            \There is no need to run this before `compile.scheme`, as\
+            \ the latter will check if the libraries are missing and\
+            \ auto-generate them. However, this will generate the\
+            \ libraries even if their files already exist, so if the\
+            \ compiler has been upgraded, this can be used to ensure\
+            \ the generated libraries are up to date."
+          )
+        ]
+    )
+    ( \case
+        [] -> pure Input.GenSchemeLibsI
+        _ -> Left $ showPatternHelp schemeLibgen
+    )
+
+fetchScheme :: InputPattern
+fetchScheme =
+  InputPattern
+    "compile.scheme.fetch"
+    []
+    I.Visible
+    []
+    ( P.wrapColumn2
+        [ ( "`compile.scheme.fetch`",
+            "Fetches the unison library for compiling to scheme.\n\n\
+            \This is done automatically when `compile.scheme` is run\
+            \ if the library is not already in the standard location\
+            \ (unison.internal). However, this command will force\
+            \ a pull even if the library already exists."
+          )
+        ]
+    )
+    ( \case
+        [] -> pure Input.FetchSchemeCompilerI
+        _ -> Left $ showPatternHelp fetchScheme
+    )
+
 createAuthor :: InputPattern
 createAuthor =
   InputPattern
@@ -2331,7 +2396,10 @@ validInputs =
       quit,
       updateBuiltins,
       makeStandalone,
+      runScheme,
       compileScheme,
+      schemeLibgen,
+      fetchScheme,
       mergeBuiltins,
       mergeIOBuiltins,
       dependents,
diff --git a/unison-cli/unison-cli.cabal b/unison-cli/unison-cli.cabal
index 22a16743a..0a9204805 100644
--- a/unison-cli/unison-cli.cabal
+++ b/unison-cli/unison-cli.cabal
@@ -164,6 +164,7 @@ library
     , nonempty-containers
     , open-browser
     , pretty-simple
+    , process
     , random >=1.2.0
     , regex-tdfa
     , semialign
@@ -522,6 +523,7 @@ executable unison
     , open-browser
     , optparse-applicative >=0.16.1.0
     , pretty-simple
+    , process
     , random >=1.2.0
     , regex-tdfa
     , semialign
@@ -648,6 +650,7 @@ test-suite cli-tests
     , nonempty-containers
     , open-browser
     , pretty-simple
+    , process
     , random >=1.2.0
     , regex-tdfa
     , semialign

From 6587c94c7108d61a8d6e9ad81fe76d0befc4fde8 Mon Sep 17 00:00:00 2001
From: Dan Doel <dan.doel@gmail.com>
Date: Mon, 14 Nov 2022 16:44:28 -0500
Subject: [PATCH 11/41] Implement scheme compilation command

---
 .../src/Unison/Codebase/Editor/HandleInput.hs | 32 ++++++++++++++++---
 1 file changed, 27 insertions(+), 5 deletions(-)

diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs
index 872a27f5d..2db1d3aab 100644
--- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs
+++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs
@@ -29,6 +29,7 @@ import Data.Time (UTCTime)
 import Data.Tuple.Extra (uncurry3)
 import qualified System.Console.Regions as Console.Regions
 import System.Cmd (system)
+import System.Process (shell, readCreateProcess)
 import System.Environment (withArgs)
 import System.Exit (ExitCode(..))
 import System.Directory
@@ -2610,10 +2611,31 @@ runScheme file = do
     ExitFailure _ ->
       Cli.returnEarly (PrintMessage "Scheme evaluation failed.")
 
-buildScheme :: String -> Cli ()
-buildScheme file = do
-  -- todo
-  Cli.returnEarly (PrintMessage "standalone scheme binary not yet implemented")
+buildScheme :: String -> String -> Cli ()
+buildScheme main file = do
+  statDir <- getSchemeStaticLibDir
+  genDir <- getSchemeGenLibDir
+  let cmd = shell "scheme -q --optimize-level 3"
+  liftIO $ putStrLn (build statDir genDir)
+  void . liftIO $ readCreateProcess cmd (build statDir genDir)
+  where
+  surround s = '"' : s ++ "\""
+  parens s = '(' : s ++ ")"
+  lns dir nms = surround . ln dir <$> nms
+  ln dir nm = dir </> "unison" </> (nm ++ ".ss")
+
+  static = ["core", "cont", "bytevector", "string", "primops", "boot"]
+  gen = ["boot-generated", "builtin-generated"]
+
+  bootf = surround $ main ++ ".boot"
+  base = "'(\"scheme\" \"petite\")"
+
+  build sd gd = parens . List.intercalate " " $
+    ["make-boot-file",bootf,base] ++
+    lns sd static ++
+    lns gd gen ++
+    [surround file]
+
 
 doRunAsScheme :: HQ.HashQualified Name -> Cli ()
 doRunAsScheme main = do
@@ -2622,7 +2644,7 @@ doRunAsScheme main = do
 
 doCompileScheme :: String -> HQ.HashQualified Name -> Cli ()
 doCompileScheme out main =
-  generateSchemeFile out main >>= buildScheme
+  generateSchemeFile out main >>= buildScheme out
 
 generateSchemeFile :: String -> HQ.HashQualified Name -> Cli String
 generateSchemeFile out main = do

From e6846c7d5f11238fbee5a5ca29d27768f4454041 Mon Sep 17 00:00:00 2001
From: Dan Doel <dan.doel@gmail.com>
Date: Mon, 14 Nov 2022 17:00:30 -0500
Subject: [PATCH 12/41] Left a debug print in scheme compile.

---
 unison-cli/src/Unison/Codebase/Editor/HandleInput.hs | 1 -
 1 file changed, 1 deletion(-)

diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs
index 2db1d3aab..67dc80674 100644
--- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs
+++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs
@@ -2616,7 +2616,6 @@ buildScheme main file = do
   statDir <- getSchemeStaticLibDir
   genDir <- getSchemeGenLibDir
   let cmd = shell "scheme -q --optimize-level 3"
-  liftIO $ putStrLn (build statDir genDir)
   void . liftIO $ readCreateProcess cmd (build statDir genDir)
   where
   surround s = '"' : s ++ "\""

From 423ad9595f82b4853a91f92739d811e5b656d84d Mon Sep 17 00:00:00 2001
From: Dan Doel <dan.doel@gmail.com>
Date: Wed, 16 Nov 2022 15:41:21 -0500
Subject: [PATCH 13/41] Fix warnings

---
 unison-cli/src/Unison/Cli/TypeCheck.hs        |  4 +---
 .../src/Unison/Codebase/Editor/HandleInput.hs | 23 ++++++++++---------
 .../Editor/HandleInput/TermResolution.hs      |  3 ++-
 3 files changed, 15 insertions(+), 15 deletions(-)

diff --git a/unison-cli/src/Unison/Cli/TypeCheck.hs b/unison-cli/src/Unison/Cli/TypeCheck.hs
index 2dd678bc5..4674de586 100644
--- a/unison-cli/src/Unison/Cli/TypeCheck.hs
+++ b/unison-cli/src/Unison/Cli/TypeCheck.hs
@@ -8,7 +8,6 @@ where
 
 import Control.Monad.Reader (ask)
 import qualified Data.Text as Text
-import qualified Data.Map as Map
 import qualified Unison.Builtin as Builtin
 import Unison.Cli.Monad (Cli)
 import qualified Unison.Cli.Monad as Cli
@@ -81,8 +80,7 @@ typecheckTerm ::
         (Seq (Result.Note Symbol Ann))
         (Type Symbol Ann))
 typecheckTerm tm = do
-  Cli.Env { codebase, generateUniqueName } <- ask
-  un <- liftIO generateUniqueName
+  Cli.Env { codebase } <- ask
   let v = Symbol 0 (Var.Inference Var.Other)
   liftIO $ fmap extract <$>
     Codebase.runTransaction codebase (typecheckFile' codebase [] (UF.UnisonFileId mempty mempty [(v, tm)] mempty))
diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs
index 7ebd129a6..52d5b6e05 100644
--- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs
+++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs
@@ -7,6 +7,7 @@ where
 
 import Control.Concurrent.STM (atomically, modifyTVar', newTVarIO, readTVar, readTVarIO)
 import qualified Control.Error.Util as ErrorUtil
+import Control.Exception (catch)
 import Control.Lens
 import Control.Monad.Reader (ask)
 import Control.Monad.State (StateT)
@@ -28,10 +29,8 @@ import qualified Data.Text as Text
 import Data.Time (UTCTime)
 import Data.Tuple.Extra (uncurry3)
 import qualified System.Console.Regions as Console.Regions
-import System.Cmd (system)
-import System.Process (shell, readCreateProcess)
+import System.Process (shell, readCreateProcess, callCommand)
 import System.Environment (withArgs)
-import System.Exit (ExitCode(..))
 import System.Directory
   ( createDirectoryIfMissing,
     doesFileExist,
@@ -56,8 +55,7 @@ import qualified Unison.Builtin.Terms as Builtin
 import Unison.Cli.Monad (Cli)
 import qualified Unison.Cli.Monad as Cli
 import qualified Unison.Cli.MonadUtils as Cli
-import Unison.Cli.NamesUtils (basicParseNames, basicPrettyPrintNamesA, displayNames, findHistoricalHQs, getBasicPrettyPrintNames, makeHistoricalParsingNames, makePrintNamesFromLabeled', makeShadowedPrintNamesFromHQ)
-import Unison.Cli.TypeCheck (typecheck)
+import Unison.Cli.NamesUtils (basicParseNames, displayNames, findHistoricalHQs, getBasicPrettyPrintNames, makeHistoricalParsingNames, makePrintNamesFromLabeled', makeShadowedPrintNamesFromHQ)
 import Unison.Cli.UnisonConfigUtils (gitUrlKey, remoteMappingKey)
 import Unison.Codebase (Codebase, Preprocessing (..), PushGitBranchOpts (..))
 import qualified Unison.Codebase as Codebase
@@ -1574,6 +1572,10 @@ inputDescription input =
     MergeBuiltinsI -> pure "builtins.merge"
     MergeIOBuiltinsI -> pure "builtins.mergeio"
     MakeStandaloneI out nm -> pure ("compile " <> Text.pack out <> " " <> HQ.toText nm)
+    ExecuteSchemeI nm -> pure ("run.scheme " <> HQ.toText nm)
+    CompileSchemeI fi nm -> pure ("compile.scheme " <> HQ.toText nm <> " " <> Text.pack fi)
+    GenSchemeLibsI -> pure "compile.scheme.genlibs"
+    FetchSchemeCompilerI -> pure "compile.scheme.fetch"
     PullRemoteBranchI orepo dest0 _syncMode pullMode _ -> do
       dest <- p' dest0
       let command =
@@ -2589,7 +2591,6 @@ getSchemeStaticLibDir = Cli.getConfig "SchemeLibs.Static" >>= \case
 doGenerateSchemeBoot :: Bool -> Maybe PPE.PrettyPrintEnv -> Cli ()
 doGenerateSchemeBoot force mppe = do
   ppe <- maybe basicPPE pure mppe
-  Cli.Env {codebase, runtime} <- ask
   dir <- getSchemeGenLibDir
   let bootf = dir </> "unison" </> "boot-generated.ss"
       binf = dir </> "unison" </> "builtin-generated.ss"
@@ -2641,10 +2642,11 @@ runScheme file = do
       lib = "--libdirs " ++ includes
       opt = "--optimize-level 3"
       cmd = "scheme -q " ++ opt ++ " " ++ lib ++ " --script " ++ file
-  liftIO (system cmd) >>= \case
-    ExitSuccess -> pure ()
-    ExitFailure _ ->
-      Cli.returnEarly (PrintMessage "Scheme evaluation failed.")
+  success <-
+    liftIO $ (True <$ callCommand cmd) `catch` \(_ :: IOException) ->
+      pure False
+  unless success $
+    Cli.returnEarly (PrintMessage "Scheme evaluation failed.")
 
 buildScheme :: String -> String -> Cli ()
 buildScheme main file = do
@@ -2684,7 +2686,6 @@ generateSchemeFile :: String -> HQ.HashQualified Name -> Cli String
 generateSchemeFile out main = do
   (comp, ppe) <- resolveMainRef main
   ensureCompilerExists
-  Cli.Env {codebase} <- ask
   doGenerateSchemeBoot False $ Just ppe
   cacheDir <- getCacheDir
   liftIO $ createDirectoryIfMissing True (cacheDir </> "scheme-tmp")
diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/TermResolution.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/TermResolution.hs
index f4f5036c8..bf3b6f374 100644
--- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/TermResolution.hs
+++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/TermResolution.hs
@@ -3,11 +3,11 @@ module Unison.Codebase.Editor.HandleInput.TermResolution
   ( lookupTermRefs
   , lookupTermRefWithType
   , resolveCon
+  , resolveTerm
   , resolveTermRef
   , resolveMainRef
   ) where
 
-import Control.Lens ((<&>))
 import Control.Monad.Trans (liftIO)
 import Control.Monad.Reader (ask)
 import Data.Maybe (catMaybes, fromJust)
@@ -35,6 +35,7 @@ import qualified Unison.Cli.Monad as Cli
 import Unison.Symbol (Symbol)
 import Unison.Type (Type)
 
+addHistory :: Names -> NamesWithHistory
 addHistory names = NamesWithHistory names mempty
 
 lookupTerm :: HQ.HashQualified Name -> Names -> [Referent]

From 2437ae8f87e8ffa9a4d1b435583301f7c05eced9 Mon Sep 17 00:00:00 2001
From: Dan Doel <dan.doel@gmail.com>
Date: Wed, 16 Nov 2022 17:01:13 -0500
Subject: [PATCH 14/41] Eliminate commented code

---
 .../src/Unison/Codebase/Editor/HandleInput.hs | 20 -------------------
 1 file changed, 20 deletions(-)

diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs
index 52d5b6e05..6f77ec911 100644
--- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs
+++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs
@@ -1443,26 +1443,6 @@ loop e = do
 magicMainWatcherString :: String
 magicMainWatcherString = "main"
 
--- resolveMain
---   :: HQ.HashQualified Name -> Cli (Reference, PPE.PrettyPrintEnv)
--- resolveMain main = do
---   Cli.Env {codebase, runtime} <- ask
---   let mainType = Runtime.mainType runtime
---   parseNames <-
---     flip NamesWithHistory.NamesWithHistory mempty
---       <$> basicPrettyPrintNamesA
---   ppe <- suffixifiedPPE parseNames
---   let resolved = toList $ NamesWithHistory.lookupHQTerm main parseNames
---       smain = HQ.toString main
---   filtered <-
---     catMaybes
---       <$> traverse (\r -> fmap (r,) <$> liftIO (loadTypeOfTerm codebase r)) resolved
---   case filtered of
---     [(Referent.Ref ref, ty)]
---       | Typechecker.fitsScheme ty mainType -> pure (ref, ppe)
---       | otherwise -> Cli.returnEarly (BadMainFunction smain ty ppe [mainType])
---     _ -> Cli.returnEarly (NoMainFunction smain ppe [mainType])
-
 inputDescription :: Input -> Cli Text
 inputDescription input =
   case input of

From a95acf075c9f88d19c3f1ed8e33bd97b5ec42c6a Mon Sep 17 00:00:00 2001
From: Travis Staton <hello@travisstaton.com>
Date: Thu, 17 Nov 2022 09:19:02 -0500
Subject: [PATCH 15/41] remove unnecessary call to Metadata.delete in
 `replaceTerm`

`replaceTerm` is bound to `apply` in `Star3.replaceFacts` which
supplies the `Star3` after first replacing all occurrences of `r` with
`r'` (see `replaceFact`)

So, there are no relations with a lhs of `r` in the `Star3`, and the
metadata delete will not have an effect.
---
 unison-cli/src/Unison/Codebase/Editor/Propagate.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/unison-cli/src/Unison/Codebase/Editor/Propagate.hs b/unison-cli/src/Unison/Codebase/Editor/Propagate.hs
index 735bb96d2..9d26853b7 100644
--- a/unison-cli/src/Unison/Codebase/Editor/Propagate.hs
+++ b/unison-cli/src/Unison/Codebase/Editor/Propagate.hs
@@ -650,9 +650,9 @@ applyPropagate patch Edits {..} = do
             typeOf r t = fromMaybe t $ Map.lookup r termTypes
 
         replaceTerm :: Referent -> Referent -> Metadata.Star Referent NameSegment -> Metadata.Star Referent NameSegment
-        replaceTerm r r' s =
+        replaceTerm _r r' s =
           ( if isPropagatedReferent r'
-              then Metadata.insert (propagatedMd r') . Metadata.delete (propagatedMd r)
+              then Metadata.insert (propagatedMd r')
               else Metadata.delete (propagatedMd r')
           )
             $ s

From 28ad7ffe485477d11f4643efb3326043c0ebc495 Mon Sep 17 00:00:00 2001
From: Travis Staton <hello@travisstaton.com>
Date: Thu, 17 Nov 2022 09:27:16 -0500
Subject: [PATCH 16/41] remove `clearPropagated` from `updateMetadatas`

The call to clearPropagated appears to be unnecessary: replaceFacts
traverses the intersection of the domain of (term/type)Edits and the
corresponding metadata Star3 and properly assigns the propagated
metadata values (see replaceTerms/replaceTypes). So, clearPropagated
would only have an effect if it corrected metadata for references not
in this intersection. If a reference is not in the Star3 then there is
nothing to correct. If a reference is in the Star3 but not in the
domain of termEdits then it would be erroneous to label it as not
propagated.

For example:

Suppose a codebase has only one term, B, that has the propagated
metadata. We apply a patch with the mapping A -> B. Star3.replaceFacts
has no effect since A is not in the codebase. The call to
`clearPropagated` will remove the propagated metadata from B
though. This doesn't seem correct though, B wasn't introduced by the
patch or a direct edit by the user.
---
 unison-cli/src/Unison/Codebase/Editor/Propagate.hs | 10 +++-------
 1 file changed, 3 insertions(+), 7 deletions(-)

diff --git a/unison-cli/src/Unison/Codebase/Editor/Propagate.hs b/unison-cli/src/Unison/Codebase/Editor/Propagate.hs
index 9d26853b7..c93bf0165 100644
--- a/unison-cli/src/Unison/Codebase/Editor/Propagate.hs
+++ b/unison-cli/src/Unison/Codebase/Editor/Propagate.hs
@@ -627,23 +627,19 @@ applyPropagate patch Edits {..} = do
         terms0 = Star3.replaceFacts replaceConstructor constructorReplacements _terms
         terms :: Branch.Star Referent NameSegment
         terms =
-          updateMetadatas Referent.Ref $
+          updateMetadatas $
             Star3.replaceFacts replaceTerm termEdits terms0
         types :: Branch.Star Reference NameSegment
         types =
-          updateMetadatas id $
+          updateMetadatas $
             Star3.replaceFacts replaceType typeEdits _types
 
         updateMetadatas ::
           Ord r =>
-          (Reference -> r) ->
           Star3.Star3 r NameSegment Metadata.Type (Metadata.Type, Metadata.Value) ->
           Star3.Star3 r NameSegment Metadata.Type (Metadata.Type, Metadata.Value)
-        updateMetadatas ref s = clearPropagated $ Star3.mapD3 go s
+        updateMetadatas s = Star3.mapD3 go s
           where
-            clearPropagated s = foldl' go s allPatchTargets
-              where
-                go s r = Metadata.delete (propagatedMd $ ref r) s
             go (tp, v) = case Map.lookup (Referent.Ref v) termEdits of
               Just (Referent.Ref r) -> (typeOf r tp, r)
               _ -> (tp, v)

From 683d07c855c6619d494d929326e542177167df0b Mon Sep 17 00:00:00 2001
From: Travis Staton <hello@travisstaton.com>
Date: Thu, 17 Nov 2022 09:36:25 -0500
Subject: [PATCH 17/41] Don't use record wildcards in applyPropagate

---
 unison-cli/src/Unison/Codebase/Editor/Propagate.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/unison-cli/src/Unison/Codebase/Editor/Propagate.hs b/unison-cli/src/Unison/Codebase/Editor/Propagate.hs
index c93bf0165..781b35eda 100644
--- a/unison-cli/src/Unison/Codebase/Editor/Propagate.hs
+++ b/unison-cli/src/Unison/Codebase/Editor/Propagate.hs
@@ -601,7 +601,7 @@ applyDeprecations patch =
 -- definition that is created by the `Edits` which is passed in is marked as
 -- a propagated change.
 applyPropagate :: Applicative m => Patch -> Edits Symbol -> Branch0 m -> Branch0 m
-applyPropagate patch Edits {..} = do
+applyPropagate patch Edits {newTerms, termReplacements, typeReplacements, constructorReplacements} = do
   let termTypes = Map.map (Hashing.typeToReference . snd) newTerms
   -- recursively update names and delete deprecated definitions
   Branch.stepEverywhere (updateLevel termReplacements typeReplacements termTypes)

From cdd917c01d5d8e57a14dba04d6c2bbb148e245fb Mon Sep 17 00:00:00 2001
From: Dan Doel <dan.doel@gmail.com>
Date: Thu, 17 Nov 2022 12:28:25 -0500
Subject: [PATCH 18/41] Fix up naming

---
 .../src/Unison/Codebase/Editor/HandleInput.hs |  8 +++----
 .../src/Unison/CommandLine/InputPatterns.hs   | 24 ++++++++++---------
 2 files changed, 17 insertions(+), 15 deletions(-)

diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs
index 6f77ec911..4bd6a55a6 100644
--- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs
+++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs
@@ -1552,10 +1552,10 @@ inputDescription input =
     MergeBuiltinsI -> pure "builtins.merge"
     MergeIOBuiltinsI -> pure "builtins.mergeio"
     MakeStandaloneI out nm -> pure ("compile " <> Text.pack out <> " " <> HQ.toText nm)
-    ExecuteSchemeI nm -> pure ("run.scheme " <> HQ.toText nm)
-    CompileSchemeI fi nm -> pure ("compile.scheme " <> HQ.toText nm <> " " <> Text.pack fi)
-    GenSchemeLibsI -> pure "compile.scheme.genlibs"
-    FetchSchemeCompilerI -> pure "compile.scheme.fetch"
+    ExecuteSchemeI nm -> pure ("run.native " <> HQ.toText nm)
+    CompileSchemeI fi nm -> pure ("compile.native " <> HQ.toText nm <> " " <> Text.pack fi)
+    GenSchemeLibsI -> pure "compile.native.genlibs"
+    FetchSchemeCompilerI -> pure "compile.native.fetch"
     PullRemoteBranchI orepo dest0 _syncMode pullMode _ -> do
       dest <- p' dest0
       let command =
diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs
index 5868bb392..e8760505f 100644
--- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs
+++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs
@@ -2119,13 +2119,13 @@ makeStandalone =
 runScheme :: InputPattern
 runScheme =
   InputPattern
-    "run.scheme"
+    "run.native"
     []
     I.Visible
     [(Required, exactDefinitionTermQueryArg)]
     ( P.wrapColumn2
-        [ ( "`run.scheme main`",
-            "Executes !main using compilation to scheme."
+        [ ( makeExample runScheme ["main"],
+            "Executes !main using native compilation via scheme."
           )
         ]
     )
@@ -2138,12 +2138,12 @@ runScheme =
 compileScheme :: InputPattern
 compileScheme =
   InputPattern
-    "compile.scheme"
+    "compile.native"
     []
     I.Visible
     [(Required, exactDefinitionTermQueryArg), (Required, noCompletionsArg)]
     ( P.wrapColumn2
-        [ ( "`compile.scheme main file`",
+        [ ( makeExample compileScheme ["main", "file"],
             "Creates stand alone executable via compilation to"
               <> "scheme. The created executable will have the effect"
               <> "of running `!main`."
@@ -2159,14 +2159,15 @@ compileScheme =
 schemeLibgen :: InputPattern
 schemeLibgen =
   InputPattern
-    "compile.scheme.genlibs"
+    "compile.native.genlibs"
     []
     I.Visible
     []
     ( P.wrapColumn2
-        [ ( "`compile.scheme.genlibs`",
+        [ ( makeExample schemeLibgen [],
             "Generates libraries necessary for scheme compilation.\n\n\
-            \There is no need to run this before `compile.scheme`, as\
+            \There is no need to run this before" <>
+            P.group (makeExample compileScheme []) <> "as\
             \ the latter will check if the libraries are missing and\
             \ auto-generate them. However, this will generate the\
             \ libraries even if their files already exist, so if the\
@@ -2183,14 +2184,15 @@ schemeLibgen =
 fetchScheme :: InputPattern
 fetchScheme =
   InputPattern
-    "compile.scheme.fetch"
+    "compile.native.fetch"
     []
     I.Visible
     []
     ( P.wrapColumn2
-        [ ( "`compile.scheme.fetch`",
+        [ ( makeExample fetchScheme [],
             "Fetches the unison library for compiling to scheme.\n\n\
-            \This is done automatically when `compile.scheme` is run\
+            \This is done automatically when" <>
+            P.group (makeExample compileScheme []) <> "is run\
             \ if the library is not already in the standard location\
             \ (unison.internal). However, this command will force\
             \ a pull even if the library already exists."

From 8902fb6dd5ace16034609780001dc909aabfee32 Mon Sep 17 00:00:00 2001
From: Travis Staton <hello@travisstaton.com>
Date: Thu, 17 Nov 2022 17:20:55 -0500
Subject: [PATCH 19/41] Make ucm use multiple capabilities by default

fixes #3614
---
 unison-cli/package.yaml     | 4 ++--
 unison-cli/unison-cli.cabal | 4 ++--
 2 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/unison-cli/package.yaml b/unison-cli/package.yaml
index 4c13157b4..20129b134 100644
--- a/unison-cli/package.yaml
+++ b/unison-cli/package.yaml
@@ -117,7 +117,7 @@ executables:
         other-modules: Paths_unison_cli
     source-dirs: unison
     main: Main.hs
-    ghc-options: -threaded -rtsopts -with-rtsopts=-I0 -optP-Wno-nonportable-include-path
+    ghc-options: -threaded -rtsopts "-with-rtsopts=-I0 -N -qn4 -qg1" -optP-Wno-nonportable-include-path
     dependencies:
       - code-page
       - optparse-applicative >= 0.16.1.0
@@ -132,7 +132,7 @@ executables:
         other-modules: Paths_unison_cli
     source-dirs: transcripts
     main: Transcripts.hs
-    ghc-options: -threaded -rtsopts -with-rtsopts=-N -v0
+    ghc-options: -threaded -rtsopts "-with-rtsopts=-I0 -N -qn4 -qg1" -v0
     dependencies:
       - code-page
       - easytest
diff --git a/unison-cli/unison-cli.cabal b/unison-cli/unison-cli.cabal
index 401f275de..1fb6c34c4 100644
--- a/unison-cli/unison-cli.cabal
+++ b/unison-cli/unison-cli.cabal
@@ -360,7 +360,7 @@ executable transcripts
       TupleSections
       TypeApplications
       ViewPatterns
-  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -v0
+  ghc-options: -Wall -threaded -rtsopts "-with-rtsopts=-I0 -N -qn4 -qg1" -v0
   build-depends:
       IntervalMap
     , ListLike
@@ -483,7 +483,7 @@ executable unison
       TupleSections
       TypeApplications
       ViewPatterns
-  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-I0 -optP-Wno-nonportable-include-path
+  ghc-options: -Wall -threaded -rtsopts "-with-rtsopts=-I0 -N -qn4 -qg1" -optP-Wno-nonportable-include-path
   build-depends:
       IntervalMap
     , ListLike

From b692b0cf53784fa671a09b939d05f0c2a8f73b4d Mon Sep 17 00:00:00 2001
From: Paul Chiusano <paul.chiusano@gmail.com>
Date: Fri, 18 Nov 2022 08:44:01 -0600
Subject: [PATCH 20/41] Mention glob patterns in help for `view`

---
 unison-cli/src/Unison/CommandLine/InputPatterns.hs | 9 +++++++--
 1 file changed, 7 insertions(+), 2 deletions(-)

diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs
index 324a009dd..3e68200c1 100644
--- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs
+++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs
@@ -332,8 +332,13 @@ view =
     I.Visible
     [(ZeroPlus, definitionQueryArg)]
     ( P.lines
-        [ "`view foo` prints definitions named `foo` within your current namespace.",
-          "`view` without arguments invokes a search to select definitions to view, which requires that `fzf` can be found within your PATH."
+        [ P.wrap $ makeExample view ["foo"] <> "shows definitions named `foo` within your current namespace.",
+          P.wrap $ makeExample view [] <> "without arguments invokes a search to select definitions to view, which requires that `fzf` can be found within your PATH.",
+          P.wrap $
+            "Supports glob syntax, where ? acts a wildcard, so"
+              <> makeExample view ["List.?"]
+              <> "will show `List.map`, `List.filter`, etc, but "
+              <> "not `List.map.doc` (since ? only matches 1 name segment)."
         ]
     )
     ( fmap (Input.ShowDefinitionI Input.ConsoleLocation Input.ShowDefinitionLocal)

From 4726fcb0324cc3ac056a0c76a054b6d322d73921 Mon Sep 17 00:00:00 2001
From: Paul Chiusano <paul.chiusano@gmail.com>
Date: Fri, 18 Nov 2022 08:54:10 -0600
Subject: [PATCH 21/41] adding blankline, though there seems to be a
 pretty-printing bug that skips it

---
 unison-cli/src/Unison/CommandLine/InputPatterns.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs
index 3e68200c1..2437f8aa7 100644
--- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs
+++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs
@@ -334,6 +334,7 @@ view =
     ( P.lines
         [ P.wrap $ makeExample view ["foo"] <> "shows definitions named `foo` within your current namespace.",
           P.wrap $ makeExample view [] <> "without arguments invokes a search to select definitions to view, which requires that `fzf` can be found within your PATH.",
+          " ", -- hmm, this blankline seems to be ignored by pretty printer
           P.wrap $
             "Supports glob syntax, where ? acts a wildcard, so"
               <> makeExample view ["List.?"]

From f914fc680b4770008dba12b5c537ec6127e85b3b Mon Sep 17 00:00:00 2001
From: Travis Staton <hello@travisstaton.com>
Date: Thu, 17 Nov 2022 13:37:45 -0500
Subject: [PATCH 22/41] Fix codebase root branch cache bugs

- Do not allow concurrent fetches of the root branch
- Update the root branch correctly
---
 .../src/Unison/Codebase/RootBranchCache.hs    | 110 ++++++++++++++++++
 .../src/Unison/Codebase/SqliteCodebase.hs     |  46 +++++---
 .../Codebase/SqliteCodebase/Operations.hs     |  38 +-----
 .../unison-parser-typechecker.cabal           |   1 +
 4 files changed, 145 insertions(+), 50 deletions(-)
 create mode 100644 parser-typechecker/src/Unison/Codebase/RootBranchCache.hs

diff --git a/parser-typechecker/src/Unison/Codebase/RootBranchCache.hs b/parser-typechecker/src/Unison/Codebase/RootBranchCache.hs
new file mode 100644
index 000000000..6fed979dc
--- /dev/null
+++ b/parser-typechecker/src/Unison/Codebase/RootBranchCache.hs
@@ -0,0 +1,110 @@
+module Unison.Codebase.RootBranchCache
+  ( RootBranchCache,
+    newEmptyRootBranchCache,
+    newEmptyRootBranchCacheIO,
+    fetchRootBranch,
+    withLock,
+  )
+where
+
+import Control.Concurrent.STM (newTVarIO)
+import Control.Monad (join)
+import Control.Monad.IO.Class
+import Data.Coerce (coerce)
+import Unison.Codebase.Branch.Type (Branch)
+import qualified Unison.Sqlite as Sqlite
+import UnliftIO (MonadUnliftIO, mask, onException)
+import UnliftIO.STM
+  ( STM,
+    TVar,
+    atomically,
+    newTVar,
+    readTVar,
+    retrySTM,
+    writeTVar,
+  )
+
+data RootBranchCacheVal
+  = Empty
+  | -- | Another thread is updating the cache. If this value is observed
+    -- then the reader should wait until the value is Empty or Full. The
+    -- api exposed from this module guarantees that a thread cannot exit
+    -- and leave the cache in this state.
+    ConcurrentModification
+  | Full (Branch Sqlite.Transaction)
+
+-- This is isomorphic to @TMVar (Maybe (Branch Sqlite.Transaction))@
+newtype RootBranchCache = RootBranchCache (TVar RootBranchCacheVal)
+
+newEmptyRootBranchCacheIO :: MonadIO m => m RootBranchCache
+newEmptyRootBranchCacheIO = liftIO (coerce $ newTVarIO Empty)
+
+newEmptyRootBranchCache :: STM RootBranchCache
+newEmptyRootBranchCache = coerce (newTVar Empty)
+
+readRbc :: RootBranchCache -> STM RootBranchCacheVal
+readRbc (RootBranchCache v) = readTVar v
+
+writeRbc :: RootBranchCache -> RootBranchCacheVal -> STM ()
+writeRbc (RootBranchCache v) x = writeTVar v x
+
+-- | Read the root branch cache, wait if the cache is currently being
+-- updated
+readRootBranchCache :: RootBranchCache -> STM (Maybe (Branch Sqlite.Transaction))
+readRootBranchCache v =
+  readRbc v >>= \case
+    Empty -> pure Nothing
+    ConcurrentModification -> retrySTM
+    Full x -> pure (Just x)
+
+fetchRootBranch :: forall m. MonadUnliftIO m => RootBranchCache -> m (Branch Sqlite.Transaction) -> m (Branch Sqlite.Transaction)
+fetchRootBranch rbc getFromDb = mask \restore -> do
+  join (atomically (fetch restore))
+  where
+    fetch :: (forall x. m x -> m x) -> STM (m (Branch Sqlite.Transaction))
+    fetch restore = do
+      readRbc rbc >>= \case
+        Empty -> do
+          writeRbc rbc ConcurrentModification
+          pure do
+            rootBranch <- restore getFromDb `onException` atomically (writeRbc rbc Empty)
+            atomically (writeRbc rbc (Full rootBranch))
+            pure rootBranch
+        ConcurrentModification -> retrySTM
+        Full x -> pure (pure x)
+
+-- | Take a cache lock so that no other thread can read or write to
+-- the cache, perform an action with the cached value, then restore
+-- the cache to Empty or Full
+withLock ::
+  forall m r.
+  MonadUnliftIO m =>
+  RootBranchCache ->
+  -- | Perform an action with the cached value
+  ( -- restore masking state
+    (forall x. m x -> m x) ->
+    -- value retrieved from cache
+    Maybe (Branch Sqlite.Transaction) ->
+    m r
+  ) ->
+  -- | compute value to restore to the cache
+  (r -> Maybe (Branch Sqlite.Transaction)) ->
+  m r
+withLock v f g = mask \restore -> do
+  mbranch <- atomically (takeLock v)
+  r <- f restore mbranch `onException` releaseLock mbranch
+  releaseLock (g r)
+  pure r
+  where
+    releaseLock :: Maybe (Branch Sqlite.Transaction) -> m ()
+    releaseLock mbranch =
+      let !val = case mbranch of
+            Nothing -> Empty
+            Just x -> Full x
+       in atomically (writeRbc v val)
+
+takeLock :: RootBranchCache -> STM (Maybe (Branch Sqlite.Transaction))
+takeLock v = do
+  res <- readRootBranchCache v
+  writeRbc v ConcurrentModification
+  pure res
diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs
index 8a74577df..cf6bb1bff 100644
--- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs
+++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs
@@ -54,6 +54,7 @@ import qualified Unison.Codebase.Init.CreateCodebaseError as Codebase1
 import Unison.Codebase.Init.OpenCodebaseError (OpenCodebaseError (..))
 import qualified Unison.Codebase.Init.OpenCodebaseError as Codebase1
 import Unison.Codebase.Path (Path)
+import Unison.Codebase.RootBranchCache
 import Unison.Codebase.SqliteCodebase.Branch.Cache (newBranchCache)
 import qualified Unison.Codebase.SqliteCodebase.Branch.Dependencies as BD
 import qualified Unison.Codebase.SqliteCodebase.Conversions as Cv
@@ -191,7 +192,7 @@ sqliteCodebase ::
   (Codebase m Symbol Ann -> m r) ->
   m (Either Codebase1.OpenCodebaseError r)
 sqliteCodebase debugName root localOrRemote migrationStrategy action = do
-  rootBranchCache <- newTVarIO Nothing
+  rootBranchCache <- newEmptyRootBranchCacheIO
   branchCache <- newBranchCache
   getDeclType <- CodebaseOps.makeCachedTransaction 2048 CodebaseOps.getDeclType
   -- The v1 codebase interface has operations to read and write individual definitions
@@ -268,21 +269,36 @@ sqliteCodebase debugName root localOrRemote migrationStrategy action = do
             getShallowCausalForHash bh =
               V2Branch.hoistCausalBranch runTransaction <$> runTransaction (Ops.expectCausalBranchByCausalHash bh)
 
-            getRootBranch :: TVar (Maybe (Sqlite.DataVersion, Branch Sqlite.Transaction)) -> m (Branch m)
-            getRootBranch rootBranchCache =
-              Branch.transform runTransaction <$> runTransaction (CodebaseOps.getRootBranch branchCache getDeclType rootBranchCache)
+            getRootBranch :: m (Branch m)
+            getRootBranch =
+              Branch.transform runTransaction
+                <$> fetchRootBranch
+                  rootBranchCache
+                  (runTransaction (CodebaseOps.uncachedLoadRootBranch branchCache getDeclType))
 
-            putRootBranch :: TVar (Maybe (Sqlite.DataVersion, Branch Sqlite.Transaction)) -> Text -> Branch m -> m ()
-            putRootBranch rootBranchCache reason branch1 = do
+            putRootBranch :: Text -> Branch m -> m ()
+            putRootBranch reason branch1 = do
               now <- liftIO getCurrentTime
               withRunInIO \runInIO -> do
-                runInIO do
-                  runTransaction do
-                    let emptyCausalHash = Cv.causalHash1to2 $ Branch.headHash Branch.empty
-                    fromRootCausalHash <- fromMaybe emptyCausalHash <$> Ops.loadRootCausalHash
-                    let toRootCausalHash = Cv.causalHash1to2 $ Branch.headHash branch1
-                    CodebaseOps.putRootBranch rootBranchCache (Branch.transform (Sqlite.unsafeIO . runInIO) branch1)
-                    Ops.appendReflog (Reflog.Entry {time = now, fromRootCausalHash, toRootCausalHash, reason})
+                -- this is naughty, the type says Transaction but it
+                -- won't run automatically with whatever Transaction
+                -- it is composed into unless the enclosing
+                -- Transaction is applied to the same db connection.
+                let branch1Trans = Branch.transform (Sqlite.unsafeIO . runInIO) branch1
+                    putRootBranchTrans :: Sqlite.Transaction () = do
+                      let emptyCausalHash = Cv.causalHash1to2 (Branch.headHash Branch.empty)
+                      fromRootCausalHash <- fromMaybe emptyCausalHash <$> Ops.loadRootCausalHash
+                      let toRootCausalHash = Cv.causalHash1to2 (Branch.headHash branch1)
+                      CodebaseOps.putRootBranch branch1Trans
+                      Ops.appendReflog (Reflog.Entry {time = now, fromRootCausalHash, toRootCausalHash, reason})
+
+                -- We need to update the database and the cached
+                -- value. We want to keep these in sync, so we take
+                -- the cache lock while updating sqlite.
+                withLock
+                  rootBranchCache
+                  (\restore _ -> restore $ runInIO $ runTransaction putRootBranchTrans)
+                  (\_ -> Just branch1Trans)
 
             -- if this blows up on cromulent hashes, then switch from `hashToHashId`
             -- to one that returns Maybe.
@@ -348,8 +364,8 @@ sqliteCodebase debugName root localOrRemote migrationStrategy action = do
                   putTypeDeclaration,
                   putTypeDeclarationComponent,
                   getTermComponentWithTypes,
-                  getRootBranch = getRootBranch rootBranchCache,
-                  putRootBranch = putRootBranch rootBranchCache,
+                  getRootBranch = getRootBranch,
+                  putRootBranch = putRootBranch,
                   getShallowCausalForHash,
                   getBranchForHashImpl = getBranchForHash,
                   putBranch,
diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs
index 4bb1ffd9f..c49d90bb8 100644
--- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs
+++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs
@@ -8,14 +8,13 @@
 module Unison.Codebase.SqliteCodebase.Operations where
 
 import Control.Lens (ifor)
-import Data.Bifunctor (second)
-import Data.Maybe (fromJust)
 import Data.Bitraversable (bitraverse)
 import Data.Either.Extra ()
 import qualified Data.List as List
 import qualified Data.List.NonEmpty as NEList
 import Data.List.NonEmpty.Extra (NonEmpty ((:|)), maximum1)
 import qualified Data.Map as Map
+import Data.Maybe (fromJust)
 import qualified Data.Set as Set
 import qualified Data.Text as Text
 import qualified U.Codebase.Branch as V2Branch
@@ -377,36 +376,6 @@ tryFlushDeclBuffer termBuffer declBuffer =
           h
    in loop
 
-getRootBranch ::
-  -- | A 'getDeclType'-like lookup, possibly backed by a cache.
-  BranchCache Sqlite.Transaction ->
-  (C.Reference.Reference -> Transaction CT.ConstructorType) ->
-  TVar (Maybe (Sqlite.DataVersion, Branch Transaction)) ->
-  Transaction (Branch Transaction)
-getRootBranch branchCache doGetDeclType rootBranchCache =
-  Sqlite.unsafeIO (readTVarIO rootBranchCache) >>= \case
-    Nothing -> forceReload
-    Just (v, b) -> do
-      -- check to see if root namespace hash has been externally modified
-      -- and reload it if necessary
-      v' <- Sqlite.getDataVersion
-      if v == v'
-        then pure b
-        else do
-          newRootHash <- Ops.expectRootCausalHash
-          if Branch.headHash b == Cv.causalHash2to1 newRootHash
-            then pure b
-            else do
-              traceM $ "database was externally modified (" ++ show v ++ " -> " ++ show v' ++ ")"
-              forceReload
-  where
-    forceReload :: Transaction (Branch Transaction)
-    forceReload = do
-      branch1 <- uncachedLoadRootBranch branchCache doGetDeclType
-      ver <- Sqlite.getDataVersion
-      Sqlite.unsafeIO (atomically (writeTVar rootBranchCache (Just (ver, branch1))))
-      pure branch1
-
 uncachedLoadRootBranch ::
   BranchCache Sqlite.Transaction ->
   (C.Reference.Reference -> Sqlite.Transaction CT.ConstructorType) ->
@@ -420,12 +389,11 @@ getRootBranchExists :: Transaction Bool
 getRootBranchExists =
   isJust <$> Ops.loadRootCausalHash
 
-putRootBranch :: TVar (Maybe (Sqlite.DataVersion, Branch Transaction)) -> Branch Transaction -> Transaction ()
-putRootBranch rootBranchCache branch1 = do
+putRootBranch :: Branch Transaction -> Transaction ()
+putRootBranch branch1 = do
   -- todo: check to see if root namespace hash has been externally modified
   -- and do something (merge?) it if necessary. But for now, we just overwrite it.
   void (Ops.saveRootBranch v2HashHandle (Cv.causalbranch1to2 branch1))
-  Sqlite.unsafeIO (atomically $ modifyTVar' rootBranchCache (fmap . second $ const branch1))
 
 -- if this blows up on cromulent hashes, then switch from `hashToHashId`
 -- to one that returns Maybe.
diff --git a/parser-typechecker/unison-parser-typechecker.cabal b/parser-typechecker/unison-parser-typechecker.cabal
index 5652aaf4e..60c680b11 100644
--- a/parser-typechecker/unison-parser-typechecker.cabal
+++ b/parser-typechecker/unison-parser-typechecker.cabal
@@ -59,6 +59,7 @@ library
       Unison.Codebase.Path
       Unison.Codebase.Path.Parse
       Unison.Codebase.PushBehavior
+      Unison.Codebase.RootBranchCache
       Unison.Codebase.Runtime
       Unison.Codebase.Serialization
       Unison.Codebase.ShortCausalHash

From faaca6f75a6b17f70a9cd73a81f94e675471b74d Mon Sep 17 00:00:00 2001
From: Dan Doel <dan.doel@gmail.com>
Date: Fri, 18 Nov 2022 13:19:59 -0500
Subject: [PATCH 23/41] Include an example transcript for manual running.

- Takes too long to pull all the code for compiling to be worth running
  in CI, even if we were able to get the scheme compiler there.
- The example is silly, but it shows an interpreted program that is slow
  enough to run once that we can beat when we include the compiler
  download time. Scheme is also executing the program 30 times.
---
 unison-src/transcripts-manual/scheme.md | 61 +++++++++++++++++++++++++
 1 file changed, 61 insertions(+)
 create mode 100644 unison-src/transcripts-manual/scheme.md

diff --git a/unison-src/transcripts-manual/scheme.md b/unison-src/transcripts-manual/scheme.md
new file mode 100644
index 000000000..8ae0d9805
--- /dev/null
+++ b/unison-src/transcripts-manual/scheme.md
@@ -0,0 +1,61 @@
+This transcript executes very slowly, because the compiler has an
+entire copy of base (and other stuff) within it.
+
+```ucm:hide
+.> builtins.mergeio
+.> pull.without-history unison.public.base.trunk base
+```
+
+```unison
+stdOut = stdHandle StdOut
+
+print txt =
+  match putBytes.impl stdOut (toUtf8 txt) with
+    Left f -> raise f
+    Right _ -> ()
+
+prints n f = print (join " " f n ++ "\n")
+
+join sep f =
+  use Text ++
+  loop acc = cases
+    0 -> acc
+    n -> loop (!f ++ (sep ++ acc)) (drop n 1)
+
+  cases
+    0 -> ""
+    n -> loop !f (drop n 1)
+
+addUp : Nat -> Nat -> Nat
+addUp acc = cases
+  0 -> acc
+  n -> addUp (1+acc) (drop n 1)
+
+repeat : Nat -> '{g} () -> '{g} ()
+repeat n act =
+  loop : Nat ->{g} ()
+  loop = cases
+    0 -> ()
+    k ->
+      !act
+      loop (drop k 1)
+
+  '(loop n)
+
+printAddUp : Nat ->{IO,Exception} ()
+printAddUp n =
+  ns = [addUp 0 n, addUp 0 n, addUp 0 n, addUp 0 n, addUp 0 n]
+  prints 8 '(toText (addUp 0 n))
+
+singleAddUp : '{IO,Exception} ()
+singleAddUp = do printAddUp 3000000
+
+multiAddUp : '{IO,Exception} ()
+multiAddUp = repeat 35 '(printAddUp 3000000)
+```
+
+```ucm
+.> add
+.> run singleAddUp
+.> run.native multiAddUp
+```

From fafc3280c9bfcb7184148d944a90217d622319fb Mon Sep 17 00:00:00 2001
From: Travis Staton <hello@travisstaton.com>
Date: Fri, 18 Nov 2022 14:18:27 -0500
Subject: [PATCH 24/41] Prevent opening two ucm processes against the same
 codebase

optionally obtain file lock on sqlite when opening a codebase
---
 parser-typechecker/package.yaml               |  1 +
 .../src/Unison/Codebase/Init.hs               | 47 +++++++++++--------
 .../Unison/Codebase/Init/OpenCodebaseError.hs |  1 +
 .../src/Unison/Codebase/SqliteCodebase.hs     | 38 ++++++++++-----
 .../Codebase/SqliteCodebase/GitError.hs       |  1 +
 .../Unison/Codebase/SqliteCodebase/Paths.hs   |  4 ++
 .../src/Unison/Codebase/Type.hs               |  1 +
 .../tests/Unison/Test/CodebaseInit.hs         | 20 ++++----
 .../unison-parser-typechecker.cabal           |  2 +
 .../src/Unison/CommandLine/OutputMessages.hs  | 11 +++--
 unison-cli/tests/Unison/Test/Ucm.hs           |  6 +--
 unison-cli/transcripts/Transcripts.hs         |  2 +-
 unison-cli/unison/Main.hs                     | 11 ++++-
 13 files changed, 95 insertions(+), 50 deletions(-)

diff --git a/parser-typechecker/package.yaml b/parser-typechecker/package.yaml
index 8c2949c36..f09cf0499 100644
--- a/parser-typechecker/package.yaml
+++ b/parser-typechecker/package.yaml
@@ -41,6 +41,7 @@ dependencies:
   - errors
   - exceptions
   - extra
+  - filelock
   - filepath
   - fingertree
   - fsnotify
diff --git a/parser-typechecker/src/Unison/Codebase/Init.hs b/parser-typechecker/src/Unison/Codebase/Init.hs
index 81983fe11..f2de5de2a 100644
--- a/parser-typechecker/src/Unison/Codebase/Init.hs
+++ b/parser-typechecker/src/Unison/Codebase/Init.hs
@@ -6,6 +6,7 @@ module Unison.Codebase.Init
     DebugName,
     InitError (..),
     CodebaseInitOptions (..),
+    CodebaseLockOption (..),
     InitResult (..),
     SpecifiedCodebase (..),
     MigrationStrategy (..),
@@ -42,6 +43,10 @@ data SpecifiedCodebase
   = CreateWhenMissing CodebasePath
   | DontCreateWhenMissing CodebasePath
 
+data CodebaseLockOption
+  = DoLock
+  | DontLock
+
 data MigrationStrategy
   = -- | Perform a migration immediately if one is required.
     MigrateAutomatically
@@ -60,9 +65,9 @@ type DebugName = String
 
 data Init m v a = Init
   { -- | open an existing codebase
-    withOpenCodebase :: forall r. DebugName -> CodebasePath -> MigrationStrategy -> (Codebase m v a -> m r) -> m (Either OpenCodebaseError r),
+    withOpenCodebase :: forall r. DebugName -> CodebasePath -> CodebaseLockOption -> MigrationStrategy -> (Codebase m v a -> m r) -> m (Either OpenCodebaseError r),
     -- | create a new codebase
-    withCreatedCodebase :: forall r. DebugName -> CodebasePath -> (Codebase m v a -> m r) -> m (Either CreateCodebaseError r),
+    withCreatedCodebase :: forall r. DebugName -> CodebasePath -> CodebaseLockOption -> (Codebase m v a -> m r) -> m (Either CreateCodebaseError r),
     -- | given a codebase root, and given that the codebase root may have other junk in it,
     -- give the path to the "actual" files; e.g. what a forked transcript should clone.
     codebasePath :: CodebasePath -> CodebasePath
@@ -85,10 +90,11 @@ createCodebaseWithResult ::
   Init m v a ->
   DebugName ->
   CodebasePath ->
+  CodebaseLockOption ->
   (Codebase m v a -> m r) ->
   m (Either (CodebasePath, InitError) r)
-createCodebaseWithResult cbInit debugName dir action =
-  createCodebase cbInit debugName dir action <&> mapLeft \case
+createCodebaseWithResult cbInit debugName dir lockOption action =
+  createCodebase cbInit debugName dir lockOption action <&> mapLeft \case
     errorMessage -> (dir, (CouldntCreateCodebase errorMessage))
 
 withOpenOrCreateCodebase ::
@@ -96,12 +102,13 @@ withOpenOrCreateCodebase ::
   Init m v a ->
   DebugName ->
   CodebaseInitOptions ->
+  CodebaseLockOption ->
   MigrationStrategy ->
   ((InitResult, CodebasePath, Codebase m v a) -> m r) ->
   m (Either (CodebasePath, InitError) r)
-withOpenOrCreateCodebase cbInit debugName initOptions migrationStrategy action = do
+withOpenOrCreateCodebase cbInit debugName initOptions lockOption migrationStrategy action = do
   let resolvedPath = initOptionsToDir initOptions
-  result <- withOpenCodebase cbInit debugName resolvedPath migrationStrategy \codebase -> do
+  result <- withOpenCodebase cbInit debugName resolvedPath lockOption migrationStrategy \codebase -> do
     action (OpenedCodebase, resolvedPath, codebase)
   case result of
     Right r -> pure $ Right r
@@ -114,7 +121,7 @@ withOpenOrCreateCodebase cbInit debugName initOptions migrationStrategy action =
               (do pure (Left (homeDir, FoundV1Codebase)))
               ( do
                   -- Create V2 codebase if neither a V1 or V2 exists
-                  createCodebaseWithResult cbInit debugName homeDir (\codebase -> action (CreatedCodebase, homeDir, codebase))
+                  createCodebaseWithResult cbInit debugName homeDir lockOption (\codebase -> action (CreatedCodebase, homeDir, codebase))
               )
           Specified specified ->
             ifM
@@ -124,14 +131,15 @@ withOpenOrCreateCodebase cbInit debugName initOptions migrationStrategy action =
                 DontCreateWhenMissing dir ->
                   pure (Left (dir, (InitErrorOpen OpenCodebaseDoesntExist)))
                 CreateWhenMissing dir ->
-                  createCodebaseWithResult cbInit debugName dir (\codebase -> action (CreatedCodebase, dir, codebase))
+                  createCodebaseWithResult cbInit debugName dir lockOption (\codebase -> action (CreatedCodebase, dir, codebase))
       OpenCodebaseUnknownSchemaVersion {} -> pure (Left (resolvedPath, InitErrorOpen err))
       OpenCodebaseRequiresMigration {} -> pure (Left (resolvedPath, InitErrorOpen err))
+      OpenCodebaseFileLockFailed {} -> pure (Left (resolvedPath, InitErrorOpen err))
 
-createCodebase :: MonadIO m => Init m v a -> DebugName -> CodebasePath -> (Codebase m v a -> m r) -> m (Either Pretty r)
-createCodebase cbInit debugName path action = do
+createCodebase :: MonadIO m => Init m v a -> DebugName -> CodebasePath -> CodebaseLockOption -> (Codebase m v a -> m r) -> m (Either Pretty r)
+createCodebase cbInit debugName path lockOption action = do
   prettyDir <- P.string <$> canonicalizePath path
-  withCreatedCodebase cbInit debugName path action <&> mapLeft \case
+  withCreatedCodebase cbInit debugName path lockOption action <&> mapLeft \case
     CreateCodebaseAlreadyExists ->
       P.wrap $
         "It looks like there's already a codebase in: "
@@ -141,30 +149,31 @@ createCodebase cbInit debugName path action = do
 
 -- previously: initCodebaseOrExit :: CodebasePath -> m (m (), Codebase m v a)
 -- previously: FileCodebase.initCodebase :: CodebasePath -> m (m (), Codebase m v a)
-withNewUcmCodebaseOrExit :: MonadIO m => Init m Symbol Ann -> DebugName -> CodebasePath -> (Codebase m Symbol Ann -> m r) -> m r
-withNewUcmCodebaseOrExit cbInit debugName path action = do
+withNewUcmCodebaseOrExit :: MonadIO m => Init m Symbol Ann -> DebugName -> CodebasePath -> CodebaseLockOption -> (Codebase m Symbol Ann -> m r) -> m r
+withNewUcmCodebaseOrExit cbInit debugName path lockOption action = do
   prettyDir <- P.string <$> canonicalizePath path
   let codebaseSetup codebase = do
         liftIO $ PT.putPrettyLn' . P.wrap $ "Initializing a new codebase in: " <> prettyDir
         Codebase.runTransaction codebase (Codebase.installUcmDependencies codebase)
-  createCodebase cbInit debugName path (\cb -> codebaseSetup cb *> action cb)
+  createCodebase cbInit debugName path lockOption (\cb -> codebaseSetup cb *> action cb)
     >>= \case
       Left error -> liftIO $ PT.putPrettyLn' error >> exitFailure
       Right result -> pure result
 
 -- | try to init a codebase where none exists and then exit regardless (i.e. `ucm --codebase dir init`)
-initCodebaseAndExit :: MonadIO m => Init m Symbol Ann -> DebugName -> Maybe CodebasePath -> m ()
-initCodebaseAndExit i debugName mdir = do
+initCodebaseAndExit :: MonadIO m => Init m Symbol Ann -> DebugName -> Maybe CodebasePath -> CodebaseLockOption -> m ()
+initCodebaseAndExit i debugName mdir lockOption = do
   codebaseDir <- Codebase.getCodebaseDir mdir
-  withNewUcmCodebaseOrExit i debugName codebaseDir (const $ pure ())
+  withNewUcmCodebaseOrExit i debugName codebaseDir lockOption (const $ pure ())
 
 withTemporaryUcmCodebase ::
   MonadUnliftIO m =>
   Init m Symbol Ann ->
   DebugName ->
+  CodebaseLockOption ->
   ((CodebasePath, Codebase m Symbol Ann) -> m r) ->
   m r
-withTemporaryUcmCodebase cbInit debugName action = do
+withTemporaryUcmCodebase cbInit debugName lockOption action = do
   UnliftIO.withSystemTempDirectory debugName $ \tempDir -> do
-    withNewUcmCodebaseOrExit cbInit debugName tempDir $ \codebase -> do
+    withNewUcmCodebaseOrExit cbInit debugName tempDir lockOption $ \codebase -> do
       action (tempDir, codebase)
diff --git a/parser-typechecker/src/Unison/Codebase/Init/OpenCodebaseError.hs b/parser-typechecker/src/Unison/Codebase/Init/OpenCodebaseError.hs
index 573261f81..ea9d0a2f5 100644
--- a/parser-typechecker/src/Unison/Codebase/Init/OpenCodebaseError.hs
+++ b/parser-typechecker/src/Unison/Codebase/Init/OpenCodebaseError.hs
@@ -15,6 +15,7 @@ data OpenCodebaseError
     OpenCodebaseDoesntExist
   | -- | The codebase exists, but its schema version is unknown to this application.
     OpenCodebaseUnknownSchemaVersion SchemaVersion
+  | OpenCodebaseFileLockFailed
   | -- | The codebase exists, but requires a migration before it can be used.
     OpenCodebaseRequiresMigration
       -- current version
diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs
index cf6bb1bff..c52aed412 100644
--- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs
+++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs
@@ -9,6 +9,7 @@
 module Unison.Codebase.SqliteCodebase
   ( Unison.Codebase.SqliteCodebase.init,
     MigrationStrategy (..),
+    CodebaseLockOption (..),
   )
 where
 
@@ -23,6 +24,7 @@ import qualified Data.Set as Set
 import qualified Data.Text as Text
 import Data.Time (getCurrentTime)
 import qualified System.Console.ANSI as ANSI
+import System.FileLock (SharedExclusive (Exclusive), withTryFileLock)
 import qualified System.FilePath as FilePath
 import qualified System.FilePath.Posix as FilePath.Posix
 import qualified U.Codebase.Branch as V2Branch
@@ -48,7 +50,7 @@ import Unison.Codebase.Editor.RemoteRepo
     writeToReadGit,
   )
 import qualified Unison.Codebase.GitError as GitError
-import Unison.Codebase.Init (MigrationStrategy (..))
+import Unison.Codebase.Init (CodebaseLockOption (..), MigrationStrategy (..))
 import qualified Unison.Codebase.Init as Codebase
 import qualified Unison.Codebase.Init.CreateCodebaseError as Codebase1
 import Unison.Codebase.Init.OpenCodebaseError (OpenCodebaseError (..))
@@ -107,13 +109,14 @@ withOpenOrCreateCodebase ::
   Codebase.DebugName ->
   CodebasePath ->
   LocalOrRemote ->
+  CodebaseLockOption ->
   MigrationStrategy ->
   ((CodebaseStatus, Codebase m Symbol Ann) -> m r) ->
   m (Either Codebase1.OpenCodebaseError r)
-withOpenOrCreateCodebase debugName codebasePath localOrRemote migrationStrategy action = do
-  createCodebaseOrError debugName codebasePath (action' CreatedCodebase) >>= \case
+withOpenOrCreateCodebase debugName codebasePath localOrRemote lockOption migrationStrategy action = do
+  createCodebaseOrError debugName codebasePath lockOption (action' CreatedCodebase) >>= \case
     Left (Codebase1.CreateCodebaseAlreadyExists) -> do
-      sqliteCodebase debugName codebasePath localOrRemote migrationStrategy (action' ExistingCodebase)
+      sqliteCodebase debugName codebasePath localOrRemote lockOption migrationStrategy (action' ExistingCodebase)
     Right r -> pure (Right r)
   where
     action' openOrCreate codebase = action (openOrCreate, codebase)
@@ -123,9 +126,10 @@ createCodebaseOrError ::
   (MonadUnliftIO m) =>
   Codebase.DebugName ->
   CodebasePath ->
+  CodebaseLockOption ->
   (Codebase m Symbol Ann -> m r) ->
   m (Either Codebase1.CreateCodebaseError r)
-createCodebaseOrError debugName path action = do
+createCodebaseOrError debugName path lockOption action = do
   ifM
     (doesFileExist $ makeCodebasePath path)
     (pure $ Left Codebase1.CreateCodebaseAlreadyExists)
@@ -137,7 +141,7 @@ createCodebaseOrError debugName path action = do
           Q.createSchema
           void . Ops.saveRootBranch v2HashHandle $ Cv.causalbranch1to2 Branch.empty
 
-      sqliteCodebase debugName path Local DontMigrate action >>= \case
+      sqliteCodebase debugName path Local lockOption DontMigrate action >>= \case
         Left schemaVersion -> error ("Failed to open codebase with schema version: " ++ show schemaVersion ++ ", which is unexpected because I just created this codebase.")
         Right result -> pure (Right result)
 
@@ -148,13 +152,14 @@ withCodebaseOrError ::
   (MonadUnliftIO m) =>
   Codebase.DebugName ->
   CodebasePath ->
+  CodebaseLockOption ->
   MigrationStrategy ->
   (Codebase m Symbol Ann -> m r) ->
   m (Either Codebase1.OpenCodebaseError r)
-withCodebaseOrError debugName dir migrationStrategy action = do
+withCodebaseOrError debugName dir lockOption migrationStrategy action = do
   doesFileExist (makeCodebasePath dir) >>= \case
     False -> pure (Left Codebase1.OpenCodebaseDoesntExist)
-    True -> sqliteCodebase debugName dir Local migrationStrategy action
+    True -> sqliteCodebase debugName dir Local lockOption migrationStrategy action
 
 initSchemaIfNotExist :: MonadIO m => FilePath -> m ()
 initSchemaIfNotExist path = liftIO do
@@ -188,10 +193,11 @@ sqliteCodebase ::
   CodebasePath ->
   -- | When local, back up the existing codebase before migrating, in case there's a catastrophic bug in the migration.
   LocalOrRemote ->
+  CodebaseLockOption ->
   MigrationStrategy ->
   (Codebase m Symbol Ann -> m r) ->
   m (Either Codebase1.OpenCodebaseError r)
-sqliteCodebase debugName root localOrRemote migrationStrategy action = do
+sqliteCodebase debugName root localOrRemote lockOption migrationStrategy action = handleLockOption do
   rootBranchCache <- newEmptyRootBranchCacheIO
   branchCache <- newBranchCache
   getDeclType <- CodebaseOps.makeCachedTransaction 2048 CodebaseOps.getDeclType
@@ -391,6 +397,13 @@ sqliteCodebase debugName root localOrRemote migrationStrategy action = do
     runTransaction action =
       withConn \conn -> Sqlite.runTransaction conn action
 
+    handleLockOption ma = case lockOption of
+      DontLock -> ma
+      DoLock -> withRunInIO \runInIO ->
+        withTryFileLock (lockfilePath root) Exclusive (\_flock -> runInIO ma) <&> \case
+          Nothing -> Left OpenCodebaseFileLockFailed
+          Just x -> x
+
 syncInternal ::
   forall m.
   MonadUnliftIO m =>
@@ -583,7 +596,7 @@ viewRemoteBranch' ReadGitRemoteNamespace {repo, sch, path} gitBranchBehavior act
           then throwIO (C.GitSqliteCodebaseError (GitError.NoDatabaseFile repo remotePath))
           else throwIO exception
 
-      result <- sqliteCodebase "viewRemoteBranch.gitCache" remotePath Remote MigrateAfterPrompt \codebase -> do
+      result <- sqliteCodebase "viewRemoteBranch.gitCache" remotePath Remote DoLock MigrateAfterPrompt \codebase -> do
         -- try to load the requested branch from it
         branch <- time "Git fetch (sch)" $ case sch of
           -- no sub-branch was specified, so use the root.
@@ -633,7 +646,7 @@ pushGitBranch srcConn repo (PushGitBranchOpts behavior _syncMode) action = Unlif
   -- set up the cache dir
   throwEitherMWith C.GitProtocolError . withRepo readRepo Git.CreateBranchIfMissing $ \pushStaging -> do
     newBranchOrErr <- throwEitherMWith (C.GitSqliteCodebaseError . C.gitErrorFromOpenCodebaseError (Git.gitDirToPath pushStaging) readRepo)
-      . withOpenOrCreateCodebase "push.dest" (Git.gitDirToPath pushStaging) Remote MigrateAfterPrompt
+      . withOpenOrCreateCodebase "push.dest" (Git.gitDirToPath pushStaging) Remote DoLock MigrateAfterPrompt
       $ \(codebaseStatus, destCodebase) -> do
         currentRootBranch <-
           Codebase1.runTransaction destCodebase CodebaseOps.getRootBranchExists >>= \case
@@ -712,9 +725,10 @@ pushGitBranch srcConn repo (PushGitBranchOpts behavior _syncMode) action = Unlif
         -- so we have to convert our expected path to test.
         posixCodebasePath =
           FilePath.Posix.joinPath (FilePath.splitDirectories codebasePath)
+        posixLockfilePath = FilePath.replaceExtension posixCodebasePath "lockfile"
         statusLines = Text.unpack <$> Text.lines status
         t = dropWhile Char.isSpace
-        okLine (t -> '?' : '?' : (t -> p)) | p == posixCodebasePath = True
+        okLine (t -> '?' : '?' : (t -> p)) | p == posixCodebasePath || p == posixLockfilePath = True
         okLine (t -> 'M' : (t -> p)) | p == posixCodebasePath = True
         okLine line = isWalDelete line || isShmDelete line
         isWalDelete (t -> 'D' : (t -> p)) | p == posixCodebasePath ++ "-wal" = True
diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/GitError.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/GitError.hs
index 92b170407..f60581214 100644
--- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/GitError.hs
+++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/GitError.hs
@@ -6,6 +6,7 @@ import Unison.CodebasePath (CodebasePath)
 
 data GitSqliteCodebaseError
   = GitCouldntParseRootBranchHash ReadGitRepo String
+  | CodebaseFileLockFailed
   | NoDatabaseFile ReadGitRepo CodebasePath
   | UnrecognizedSchemaVersion ReadGitRepo CodebasePath SchemaVersion
   | CodebaseRequiresMigration SchemaVersion SchemaVersion
diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Paths.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Paths.hs
index 3ae689d48..d0e6871ef 100644
--- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Paths.hs
+++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Paths.hs
@@ -3,6 +3,7 @@ module Unison.Codebase.SqliteCodebase.Paths
     makeCodebasePath,
     makeCodebaseDirPath,
     backupCodebasePath,
+    lockfilePath,
   )
 where
 
@@ -18,6 +19,9 @@ codebasePath = ".unison" </> "v2" </> "unison.sqlite3"
 makeCodebasePath :: CodebasePath -> FilePath
 makeCodebasePath root = makeCodebaseDirPath root </> "unison.sqlite3"
 
+lockfilePath :: CodebasePath -> FilePath
+lockfilePath root = makeCodebaseDirPath root </> "unison.lockfile"
+
 -- | Makes a path to the location where sqlite files are stored within a codebase path.
 makeCodebaseDirPath :: CodebasePath -> FilePath
 makeCodebaseDirPath root = root </> ".unison" </> "v2"
diff --git a/parser-typechecker/src/Unison/Codebase/Type.hs b/parser-typechecker/src/Unison/Codebase/Type.hs
index d37644afb..093b1e0f4 100644
--- a/parser-typechecker/src/Unison/Codebase/Type.hs
+++ b/parser-typechecker/src/Unison/Codebase/Type.hs
@@ -159,3 +159,4 @@ gitErrorFromOpenCodebaseError path repo = \case
     UnrecognizedSchemaVersion repo path (fromIntegral v)
   OpenCodebaseRequiresMigration fromSv toSv ->
     CodebaseRequiresMigration fromSv toSv
+  OpenCodebaseFileLockFailed -> CodebaseFileLockFailed
diff --git a/parser-typechecker/tests/Unison/Test/CodebaseInit.hs b/parser-typechecker/tests/Unison/Test/CodebaseInit.hs
index dd4e76b68..6ac30e408 100644
--- a/parser-typechecker/tests/Unison/Test/CodebaseInit.hs
+++ b/parser-typechecker/tests/Unison/Test/CodebaseInit.hs
@@ -29,7 +29,7 @@ test =
             [ scope "a v2 codebase should be opened" do
                 tmp <- io (Temp.getCanonicalTemporaryDirectory >>= flip Temp.createTempDirectory "ucm-test")
                 cbInit <- io initMockWithCodebase
-                r <- io $ CI.withOpenOrCreateCodebase cbInit "ucm-test" (Home tmp) CI.DontMigrate \case
+                r <- io $ CI.withOpenOrCreateCodebase cbInit "ucm-test" (Home tmp) CI.DontLock CI.DontMigrate \case
                   (CI.OpenedCodebase, _, _) -> pure True
                   _ -> pure False
                 case r of
@@ -38,7 +38,7 @@ test =
               scope "a v2 codebase should be created when one does not exist" do
                 tmp <- io (Temp.getCanonicalTemporaryDirectory >>= flip Temp.createTempDirectory "ucm-test")
                 cbInit <- io initMockWithoutCodebase
-                r <- io $ CI.withOpenOrCreateCodebase cbInit "ucm-test" (Home tmp) CI.DontMigrate \case
+                r <- io $ CI.withOpenOrCreateCodebase cbInit "ucm-test" (Home tmp) CI.DontLock CI.DontMigrate \case
                   (CI.CreatedCodebase, _, _) -> pure True
                   _ -> pure False
                 case r of
@@ -51,7 +51,7 @@ test =
                 tmp <- io (Temp.getCanonicalTemporaryDirectory >>= flip Temp.createTempDirectory "ucm-test")
                 cbInit <- io initMockWithCodebase
                 res <- io $
-                  CI.withOpenOrCreateCodebase cbInit "ucm-test" (Specified (DontCreateWhenMissing tmp)) CI.DontMigrate $ \case
+                  CI.withOpenOrCreateCodebase cbInit "ucm-test" (Specified (DontCreateWhenMissing tmp)) CI.DontLock CI.DontMigrate $ \case
                     (CI.OpenedCodebase, _, _) -> pure True
                     _ -> pure False
                 case res of
@@ -61,7 +61,7 @@ test =
                 tmp <- io (Temp.getCanonicalTemporaryDirectory >>= flip Temp.createTempDirectory "ucm-test")
                 cbInit <- io initMockWithoutCodebase
                 res <- io $
-                  CI.withOpenOrCreateCodebase cbInit "ucm-test" (Specified (DontCreateWhenMissing tmp)) CI.DontMigrate $ \case
+                  CI.withOpenOrCreateCodebase cbInit "ucm-test" (Specified (DontCreateWhenMissing tmp)) CI.DontLock CI.DontMigrate $ \case
                     _ -> pure False
                 case res of
                   Left (_, CI.InitErrorOpen OpenCodebaseDoesntExist) -> expect True
@@ -72,7 +72,7 @@ test =
             [ scope "a v2 codebase should be created when one does not exist at the Specified dir" do
                 tmp <- io (Temp.getCanonicalTemporaryDirectory >>= flip Temp.createTempDirectory "ucm-test")
                 cbInit <- io initMockWithoutCodebase
-                res <- io $ CI.withOpenOrCreateCodebase cbInit "ucm-test" (Specified (CreateWhenMissing tmp)) CI.DontMigrate \case
+                res <- io $ CI.withOpenOrCreateCodebase cbInit "ucm-test" (Specified (CreateWhenMissing tmp)) CI.DontLock CI.DontMigrate \case
                   (CI.CreatedCodebase, _, _) -> pure True
                   _ -> pure False
                 case res of
@@ -81,7 +81,7 @@ test =
               scope "a v2 codebase should be opened when one exists" do
                 tmp <- io (Temp.getCanonicalTemporaryDirectory >>= flip Temp.createTempDirectory "ucm-test")
                 cbInit <- io initMockWithCodebase
-                res <- io $ CI.withOpenOrCreateCodebase cbInit "ucm-test" (Specified (CreateWhenMissing tmp)) CI.DontMigrate \case
+                res <- io $ CI.withOpenOrCreateCodebase cbInit "ucm-test" (Specified (CreateWhenMissing tmp)) CI.DontLock CI.DontMigrate \case
                   (CI.OpenedCodebase, _, _) -> pure True
                   _ -> pure False
                 case res of
@@ -98,9 +98,9 @@ initMockWithCodebase = do
   pure $
     Init
       { -- withOpenCodebase :: forall r. DebugName -> CodebasePath -> (Codebase m v a -> m r) -> m (Either Pretty r),
-        withOpenCodebase = \_ _ _ action -> Right <$> action codebase,
+        withOpenCodebase = \_ _ _ _ action -> Right <$> action codebase,
         -- withCreatedCodebase :: forall r. DebugName -> CodebasePath -> (Codebase m v a -> m r) -> m (Either CreateCodebaseError r),
-        withCreatedCodebase = \_ _ action -> Right <$> action codebase,
+        withCreatedCodebase = \_ _ _ action -> Right <$> action codebase,
         -- CodebasePath -> CodebasePath
         codebasePath = id
       }
@@ -110,9 +110,9 @@ initMockWithoutCodebase = do
   let codebase = error "did we /actually/ need a Codebase?"
   pure $
     Init
-      { withOpenCodebase = \_ _ _ _ -> pure (Left OpenCodebaseDoesntExist),
+      { withOpenCodebase = \_ _ _ _ _ -> pure (Left OpenCodebaseDoesntExist),
         -- withCreatedCodebase :: forall r. DebugName -> CodebasePath -> (Codebase m v a -> m r) -> m (Either CreateCodebaseError r),
-        withCreatedCodebase = \_ _ action -> Right <$> action codebase,
+        withCreatedCodebase = \_ _ _ action -> Right <$> action codebase,
         -- CodebasePath -> CodebasePath
         codebasePath = id
       }
diff --git a/parser-typechecker/unison-parser-typechecker.cabal b/parser-typechecker/unison-parser-typechecker.cabal
index 60c680b11..33990dd71 100644
--- a/parser-typechecker/unison-parser-typechecker.cabal
+++ b/parser-typechecker/unison-parser-typechecker.cabal
@@ -209,6 +209,7 @@ library
     , errors
     , exceptions
     , extra
+    , filelock
     , filepath
     , fingertree
     , free
@@ -394,6 +395,7 @@ test-suite parser-typechecker-tests
     , errors
     , exceptions
     , extra
+    , filelock
     , filemanip
     , filepath
     , fingertree
diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs
index 29b7a48eb..2b4aa402f 100644
--- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs
+++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs
@@ -665,8 +665,8 @@ notifyUser dir o = case o of
     CachedTests 0 _ -> pure . P.callout "😶" $ "No tests to run."
     CachedTests n n'
       | n == n' ->
-        pure $
-          P.lines [cache, "", displayTestResults True ppe oks fails]
+          pure $
+            P.lines [cache, "", displayTestResults True ppe oks fails]
     CachedTests _n m ->
       pure $
         if m == 0
@@ -675,6 +675,7 @@ notifyUser dir o = case o of
             P.indentN 2 $
               P.lines ["", cache, "", displayTestResults False ppe oks fails, "", "✅  "]
       where
+
     NewlyComputed -> do
       clearCurrentLine
       pure $
@@ -1131,6 +1132,10 @@ notifyUser dir o = case o of
           else pure mempty
   GitError e -> pure $ case e of
     GitSqliteCodebaseError e -> case e of
+      CodebaseFileLockFailed ->
+        P.wrap $
+          "Failed to obtain a file lock on the codebase. "
+            <> "Perhaps you are running multiple ucm processes against the same codebase."
       NoDatabaseFile repo localPath ->
         P.wrap $
           "I didn't find a codebase in the repository at"
@@ -2463,7 +2468,7 @@ showDiffNamespace ::
   (Pretty, NumberedArgs)
 showDiffNamespace _ _ _ _ diffOutput
   | OBD.isEmpty diffOutput =
-    ("The namespaces are identical.", mempty)
+      ("The namespaces are identical.", mempty)
 showDiffNamespace sn ppe oldPath newPath OBD.BranchDiffOutput {..} =
   (P.sepNonEmpty "\n\n" p, toList args)
   where
diff --git a/unison-cli/tests/Unison/Test/Ucm.hs b/unison-cli/tests/Unison/Test/Ucm.hs
index 545fe9260..4a862e07f 100644
--- a/unison-cli/tests/Unison/Test/Ucm.hs
+++ b/unison-cli/tests/Unison/Test/Ucm.hs
@@ -53,7 +53,7 @@ initCodebase fmt = do
   tmp <-
     Temp.getCanonicalTemporaryDirectory
       >>= flip Temp.createTempDirectory "ucm-test"
-  result <- Codebase.Init.withCreatedCodebase cbInit "ucm-test" tmp (const $ pure ())
+  result <- Codebase.Init.withCreatedCodebase cbInit "ucm-test" tmp SC.DoLock (const $ pure ())
   case result of
     Left CreateCodebaseAlreadyExists -> fail $ P.toANSI 80 "Codebase already exists"
     Right _ -> pure $ Codebase tmp fmt
@@ -66,7 +66,7 @@ runTranscript (Codebase codebasePath fmt) transcript = do
   let err e = fail $ "Parse error: \n" <> show e
       cbInit = case fmt of CodebaseFormat2 -> SC.init
   TR.withTranscriptRunner "Unison.Test.Ucm.runTranscript Invalid Version String" configFile $ \runner -> do
-    result <- Codebase.Init.withOpenCodebase cbInit "transcript" codebasePath SC.DontMigrate \codebase -> do
+    result <- Codebase.Init.withOpenCodebase cbInit "transcript" codebasePath SC.DoLock SC.DontMigrate \codebase -> do
       Codebase.runTransaction codebase (Codebase.installUcmDependencies codebase)
       let transcriptSrc = Text.pack . stripMargin $ unTranscript transcript
       output <- either err Text.unpack <$> runner "transcript" transcriptSrc (codebasePath, codebase)
@@ -81,7 +81,7 @@ runTranscript (Codebase codebasePath fmt) transcript = do
 lowLevel :: Codebase -> (Codebase.Codebase IO Symbol Ann -> IO a) -> IO a
 lowLevel (Codebase root fmt) action = do
   let cbInit = case fmt of CodebaseFormat2 -> SC.init
-  result <- Codebase.Init.withOpenCodebase cbInit "lowLevel" root SC.DontMigrate action
+  result <- Codebase.Init.withOpenCodebase cbInit "lowLevel" root SC.DoLock SC.DontMigrate action
   case result of
     Left e -> PT.putPrettyLn (P.shown e) *> pure (error "This really should have loaded")
     Right a -> pure a
diff --git a/unison-cli/transcripts/Transcripts.hs b/unison-cli/transcripts/Transcripts.hs
index 7f4b2e338..52f8a2843 100644
--- a/unison-cli/transcripts/Transcripts.hs
+++ b/unison-cli/transcripts/Transcripts.hs
@@ -34,7 +34,7 @@ type TestBuilder = FilePath -> [String] -> String -> Test ()
 testBuilder ::
   Bool -> FilePath -> [String] -> String -> Test ()
 testBuilder expectFailure dir prelude transcript = scope transcript $ do
-  outputs <- io . withTemporaryUcmCodebase SC.init "transcript" $ \(codebasePath, codebase) -> do
+  outputs <- io . withTemporaryUcmCodebase SC.init "transcript" SC.DoLock $ \(codebasePath, codebase) -> do
     withTranscriptRunner "TODO: pass version here" Nothing $ \runTranscript -> do
       for files $ \filePath -> do
         transcriptSrc <- readUtf8 filePath
diff --git a/unison-cli/unison/Main.hs b/unison-cli/unison/Main.hs
index a4f41367a..394c5f7dc 100644
--- a/unison-cli/unison/Main.hs
+++ b/unison-cli/unison/Main.hs
@@ -336,7 +336,7 @@ prepareTranscriptDir shouldFork mCodePathOption = do
       Path.copyDir (CodebaseInit.codebasePath cbInit path) (CodebaseInit.codebasePath cbInit tmp)
     DontFork -> do
       PT.putPrettyLn . P.wrap $ "Transcript will be run on a new, empty codebase."
-      CodebaseInit.withNewUcmCodebaseOrExit cbInit "main.transcript" tmp (const $ pure ())
+      CodebaseInit.withNewUcmCodebaseOrExit cbInit "main.transcript" tmp SC.DoLock (const $ pure ())
   pure tmp
 
 runTranscripts' ::
@@ -516,7 +516,7 @@ defaultBaseLib =
 getCodebaseOrExit :: Maybe CodebasePathOption -> SC.MigrationStrategy -> ((InitResult, CodebasePath, Codebase IO Symbol Ann) -> IO r) -> IO r
 getCodebaseOrExit codebasePathOption migrationStrategy action = do
   initOptions <- argsToCodebaseInitOptions codebasePathOption
-  result <- CodebaseInit.withOpenOrCreateCodebase SC.init "main" initOptions migrationStrategy \case
+  result <- CodebaseInit.withOpenOrCreateCodebase SC.init "main" initOptions SC.DoLock migrationStrategy \case
     cbInit@(CreatedCodebase, dir, _) -> do
       pDir <- prettyDir dir
       PT.putPrettyLn' ""
@@ -535,6 +535,13 @@ getCodebaseOrExit codebasePathOption migrationStrategy action = do
             case err of
               InitErrorOpen err ->
                 case err of
+                  OpenCodebaseFileLockFailed ->
+                    pure
+                      ( P.lines
+                          [ "Failed to obtain a file lock on the codebase. ",
+                            "Perhaps you are running multiple ucm processes against the same codebase."
+                          ]
+                      )
                   OpenCodebaseDoesntExist ->
                     pure
                       ( P.lines

From fc9fe143293a3e3e449f7e59a43307f4a67f40e3 Mon Sep 17 00:00:00 2001
From: Mitchell Rosen <mitchellwrosen@gmail.com>
Date: Mon, 21 Nov 2022 14:08:55 -0500
Subject: [PATCH 25/41] ormolu

---
 parser-typechecker/src/Unison/Runtime/ANF.hs  |  57 +++---
 .../src/Unison/Runtime/ANF/Serialize.hs       |   3 +-
 .../src/Unison/Runtime/Machine.hs             |   2 +-
 .../src/Unison/Runtime/Serialize.hs           |   4 +-
 unison-cli/src/Unison/Cli/TypeCheck.hs        |  23 ++-
 .../src/Unison/Codebase/Editor/HandleInput.hs | 193 +++++++++---------
 .../Editor/HandleInput/TermResolution.hs      | 121 +++++------
 .../src/Unison/CommandLine/InputPatterns.hs   |  26 +--
 8 files changed, 227 insertions(+), 202 deletions(-)

diff --git a/parser-typechecker/src/Unison/Runtime/ANF.hs b/parser-typechecker/src/Unison/Runtime/ANF.hs
index b135974b4..d0c0357f8 100644
--- a/parser-typechecker/src/Unison/Runtime/ANF.hs
+++ b/parser-typechecker/src/Unison/Runtime/ANF.hs
@@ -76,10 +76,10 @@ import Control.Monad.State (MonadState (..), State, gets, modify, runState)
 import Data.Bifoldable (Bifoldable (..))
 import Data.Bifunctor (Bifunctor (..))
 import Data.Bits (shiftL, shiftR, (.&.), (.|.))
-import qualified Data.Primitive as PA
 import Data.Functor.Compose (Compose (..))
 import Data.List hiding (and, or)
 import qualified Data.Map as Map
+import qualified Data.Primitive as PA
 import qualified Data.Set as Set
 import qualified Data.Text as Data.Text
 import GHC.Stack (CallStack, callStack)
@@ -227,12 +227,13 @@ newtype Prefix v x = Pfx (Map v [v]) deriving (Show)
 
 instance Functor (Prefix v) where
   fmap _ (Pfx m) = Pfx m
+
 instance Ord v => Applicative (Prefix v) where
   pure _ = Pfx Map.empty
   Pfx ml <*> Pfx mr = Pfx $ Map.unionWith common ml mr
 
 common :: Eq v => [v] -> [v] -> [v]
-common (u:us) (v:vs)
+common (u : us) (v : vs)
   | u == v = u : common us vs
 common _ _ = []
 
@@ -265,13 +266,13 @@ dropPrefix v n = ABT.visitPure rw
       | v == u = Just (apps' (var (ABT.annotation f) u) (drop n as))
     rw _ = Nothing
 
-dropPrefixes
-  :: Ord v => Semigroup a => Map v Int -> Term v a -> Term v a
+dropPrefixes ::
+  Ord v => Semigroup a => Map v Int -> Term v a -> Term v a
 dropPrefixes m = ABT.visitPure rw
   where
     rw (Apps' f@(Var' u) as)
       | Just n <- Map.lookup u m =
-        Just (apps' (var (ABT.annotation f) u) (drop n as))
+          Just (apps' (var (ABT.annotation f) u) (drop n as))
     rw _ = Nothing
 
 -- Performs opposite transformations to those in enclose. Named after
@@ -280,27 +281,28 @@ beta :: Var v => Monoid a => (Term v a -> Term v a) -> Term v a -> Maybe (Term v
 beta rec (LetRecNamedTop' top (fmap (fmap rec) -> vbs) (rec -> bd)) =
   Just $ letRec' top lvbs lbd
   where
-  -- Avoid completely reducing a lambda expression, because recursive
-  -- lets must be guarded.
-  args (v, LamsNamed' vs Ann'{}) = (v, vs)
-  args (v, LamsNamed' vs _) = (v, init vs)
-  args (v, _) = (v, [])
+    -- Avoid completely reducing a lambda expression, because recursive
+    -- lets must be guarded.
+    args (v, LamsNamed' vs Ann' {}) = (v, vs)
+    args (v, LamsNamed' vs _) = (v, init vs)
+    args (v, _) = (v, [])
 
-  Pfx m0 = traverse_ (prefix . snd) vbs *> prefix bd
+    Pfx m0 = traverse_ (prefix . snd) vbs *> prefix bd
 
-  f ls rs = case common ls rs of
-    [] -> Nothing
-    vs -> Just vs
+    f ls rs = case common ls rs of
+      [] -> Nothing
+      vs -> Just vs
 
-  m = Map.map length $ Map.differenceWith f (Map.fromList $ map args vbs) m0
-  lvbs = vbs <&> \(v, b0) -> (,) v $ case b0 of
-    LamsNamed' vs b | Just n <- Map.lookup v m ->
-      lam' (ABT.annotation b0) (drop n vs) (dropPrefixes m b)
-    -- shouldn't happen
-    b -> dropPrefixes m b
-
-  lbd = dropPrefixes m bd
+    m = Map.map length $ Map.differenceWith f (Map.fromList $ map args vbs) m0
+    lvbs =
+      vbs <&> \(v, b0) -> (,) v $ case b0 of
+        LamsNamed' vs b
+          | Just n <- Map.lookup v m ->
+              lam' (ABT.annotation b0) (drop n vs) (dropPrefixes m b)
+        -- shouldn't happen
+        b -> dropPrefixes m b
 
+    lbd = dropPrefixes m bd
 beta rec (Let1NamedTop' top v l@(LamsNamed' vs bd) (rec -> e))
   | n > 0 = Just $ let1' top [(v, lamb)] (dropPrefix v n e)
   | otherwise = Nothing
@@ -311,17 +313,18 @@ beta rec (Let1NamedTop' top v l@(LamsNamed' vs bd) (rec -> e))
     -- Enclosing doesn't create let-bound lambdas, so we
     -- should never reduce a lambda to a non-lambda, as that
     -- could affect evaluation order.
-    m | Ann' _ _ <- bd = length vs
+    m
+      | Ann' _ _ <- bd = length vs
       | otherwise = length vs - 1
     n = min m . length $ appPfx (prefix e) v vs
-
 beta rec (Apps' l@(LamsNamed' vs body) as)
-  | n <- matchVars 0 vs as
-  , n > 0 = Just $ apps' (lam' al (drop n vs) (rec body)) (drop n as)
+  | n <- matchVars 0 vs as,
+    n > 0 =
+      Just $ apps' (lam' al (drop n vs) (rec body)) (drop n as)
   | otherwise = Nothing
   where
     al = ABT.annotation l
-    matchVars !n (u:us) (Var' v : as) | u == v = matchVars (1+n) us as
+    matchVars !n (u : us) (Var' v : as) | u == v = matchVars (1 + n) us as
     matchVars n _ _ = n
 beta _ _ = Nothing
 
diff --git a/parser-typechecker/src/Unison/Runtime/ANF/Serialize.hs b/parser-typechecker/src/Unison/Runtime/ANF/Serialize.hs
index bb802362f..201335dcb 100644
--- a/parser-typechecker/src/Unison/Runtime/ANF/Serialize.hs
+++ b/parser-typechecker/src/Unison/Runtime/ANF/Serialize.hs
@@ -787,7 +787,8 @@ deserializeValue bs = runGetS (getVersion >>= getValue) bs
   where
     getVersion =
       getWord32be >>= \case
-        n | n < 1 -> fail $ "deserializeValue: unknown version: " ++ show n
+        n
+          | n < 1 -> fail $ "deserializeValue: unknown version: " ++ show n
           | n < 3 -> fail $ "deserializeValue: unsupported version: " ++ show n
           | n == 3 -> pure n
           | otherwise -> fail $ "deserializeValue: unknown version: " ++ show n
diff --git a/parser-typechecker/src/Unison/Runtime/Machine.hs b/parser-typechecker/src/Unison/Runtime/Machine.hs
index ad370f744..53e7709e0 100644
--- a/parser-typechecker/src/Unison/Runtime/Machine.hs
+++ b/parser-typechecker/src/Unison/Runtime/Machine.hs
@@ -375,7 +375,7 @@ exec !_ !denv !_activeThreads !ustk !bstk !k _ (BPrim2 CMPU i j) = do
   ustk <- bump ustk
   poke ustk . fromEnum $ universalCompare compare x y
   pure (denv, ustk, bstk, k)
-exec !_   !_    !_activeThreads !_    !bstk !k r (BPrim2 THRO i j) = do
+exec !_ !_ !_activeThreads !_ !bstk !k r (BPrim2 THRO i j) = do
   name <- peekOffBi @Util.Text.Text bstk i
   x <- peekOff bstk j
   throwIO (BU (traceK r k) (Util.Text.toText name) x)
diff --git a/parser-typechecker/src/Unison/Runtime/Serialize.hs b/parser-typechecker/src/Unison/Runtime/Serialize.hs
index dfc8520ff..6382eae29 100644
--- a/parser-typechecker/src/Unison/Runtime/Serialize.hs
+++ b/parser-typechecker/src/Unison/Runtime/Serialize.hs
@@ -15,11 +15,12 @@ import Data.Bytes.VarInt
 import Data.Foldable (traverse_)
 import Data.Int (Int64)
 import Data.Map.Strict as Map (Map, fromList, toList)
+import qualified Data.Primitive as PA
 import Data.Text (Text)
 import Data.Text.Encoding (decodeUtf8, encodeUtf8)
 import qualified Data.Vector.Primitive as BA
-import qualified Data.Primitive as PA
 import Data.Word (Word64, Word8)
+import GHC.Exts as IL (IsList (..))
 import qualified U.Util.Hash as Hash
 import Unison.ConstructorReference (ConstructorReference, GConstructorReference (..))
 import qualified Unison.ConstructorType as CT
@@ -35,7 +36,6 @@ import Unison.Runtime.MCode
   )
 import qualified Unison.Util.Bytes as Bytes
 import Unison.Util.EnumContainers as EC
-import GHC.Exts as IL (IsList(..))
 
 unknownTag :: MonadGet m => String -> Word8 -> m a
 unknownTag t w =
diff --git a/unison-cli/src/Unison/Cli/TypeCheck.hs b/unison-cli/src/Unison/Cli/TypeCheck.hs
index 4674de586..382ad2e41 100644
--- a/unison-cli/src/Unison/Cli/TypeCheck.hs
+++ b/unison-cli/src/Unison/Cli/TypeCheck.hs
@@ -2,7 +2,7 @@ module Unison.Cli.TypeCheck
   ( typecheck,
     typecheckHelper,
     typecheckFile,
-    typecheckTerm
+    typecheckTerm,
   )
 where
 
@@ -20,13 +20,13 @@ import Unison.Parser.Ann (Ann (..))
 import Unison.Prelude
 import qualified Unison.Result as Result
 import qualified Unison.Sqlite as Sqlite
-import Unison.Symbol (Symbol(Symbol))
+import Unison.Symbol (Symbol (Symbol))
 import qualified Unison.Syntax.Lexer as L
 import qualified Unison.Syntax.Parser as Parser
-import Unison.Type (Type)
 import Unison.Term (Term)
-import qualified Unison.Var as Var
+import Unison.Type (Type)
 import qualified Unison.UnisonFile as UF
+import qualified Unison.Var as Var
 
 typecheck ::
   [Type Symbol Ann] ->
@@ -78,15 +78,17 @@ typecheckTerm ::
   Cli
     ( Result.Result
         (Seq (Result.Note Symbol Ann))
-        (Type Symbol Ann))
+        (Type Symbol Ann)
+    )
 typecheckTerm tm = do
-  Cli.Env { codebase } <- ask
+  Cli.Env {codebase} <- ask
   let v = Symbol 0 (Var.Inference Var.Other)
-  liftIO $ fmap extract <$>
-    Codebase.runTransaction codebase (typecheckFile' codebase [] (UF.UnisonFileId mempty mempty [(v, tm)] mempty))
+  liftIO $
+    fmap extract
+      <$> Codebase.runTransaction codebase (typecheckFile' codebase [] (UF.UnisonFileId mempty mempty [(v, tm)] mempty))
   where
     extract tuf
-      | [[(_,_,ty)]] <- UF.topLevelComponents' tuf = ty
+      | [[(_, _, ty)]] <- UF.topLevelComponents' tuf = ty
       | otherwise = error "internal error: typecheckTerm"
 
 typecheckFile' ::
@@ -96,7 +98,8 @@ typecheckFile' ::
   Sqlite.Transaction
     ( Result.Result
         (Seq (Result.Note Symbol Ann))
-        (UF.TypecheckedUnisonFile Symbol Ann))
+        (UF.TypecheckedUnisonFile Symbol Ann)
+    )
 typecheckFile' codebase ambient file = do
   typeLookup <-
     (<> Builtin.typeLookup)
diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs
index 3e6bef4ee..b72c40729 100644
--- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs
+++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs
@@ -20,7 +20,6 @@ import qualified Data.List as List
 import Data.List.Extra (nubOrd)
 import qualified Data.List.NonEmpty as Nel
 import qualified Data.Map as Map
-import Unison.Cli.TypeCheck (typecheck, typecheckTerm)
 import qualified Data.Sequence as Seq
 import qualified Data.Set as Set
 import Data.Set.NonEmpty (NESet)
@@ -29,15 +28,15 @@ import qualified Data.Text as Text
 import Data.Time (UTCTime)
 import Data.Tuple.Extra (uncurry3)
 import qualified System.Console.Regions as Console.Regions
-import System.Process (shell, readCreateProcess, callCommand)
-import System.Environment (withArgs)
 import System.Directory
-  ( createDirectoryIfMissing,
+  ( XdgDirectory (..),
+    createDirectoryIfMissing,
     doesFileExist,
-    XdgDirectory(..),
     getXdgDirectory,
   )
+import System.Environment (withArgs)
 import System.FilePath ((</>))
+import System.Process (callCommand, readCreateProcess, shell)
 import qualified Text.Megaparsec as P
 import qualified U.Codebase.Branch.Diff as V2Branch
 import qualified U.Codebase.Causal as V2Causal
@@ -54,11 +53,12 @@ import qualified Unison.Builtin.Decls as DD
 import qualified Unison.Builtin.Terms as Builtin
 import Unison.Cli.Monad (Cli)
 import qualified Unison.Cli.Monad as Cli
+import qualified Unison.Cli.MonadUtils as Cli
 import Unison.Cli.NamesUtils (basicParseNames, displayNames, findHistoricalHQs, getBasicPrettyPrintNames, makeHistoricalParsingNames, makePrintNamesFromLabeled', makeShadowedPrintNamesFromHQ)
 import Unison.Cli.PrettyPrintUtils (currentPrettyPrintEnvDecl, prettyPrintEnvDecl)
+import Unison.Cli.TypeCheck (typecheck, typecheckTerm)
 import Unison.Cli.UnisonConfigUtils (gitUrlKey, remoteMappingKey)
 import Unison.Codebase (Codebase, Preprocessing (..), PushGitBranchOpts (..))
-import qualified Unison.Cli.MonadUtils as Cli
 import qualified Unison.Codebase as Codebase
 import Unison.Codebase.Branch (Branch (..), Branch0 (..))
 import qualified Unison.Codebase.Branch as Branch
@@ -76,7 +76,10 @@ import Unison.Codebase.Editor.HandleInput.MoveBranch (doMoveBranch)
 import qualified Unison.Codebase.Editor.HandleInput.NamespaceDependencies as NamespaceDependencies
 import Unison.Codebase.Editor.HandleInput.NamespaceDiffUtils (diffHelper)
 import Unison.Codebase.Editor.HandleInput.TermResolution
-  (resolveTermRef, resolveMainRef, resolveCon)
+  ( resolveCon,
+    resolveMainRef,
+    resolveTermRef,
+  )
 import Unison.Codebase.Editor.HandleInput.Update (doSlurpAdds, handleUpdate)
 import Unison.Codebase.Editor.Input
 import qualified Unison.Codebase.Editor.Input as Input
@@ -116,7 +119,6 @@ import qualified Unison.Codebase.Runtime as Runtime
 import qualified Unison.Codebase.ShortCausalHash as SCH
 import qualified Unison.Codebase.SqliteCodebase.Conversions as Cv
 import qualified Unison.Codebase.SyncMode as SyncMode
-import qualified Unison.Syntax.TermPrinter as TP
 import Unison.Codebase.TermEdit (TermEdit (..))
 import qualified Unison.Codebase.TermEdit.Typing as TermEdit
 import Unison.Codebase.Type (GitPushBehavior (..))
@@ -178,6 +180,7 @@ import Unison.Symbol (Symbol)
 import qualified Unison.Sync.Types as Share (Path (..), hashJWTHash)
 import qualified Unison.Syntax.Lexer as L
 import qualified Unison.Syntax.Parser as Parser
+import qualified Unison.Syntax.TermPrinter as TP
 import Unison.Term (Term)
 import qualified Unison.Term as Term
 import Unison.Type (Type)
@@ -385,7 +388,7 @@ loop e = do
               Cli.respond $ PrintMessage pretty
             ShowReflogI -> do
               let numEntriesToShow = 500
-              entries <- 
+              entries <-
                 Cli.runTransaction do
                   schLength <- Codebase.branchHashLength
                   Codebase.getReflog numEntriesToShow <&> fmap (first $ SCH.fromHash schLength)
@@ -1264,8 +1267,8 @@ loop e = do
               ppe <- suffixifiedPPE =<< makePrintNamesFromLabeled' (Patch.labeledDependencies patch)
               Cli.respondNumbered $ ListEdits patch ppe
             PullRemoteBranchI mRepo path sMode pMode verbosity ->
-              inputDescription input >>=
-                doPullRemoteBranch mRepo path sMode pMode verbosity
+              inputDescription input
+                >>= doPullRemoteBranch mRepo path sMode pMode verbosity
             PushRemoteBranchI pushRemoteBranchInput -> handlePushRemoteBranch pushRemoteBranchInput
             ListDependentsI hq -> handleDependents hq
             ListDependenciesI hq -> do
@@ -1378,14 +1381,14 @@ loop e = do
                 traceM $ show name ++ ",Type," ++ Text.unpack (Reference.toText r)
               for_ (Relation.toList . Branch.deepTerms $ rootBranch0) \(r, name) ->
                 traceM $ show name ++ ",Term," ++ Text.unpack (Referent.toText r)
-            DebugClearWatchI {} -> 
+            DebugClearWatchI {} ->
               Cli.runTransaction Codebase.clearWatches
             DebugDoctorI {} -> do
               r <- Cli.runTransaction IntegrityCheck.integrityCheckFullCodebase
               Cli.respond (IntegrityCheck r)
             DebugNameDiffI fromSCH toSCH -> do
               Cli.Env {codebase} <- ask
-              (schLen, fromCHs, toCHs) <- 
+              (schLen, fromCHs, toCHs) <-
                 Cli.runTransaction do
                   schLen <- Codebase.branchHashLength
                   fromCHs <- Codebase.causalHashesByPrefix fromSCH
@@ -2487,62 +2490,67 @@ mergeBranchAndPropagateDefaultPatch mode inputDescription unchangedMessage srcb
 
 basicPPE :: Cli PPE.PrettyPrintEnv
 basicPPE = do
-  parseNames <- 
+  parseNames <-
     flip NamesWithHistory.NamesWithHistory mempty
       <$> basicParseNames
   suffixifiedPPE parseNames
 
 compilerPath :: Path.Path'
-compilerPath = Path.Path' { Path.unPath' = Left abs }
+compilerPath = Path.Path' {Path.unPath' = Left abs}
   where
-  segs = NameSegment <$> ["unison", "internal"]
-  rootPath = Path.Path { Path.toSeq = Seq.fromList segs }
-  abs = Path.Absolute { Path.unabsolute = rootPath }
+    segs = NameSegment <$> ["unison", "internal"]
+    rootPath = Path.Path {Path.toSeq = Seq.fromList segs}
+    abs = Path.Absolute {Path.unabsolute = rootPath}
 
 doFetchCompiler :: Cli ()
 doFetchCompiler =
-  inputDescription pullInput >>=
-    doPullRemoteBranch
-      repo compilerPath
-      SyncMode.Complete
-      Input.PullWithoutHistory
-      Verbosity.Silent
-  where
-  -- fetching info
-  ns = ReadShareRemoteNamespace
-     { server = RemoteRepo.DefaultCodeserver
-     , repo = "dolio"
-     , path =
-         Path.fromList $ NameSegment <$> ["public", "internal", "trunk"]
-     }
-  repo = Just $ ReadRemoteNamespaceShare ns
-
-  pullInput =
-    PullRemoteBranchI
+  inputDescription pullInput
+    >>= doPullRemoteBranch
       repo
       compilerPath
       SyncMode.Complete
       Input.PullWithoutHistory
       Verbosity.Silent
+  where
+    -- fetching info
+    ns =
+      ReadShareRemoteNamespace
+        { server = RemoteRepo.DefaultCodeserver,
+          repo = "dolio",
+          path =
+            Path.fromList $ NameSegment <$> ["public", "internal", "trunk"]
+        }
+    repo = Just $ ReadRemoteNamespaceShare ns
+
+    pullInput =
+      PullRemoteBranchI
+        repo
+        compilerPath
+        SyncMode.Complete
+        Input.PullWithoutHistory
+        Verbosity.Silent
 
 ensureCompilerExists :: Cli ()
 ensureCompilerExists =
-  Cli.branchExistsAtPath' compilerPath >>=
-    flip unless doFetchCompiler
+  Cli.branchExistsAtPath' compilerPath
+    >>= flip unless doFetchCompiler
 
 getCacheDir :: Cli String
 getCacheDir = liftIO $ getXdgDirectory XdgCache "unisonlanguage"
 
 getSchemeGenLibDir :: Cli String
-getSchemeGenLibDir = Cli.getConfig "SchemeLibs.Generated" >>= \case
-  Just dir -> pure dir
-  Nothing -> (</> "scheme-libs") <$> getCacheDir
+getSchemeGenLibDir =
+  Cli.getConfig "SchemeLibs.Generated" >>= \case
+    Just dir -> pure dir
+    Nothing -> (</> "scheme-libs") <$> getCacheDir
 
 getSchemeStaticLibDir :: Cli String
-getSchemeStaticLibDir = Cli.getConfig "SchemeLibs.Static" >>= \case
-  Just dir -> pure dir
-  Nothing -> liftIO $
-    getXdgDirectory XdgData ("unisonlanguage" </> "scheme-libs")
+getSchemeStaticLibDir =
+  Cli.getConfig "SchemeLibs.Static" >>= \case
+    Just dir -> pure dir
+    Nothing ->
+      liftIO $
+        getXdgDirectory XdgData ("unisonlanguage" </> "scheme-libs")
 
 doGenerateSchemeBoot :: Bool -> Maybe PPE.PrettyPrintEnv -> Cli ()
 doGenerateSchemeBoot force mppe = do
@@ -2556,20 +2564,20 @@ doGenerateSchemeBoot force mppe = do
   gen ppe saveBase bootf dirTm bootName
   gen ppe saveBase binf dirTm builtinName
   where
-  a = External
-  hq nm
-    | Just hqn <- HQ.fromString nm = hqn
-    | otherwise = error $ "internal error: cannot hash qualify: " ++ nm
+    a = External
+    hq nm
+      | Just hqn <- HQ.fromString nm = hqn
+      | otherwise = error $ "internal error: cannot hash qualify: " ++ nm
 
-  sbName = hq ".unison.internal.compiler.scheme.saveBaseFile"
-  bootName = hq ".unison.internal.compiler.scheme.bootSpec"
-  builtinName = hq ".unison.internal.compiler.scheme.builtinSpec"
+    sbName = hq ".unison.internal.compiler.scheme.saveBaseFile"
+    bootName = hq ".unison.internal.compiler.scheme.bootSpec"
+    builtinName = hq ".unison.internal.compiler.scheme.builtinSpec"
 
-  gen ppe save file dir nm =
-    liftIO (doesFileExist file) >>= \b -> when (not b || force) do
-      spec <- Term.ref a <$> resolveTermRef nm
-      let make = Term.apps' save [dir, spec]
-      typecheckAndEval ppe make
+    gen ppe save file dir nm =
+      liftIO (doesFileExist file) >>= \b -> when (not b || force) do
+        spec <- Term.ref a <$> resolveTermRef nm
+        let make = Term.apps' save [dir, spec]
+        typecheckAndEval ppe make
 
 typecheckAndEval :: PPE.PrettyPrintEnv -> Term Symbol Ann -> Cli ()
 typecheckAndEval ppe tm = do
@@ -2579,16 +2587,16 @@ typecheckAndEval ppe tm = do
     -- Type checking succeeded
     Result.Result _ (Just ty)
       | Typechecker.fitsScheme ty mty ->
-        () <$ evalUnisonTerm False ppe False tm
+          () <$ evalUnisonTerm False ppe False tm
       | otherwise ->
-        Cli.returnEarly $ BadMainFunction rendered ty ppe [mty]
+          Cli.returnEarly $ BadMainFunction rendered ty ppe [mty]
     Result.Result notes Nothing -> do
       currentPath <- Cli.getCurrentPath
-      let tes = [ err | Result.TypeError err <- toList notes ]
+      let tes = [err | Result.TypeError err <- toList notes]
       Cli.returnEarly (TypeErrors currentPath (Text.pack rendered) ppe tes)
   where
-  a = External
-  rendered = P.toPlainUnbroken $ TP.pretty ppe tm
+    a = External
+    rendered = P.toPlainUnbroken $ TP.pretty ppe tm
 
 runScheme :: String -> Cli ()
 runScheme file = do
@@ -2599,8 +2607,9 @@ runScheme file = do
       opt = "--optimize-level 3"
       cmd = "scheme -q " ++ opt ++ " " ++ lib ++ " --script " ++ file
   success <-
-    liftIO $ (True <$ callCommand cmd) `catch` \(_ :: IOException) ->
-      pure False
+    liftIO $
+      (True <$ callCommand cmd) `catch` \(_ :: IOException) ->
+        pure False
   unless success $
     Cli.returnEarly (PrintMessage "Scheme evaluation failed.")
 
@@ -2611,23 +2620,23 @@ buildScheme main file = do
   let cmd = shell "scheme -q --optimize-level 3"
   void . liftIO $ readCreateProcess cmd (build statDir genDir)
   where
-  surround s = '"' : s ++ "\""
-  parens s = '(' : s ++ ")"
-  lns dir nms = surround . ln dir <$> nms
-  ln dir nm = dir </> "unison" </> (nm ++ ".ss")
+    surround s = '"' : s ++ "\""
+    parens s = '(' : s ++ ")"
+    lns dir nms = surround . ln dir <$> nms
+    ln dir nm = dir </> "unison" </> (nm ++ ".ss")
 
-  static = ["core", "cont", "bytevector", "string", "primops", "boot"]
-  gen = ["boot-generated", "builtin-generated"]
+    static = ["core", "cont", "bytevector", "string", "primops", "boot"]
+    gen = ["boot-generated", "builtin-generated"]
 
-  bootf = surround $ main ++ ".boot"
-  base = "'(\"scheme\" \"petite\")"
-
-  build sd gd = parens . List.intercalate " " $
-    ["make-boot-file",bootf,base] ++
-    lns sd static ++
-    lns gd gen ++
-    [surround file]
+    bootf = surround $ main ++ ".boot"
+    base = "'(\"scheme\" \"petite\")"
 
+    build sd gd =
+      parens . List.intercalate " " $
+        ["make-boot-file", bootf, base]
+          ++ lns sd static
+          ++ lns gd gen
+          ++ [surround file]
 
 doRunAsScheme :: HQ.HashQualified Name -> Cli ()
 doRunAsScheme main = do
@@ -2659,22 +2668,22 @@ generateSchemeFile out main = do
   typecheckAndEval ppe tm
   pure fullpath
   where
-  a = External
-  hq nm
-    | Just hqn <- HQ.fromString nm = hqn
-    | otherwise = error $ "internal error: cannot hash qualify: " ++ nm
+    a = External
+    hq nm
+      | Just hqn <- HQ.fromString nm = hqn
+      | otherwise = error $ "internal error: cannot hash qualify: " ++ nm
 
-  saveNm = hq ".unison.internal.compiler.saveScheme"
-  filePathNm = hq "FilePath.FilePath"
+    saveNm = hq ".unison.internal.compiler.saveScheme"
+    filePathNm = hq "FilePath.FilePath"
 
-doPullRemoteBranch
-  :: Maybe ReadRemoteNamespace
-  -> Path'
-  -> SyncMode.SyncMode
-  -> PullMode
-  -> Verbosity.Verbosity
-  -> Text
-  -> Cli ()
+doPullRemoteBranch ::
+  Maybe ReadRemoteNamespace ->
+  Path' ->
+  SyncMode.SyncMode ->
+  PullMode ->
+  Verbosity.Verbosity ->
+  Text ->
+  Cli ()
 doPullRemoteBranch mayRepo path syncMode pullMode verbosity description = do
   Cli.Env {codebase} <- ask
   let preprocess = case pullMode of
diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/TermResolution.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/TermResolution.hs
index 24e5cf900..7a3c2498a 100644
--- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/TermResolution.hs
+++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/TermResolution.hs
@@ -1,39 +1,40 @@
-
 module Unison.Codebase.Editor.HandleInput.TermResolution
-  ( lookupTermRefs
-  , lookupTermRefWithType
-  , resolveCon
-  , resolveTerm
-  , resolveTermRef
-  , resolveMainRef
-  ) where
+  ( lookupTermRefs,
+    lookupTermRefWithType,
+    resolveCon,
+    resolveTerm,
+    resolveTermRef,
+    resolveMainRef,
+  )
+where
 
-import Control.Monad.Trans (liftIO)
 import Control.Monad.Reader (ask)
+import Control.Monad.Trans (liftIO)
 import Data.Maybe (catMaybes, fromJust)
-import Data.Set (toList, fromList)
-
-import qualified Unison.HashQualified as HQ
+import Data.Set (fromList, toList)
+import Unison.Cli.Monad (Cli)
+import qualified Unison.Cli.Monad as Cli
+import Unison.Cli.NamesUtils (basicParseNames, basicPrettyPrintNamesA)
+import qualified Unison.Codebase as Codebase
+import Unison.Codebase.Editor.Output (Output (..))
+import Unison.Codebase.Path (hqSplitFromName')
+import qualified Unison.Codebase.Runtime as Runtime
 import Unison.ConstructorReference
+import qualified Unison.HashQualified as HQ
 import Unison.Name (Name)
 import Unison.Names (Names)
 import Unison.NamesWithHistory
-  (NamesWithHistory(..), lookupHQTerm)
-import Unison.Reference (Reference)
-import Unison.Referent (Referent, pattern Ref, pattern Con)
-import Unison.Codebase.Path (hqSplitFromName')
-import Unison.Cli.Monad (Cli)
-import Unison.Cli.NamesUtils (basicParseNames,basicPrettyPrintNamesA)
+  ( NamesWithHistory (..),
+    lookupHQTerm,
+  )
 import Unison.Parser.Ann (Ann)
 import Unison.PrettyPrintEnv (PrettyPrintEnv)
 import Unison.PrettyPrintEnv.Names (fromSuffixNames)
-import qualified Unison.Codebase as Codebase
-import Unison.Codebase.Editor.Output (Output(..))
-import qualified Unison.Codebase.Runtime as Runtime
-import qualified Unison.Typechecker as Typechecker
-import qualified Unison.Cli.Monad as Cli
+import Unison.Reference (Reference)
+import Unison.Referent (Referent, pattern Con, pattern Ref)
 import Unison.Symbol (Symbol)
 import Unison.Type (Type)
+import qualified Unison.Typechecker as Typechecker
 
 addHistory :: Names -> NamesWithHistory
 addHistory names = NamesWithHistory names mempty
@@ -43,62 +44,69 @@ lookupTerm hq parseNames = toList (lookupHQTerm hq hnames)
   where
     hnames = addHistory parseNames
 
-lookupCon
-  :: HQ.HashQualified Name
-  -> Names
-  -> ([ConstructorReference], [Referent])
+lookupCon ::
+  HQ.HashQualified Name ->
+  Names ->
+  ([ConstructorReference], [Referent])
 lookupCon hq parseNames =
   unzip . catMaybes . fmap extract $ lookupTerm hq parseNames
   where
     extract rt@(Con rf _) = Just (rf, rt)
     extract _ = Nothing
 
-lookupTermRefs
-  :: HQ.HashQualified Name -> Names -> ([Reference], [Referent])
+lookupTermRefs ::
+  HQ.HashQualified Name -> Names -> ([Reference], [Referent])
 lookupTermRefs hq parseNames =
   unzip . catMaybes . fmap extract $ lookupTerm hq parseNames
   where
     extract rt@(Ref rf) = Just (rf, rt)
     extract _ = Nothing
 
-lookupTermRefWithType
-  :: Codebase.Codebase IO Symbol Ann
-  -> HQ.HashQualified Name
-  -> Cli [(Reference,Type Symbol Ann)]
+lookupTermRefWithType ::
+  Codebase.Codebase IO Symbol Ann ->
+  HQ.HashQualified Name ->
+  Cli [(Reference, Type Symbol Ann)]
 lookupTermRefWithType codebase name = do
   nms <- basicParseNames
-  liftIO .
-    Codebase.runTransaction codebase .
-    fmap catMaybes .
-    traverse annot .
-    fst $ lookupTermRefs name nms
+  liftIO
+    . Codebase.runTransaction codebase
+    . fmap catMaybes
+    . traverse annot
+    . fst
+    $ lookupTermRefs name nms
   where
     annot tm =
       fmap ((,) tm) <$> Codebase.getTypeOfTerm codebase tm
 
 resolveTerm :: HQ.HashQualified Name -> Cli Referent
-resolveTerm name = basicParseNames >>= \nms ->
-  case lookupTerm name nms of
-    [] -> Cli.returnEarly (TermNotFound $ fromJust parsed)
-      where parsed = hqSplitFromName' =<< HQ.toName name
-    [rf] -> pure rf
-    rfs -> Cli.returnEarly (TermAmbiguous name (fromList rfs))
+resolveTerm name =
+  basicParseNames >>= \nms ->
+    case lookupTerm name nms of
+      [] -> Cli.returnEarly (TermNotFound $ fromJust parsed)
+        where
+          parsed = hqSplitFromName' =<< HQ.toName name
+      [rf] -> pure rf
+      rfs -> Cli.returnEarly (TermAmbiguous name (fromList rfs))
 
 resolveCon :: HQ.HashQualified Name -> Cli ConstructorReference
-resolveCon name = basicParseNames >>= \nms ->
-  case lookupCon name nms of
-    ([], _) -> Cli.returnEarly (TermNotFound $ fromJust parsed)
-      where parsed = hqSplitFromName' =<< HQ.toName name
-    ([co], _) -> pure co
-    (_, rfts) -> Cli.returnEarly (TermAmbiguous name (fromList rfts))
+resolveCon name =
+  basicParseNames >>= \nms ->
+    case lookupCon name nms of
+      ([], _) -> Cli.returnEarly (TermNotFound $ fromJust parsed)
+        where
+          parsed = hqSplitFromName' =<< HQ.toName name
+      ([co], _) -> pure co
+      (_, rfts) -> Cli.returnEarly (TermAmbiguous name (fromList rfts))
 
 resolveTermRef :: HQ.HashQualified Name -> Cli Reference
-resolveTermRef name = basicParseNames >>= \nms ->
-  case lookupTermRefs name nms of
-    ([], _) -> Cli.returnEarly (TermNotFound $ fromJust parsed)
-      where parsed = hqSplitFromName' =<< HQ.toName name
-    ([rf], _) -> pure rf
-    (_, rfts) -> Cli.returnEarly (TermAmbiguous name (fromList rfts))
+resolveTermRef name =
+  basicParseNames >>= \nms ->
+    case lookupTermRefs name nms of
+      ([], _) -> Cli.returnEarly (TermNotFound $ fromJust parsed)
+        where
+          parsed = hqSplitFromName' =<< HQ.toName name
+      ([rf], _) -> pure rf
+      (_, rfts) -> Cli.returnEarly (TermAmbiguous name (fromList rfts))
 
 resolveMainRef :: HQ.HashQualified Name -> Cli (Reference, PrettyPrintEnv)
 resolveMainRef main = do
@@ -113,4 +121,3 @@ resolveMainRef main = do
       | Typechecker.fitsScheme ty mainType -> pure (rf, ppe)
       | otherwise -> Cli.returnEarly (BadMainFunction smain ty ppe [mainType])
     _ -> Cli.returnEarly (NoMainFunction smain ppe [mainType])
-
diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs
index e0644858f..629746c73 100644
--- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs
+++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs
@@ -2172,13 +2172,14 @@ schemeLibgen =
     ( P.wrapColumn2
         [ ( makeExample schemeLibgen [],
             "Generates libraries necessary for scheme compilation.\n\n\
-            \There is no need to run this before" <>
-            P.group (makeExample compileScheme []) <> "as\
-            \ the latter will check if the libraries are missing and\
-            \ auto-generate them. However, this will generate the\
-            \ libraries even if their files already exist, so if the\
-            \ compiler has been upgraded, this can be used to ensure\
-            \ the generated libraries are up to date."
+            \There is no need to run this before"
+              <> P.group (makeExample compileScheme [])
+              <> "as\
+                 \ the latter will check if the libraries are missing and\
+                 \ auto-generate them. However, this will generate the\
+                 \ libraries even if their files already exist, so if the\
+                 \ compiler has been upgraded, this can be used to ensure\
+                 \ the generated libraries are up to date."
           )
         ]
     )
@@ -2197,11 +2198,12 @@ fetchScheme =
     ( P.wrapColumn2
         [ ( makeExample fetchScheme [],
             "Fetches the unison library for compiling to scheme.\n\n\
-            \This is done automatically when" <>
-            P.group (makeExample compileScheme []) <> "is run\
-            \ if the library is not already in the standard location\
-            \ (unison.internal). However, this command will force\
-            \ a pull even if the library already exists."
+            \This is done automatically when"
+              <> P.group (makeExample compileScheme [])
+              <> "is run\
+                 \ if the library is not already in the standard location\
+                 \ (unison.internal). However, this command will force\
+                 \ a pull even if the library already exists."
           )
         ]
     )

From 4947186e2319a2e53e082671071fb03e29b5345e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?R=C3=BAnar?= <runarorama@gmail.com>
Date: Mon, 21 Nov 2022 14:25:11 -0500
Subject: [PATCH 26/41] Indent after newline in pattern lists

---
 .../src/Unison/Syntax/TermPrinter.hs          |  2 +-
 unison-src/transcripts-round-trip/main.md     | 23 +++++++
 .../transcripts-round-trip/main.output.md     | 60 +++++++++++++++++++
 3 files changed, 84 insertions(+), 1 deletion(-)

diff --git a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs
index 114180894..71fd58aaa 100644
--- a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs
+++ b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs
@@ -732,7 +732,7 @@ printCase im doc ms0 = PP.lines . alignGrid <$> grid
     patLhs env vs pats =
       case pats of
         [pat] -> PP.group (fst (prettyPattern env (ac 0 Block im doc) (-1) vs pat))
-        pats -> PP.group . PP.sep ("," <> PP.softbreak)
+        pats -> PP.group . PP.sep (PP.indentAfterNewline "  " $ "," <> PP.softbreak)
           . (`evalState` vs)
           . for pats
           $ \pat -> do
diff --git a/unison-src/transcripts-round-trip/main.md b/unison-src/transcripts-round-trip/main.md
index bf5034086..9870461a7 100644
--- a/unison-src/transcripts-round-trip/main.md
+++ b/unison-src/transcripts-round-trip/main.md
@@ -484,3 +484,26 @@ Regression test for https://github.com/unisonweb/unison/pull/3548
 ```ucm
 .> load scratch.u
 ```
+
+# Indent long pattern lists to avoid virtual semicolon
+
+Regression test for https://github.com/unisonweb/unison/issues/3627
+
+```unison:hide
+(+) a b = ##Nat.+ a b
+
+foo = cases
+  aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa,
+   bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
+    -> aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
+```
+
+```ucm
+.> add
+.> edit foo
+.> undo
+```
+
+```ucm
+.> load scratch.u
+```
\ No newline at end of file
diff --git a/unison-src/transcripts-round-trip/main.output.md b/unison-src/transcripts-round-trip/main.output.md
index ff053e273..9f8099478 100644
--- a/unison-src/transcripts-round-trip/main.output.md
+++ b/unison-src/transcripts-round-trip/main.output.md
@@ -1469,3 +1469,63 @@ Regression test for https://github.com/unisonweb/unison/pull/3548
   I loaded scratch.u and didn't find anything.
 
 ```
+# Indent long pattern lists to avoid virtual semicolon
+
+Regression test for https://github.com/unisonweb/unison/issues/3627
+
+```unison
+(+) a b = ##Nat.+ a b
+
+foo = cases
+  aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa,
+   bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
+    -> aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
+```
+
+```ucm
+.> add
+
+  ⍟ I've added these definitions:
+  
+    +   : Nat -> Nat -> Nat
+    foo : Nat -> Nat -> Nat
+
+.> edit foo
+
+  ☝️
+  
+  I added these definitions to the top of
+  /Users/runar/work/unison/scratch.u
+  
+    foo : Nat -> Nat -> Nat
+    foo = cases
+      aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa,
+        bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb ->
+        aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
+          + bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
+  
+  You can edit them there, then do `update` to replace the
+  definitions currently in this namespace.
+
+.> undo
+
+  Here are the changes I undid
+  
+  Added definitions:
+  
+    1. +   : Nat -> Nat -> Nat
+    2. foo : Nat -> Nat -> Nat
+
+```
+```ucm
+.> load scratch.u
+
+  I found and typechecked these definitions in scratch.u. If you
+  do an `add` or `update`, here's how your codebase would
+  change:
+  
+    ⍟ These new definitions are ok to `add`:
+    
+      foo : Nat -> Nat -> Nat
+
+```

From 963259a6ae9a4ee867d7d36efa269a8a45b7d039 Mon Sep 17 00:00:00 2001
From: Mitchell Rosen <mitchellwrosen@gmail.com>
Date: Mon, 21 Nov 2022 15:14:19 -0500
Subject: [PATCH 27/41] delete prelude-extras

---
 parser-typechecker/package.yaml               |   1 -
 .../unison-parser-typechecker.cabal           |   2 -
 stack.yaml                                    |   1 -
 stack.yaml.lock                               | 131 +++++++++---------
 unison-core/package.yaml                      |   1 -
 unison-core/src/Unison/DataDeclaration.hs     |   3 +-
 unison-core/src/Unison/Term.hs                |   5 -
 unison-core/src/Unison/Type.hs                |   7 -
 unison-core/unison-core1.cabal                |   1 -
 9 files changed, 63 insertions(+), 89 deletions(-)

diff --git a/parser-typechecker/package.yaml b/parser-typechecker/package.yaml
index 8c2949c36..cab461185 100644
--- a/parser-typechecker/package.yaml
+++ b/parser-typechecker/package.yaml
@@ -73,7 +73,6 @@ dependencies:
   - openapi3
   - optparse-applicative >= 0.16.1.0
   - pem
-  - prelude-extras
   - pretty-simple
   - primitive
   - process
diff --git a/parser-typechecker/unison-parser-typechecker.cabal b/parser-typechecker/unison-parser-typechecker.cabal
index 5652aaf4e..5af0be66b 100644
--- a/parser-typechecker/unison-parser-typechecker.cabal
+++ b/parser-typechecker/unison-parser-typechecker.cabal
@@ -240,7 +240,6 @@ library
     , openapi3
     , optparse-applicative >=0.16.1.0
     , pem
-    , prelude-extras
     , pretty-simple
     , primitive
     , process
@@ -426,7 +425,6 @@ test-suite parser-typechecker-tests
     , openapi3
     , optparse-applicative >=0.16.1.0
     , pem
-    , prelude-extras
     , pretty-simple
     , primitive
     , process
diff --git a/stack.yaml b/stack.yaml
index 83716f37d..57fcf9bb3 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -54,7 +54,6 @@ extra-deps:
 - github: judah/haskeline
   commit: d6c2643b0d5c19be7e440615c6f84d603d4bc648
 - guid-0.1.0@sha256:a7c975be473f6f142d5cc1b39bc807a99043d20b1bb0873fdfe7a3ce84d2faf1,1078
-- prelude-extras-0.4.0.3@sha256:1c10b0123ea13a6423d74a8fcbaeb2d5249b472588abde418a36b47b7c4f48c8,1163
 - sandi-0.5@sha256:b278d072ca717706ea38f9bd646e023f7f2576a778fb43565b434f93638849aa,3010
 - strings-1.1@sha256:0285dec4c8ab262359342b3e5ef1eb567074669461b9b38404f1cb870c881c5c,1617
 - fuzzyfind-3.0.0@sha256:d79a5d3ed194dd436c6b839bf187211d880cf773b2febaca456e5ccf93f5ac65,1814
diff --git a/stack.yaml.lock b/stack.yaml.lock
index 22747c804..76e93091c 100644
--- a/stack.yaml.lock
+++ b/stack.yaml.lock
@@ -5,173 +5,166 @@
 
 packages:
 - completed:
-    sha256: d4fd87fb7bfc5d8e9fbc3e4ee7302c6b1500cdc00fdb9b659d0f4849b6ebe2d5
-    name: configurator
     size: 15989
     url: https://github.com/unisonweb/configurator/archive/e47e9e9fe1f576f8c835183b9def52d73c01327a.tar.gz
-    pantry-tree:
-      sha256: 90547cd983fd15ebdc803e057d3ef8735fe93a75e29a00f8a74eadc13ee0f6e9
-      size: 955
+    name: configurator
     version: 0.3.0.0
+    sha256: d4fd87fb7bfc5d8e9fbc3e4ee7302c6b1500cdc00fdb9b659d0f4849b6ebe2d5
+    pantry-tree:
+      size: 955
+      sha256: 90547cd983fd15ebdc803e057d3ef8735fe93a75e29a00f8a74eadc13ee0f6e9
   original:
     url: https://github.com/unisonweb/configurator/archive/e47e9e9fe1f576f8c835183b9def52d73c01327a.tar.gz
 - completed:
-    sha256: 6e642163070a217cc3363bdbefde571ff6c1878f4fc3d92e9c910db7fa88eaf2
-    name: shellmet
     size: 10460
     url: https://github.com/unisonweb/shellmet/archive/2fd348592c8f51bb4c0ca6ba4bc8e38668913746.tar.gz
-    pantry-tree:
-      sha256: 05a169a7a6b68100630e885054dc1821d31cd06571b0317ec90c75ac2c41aeb7
-      size: 654
+    name: shellmet
     version: 0.0.4.0
+    sha256: 6e642163070a217cc3363bdbefde571ff6c1878f4fc3d92e9c910db7fa88eaf2
+    pantry-tree:
+      size: 654
+      sha256: 05a169a7a6b68100630e885054dc1821d31cd06571b0317ec90c75ac2c41aeb7
   original:
     url: https://github.com/unisonweb/shellmet/archive/2fd348592c8f51bb4c0ca6ba4bc8e38668913746.tar.gz
 - completed:
-    sha256: a45eb3dbe7333c108aef4afce7f763c7661919b09641ef9d241c7ca4a78bf735
-    name: ki
-    subdir: ki
     size: 15840
+    subdir: ki
     url: https://github.com/awkward-squad/ki/archive/563e96238dfe392dccf68d93953c8f30fd53bec8.tar.gz
-    pantry-tree:
-      sha256: c63220c438c076818e09061b117c56055e154f6abb66ea9bc44a3900fcabd654
-      size: 704
+    name: ki
     version: 1.0.0
+    sha256: a45eb3dbe7333c108aef4afce7f763c7661919b09641ef9d241c7ca4a78bf735
+    pantry-tree:
+      size: 704
+      sha256: c63220c438c076818e09061b117c56055e154f6abb66ea9bc44a3900fcabd654
   original:
     subdir: ki
     url: https://github.com/awkward-squad/ki/archive/563e96238dfe392dccf68d93953c8f30fd53bec8.tar.gz
 - completed:
-    sha256: ef827ea5e8581cd68da9600660b2e584877d4fcdcf1cd2eb4652e0e51d817465
-    name: haskeline
     size: 74363
     url: https://github.com/judah/haskeline/archive/d6c2643b0d5c19be7e440615c6f84d603d4bc648.tar.gz
-    pantry-tree:
-      sha256: e30301b5389893948e25d39978d09948b11479b5b2a3517b978466fde548fc48
-      size: 3769
+    name: haskeline
     version: 0.8.0.0
+    sha256: ef827ea5e8581cd68da9600660b2e584877d4fcdcf1cd2eb4652e0e51d817465
+    pantry-tree:
+      size: 3769
+      sha256: e30301b5389893948e25d39978d09948b11479b5b2a3517b978466fde548fc48
   original:
     url: https://github.com/judah/haskeline/archive/d6c2643b0d5c19be7e440615c6f84d603d4bc648.tar.gz
 - completed:
+    hackage: guid-0.1.0@sha256:a7c975be473f6f142d5cc1b39bc807a99043d20b1bb0873fdfe7a3ce84d2faf1,1078
     pantry-tree:
-      sha256: a33838b7b1c54f6ac3e1b436b25674948713a4189658e4d82e639b9a689bc90d
       size: 364
-    hackage: guid-0.1.0@sha256:a7c975be473f6f142d5cc1b39bc807a99043d20b1bb0873fdfe7a3ce84d2faf1,1078
+      sha256: a33838b7b1c54f6ac3e1b436b25674948713a4189658e4d82e639b9a689bc90d
   original:
     hackage: guid-0.1.0@sha256:a7c975be473f6f142d5cc1b39bc807a99043d20b1bb0873fdfe7a3ce84d2faf1,1078
 - completed:
+    hackage: sandi-0.5@sha256:b278d072ca717706ea38f9bd646e023f7f2576a778fb43565b434f93638849aa,3010
     pantry-tree:
-      sha256: a03f60a1250c9d0daaf208ba58ccf24e05e0807f2e3dc7892fad3f2f3a196f7f
-      size: 476
-    hackage: prelude-extras-0.4.0.3@sha256:1c10b0123ea13a6423d74a8fcbaeb2d5249b472588abde418a36b47b7c4f48c8,1163
-  original:
-    hackage: prelude-extras-0.4.0.3@sha256:1c10b0123ea13a6423d74a8fcbaeb2d5249b472588abde418a36b47b7c4f48c8,1163
-- completed:
-    pantry-tree:
-      sha256: 5ca7ce4bc22ab9d4427bb149b5e283ab9db43375df14f7131fdfd48775f36350
       size: 3455
-    hackage: sandi-0.5@sha256:b278d072ca717706ea38f9bd646e023f7f2576a778fb43565b434f93638849aa,3010
+      sha256: 5ca7ce4bc22ab9d4427bb149b5e283ab9db43375df14f7131fdfd48775f36350
   original:
     hackage: sandi-0.5@sha256:b278d072ca717706ea38f9bd646e023f7f2576a778fb43565b434f93638849aa,3010
 - completed:
+    hackage: strings-1.1@sha256:0285dec4c8ab262359342b3e5ef1eb567074669461b9b38404f1cb870c881c5c,1617
     pantry-tree:
-      sha256: 876e5a679244143e2a7e74357427c7522a8d61f68a4cc3ae265fe4960b75a2e2
       size: 212
-    hackage: strings-1.1@sha256:0285dec4c8ab262359342b3e5ef1eb567074669461b9b38404f1cb870c881c5c,1617
+      sha256: 876e5a679244143e2a7e74357427c7522a8d61f68a4cc3ae265fe4960b75a2e2
   original:
     hackage: strings-1.1@sha256:0285dec4c8ab262359342b3e5ef1eb567074669461b9b38404f1cb870c881c5c,1617
 - completed:
+    hackage: fuzzyfind-3.0.0@sha256:d79a5d3ed194dd436c6b839bf187211d880cf773b2febaca456e5ccf93f5ac65,1814
     pantry-tree:
-      sha256: 0e6c6d4f89083c8385de5adc4f36ad01b2b0ff45261b47f7d90d919969c8b5ed
       size: 542
-    hackage: fuzzyfind-3.0.0@sha256:d79a5d3ed194dd436c6b839bf187211d880cf773b2febaca456e5ccf93f5ac65,1814
+      sha256: 0e6c6d4f89083c8385de5adc4f36ad01b2b0ff45261b47f7d90d919969c8b5ed
   original:
     hackage: fuzzyfind-3.0.0@sha256:d79a5d3ed194dd436c6b839bf187211d880cf773b2febaca456e5ccf93f5ac65,1814
 - completed:
+    hackage: monad-validate-1.2.0.0@sha256:9850f408431098b28806dd464b6825a88a0b56c84f380d7fe0454c1df9d6f881,3505
     pantry-tree:
-      sha256: 8e049bd12ce2bd470909578f2ee8eb80b89d5ff88860afa30e29dd4eafecfa3e
       size: 713
-    hackage: monad-validate-1.2.0.0@sha256:9850f408431098b28806dd464b6825a88a0b56c84f380d7fe0454c1df9d6f881,3505
+      sha256: 8e049bd12ce2bd470909578f2ee8eb80b89d5ff88860afa30e29dd4eafecfa3e
   original:
     hackage: monad-validate-1.2.0.0@sha256:9850f408431098b28806dd464b6825a88a0b56c84f380d7fe0454c1df9d6f881,3505
 - completed:
+    hackage: NanoID-3.1.0@sha256:9118ab00e8650b5a56a10c90295d357eb77a8057a598b7e56dfedc9c6d53c77d,1524
     pantry-tree:
-      sha256: d33d603a2f0d1a220ff0d5e7edb6273def89120e6bb958c2d836cae89e788334
       size: 363
-    hackage: NanoID-3.1.0@sha256:9118ab00e8650b5a56a10c90295d357eb77a8057a598b7e56dfedc9c6d53c77d,1524
+      sha256: d33d603a2f0d1a220ff0d5e7edb6273def89120e6bb958c2d836cae89e788334
   original:
     hackage: NanoID-3.1.0@sha256:9118ab00e8650b5a56a10c90295d357eb77a8057a598b7e56dfedc9c6d53c77d,1524
 - completed:
-    pantry-tree:
-      sha256: c7f5afe70db567e2cf9f3119b49f4b402705e6bd08ed8ba98747a64a8a0bef41
-      size: 770
     hackage: direct-sqlite-2.3.27@sha256:94207d3018da3bda84bc6ce00d2c0236ced7edb37afbd726ed2a0bfa236e149b,3771
+    pantry-tree:
+      size: 770
+      sha256: c7f5afe70db567e2cf9f3119b49f4b402705e6bd08ed8ba98747a64a8a0bef41
   original:
     hackage: direct-sqlite-2.3.27
 - completed:
+    hackage: recover-rtti-0.4.0.0@sha256:2ce1e031ec0e34d736fa45f0149bbd55026f614939dc90ffd14a9c5d24093ff4,4423
     pantry-tree:
-      sha256: d87d84c3f760c1b2540f74e4a301cd4e8294df891e8e4262e8bdd313bc8e0bfd
       size: 2410
-    hackage: recover-rtti-0.4.0.0@sha256:2ce1e031ec0e34d736fa45f0149bbd55026f614939dc90ffd14a9c5d24093ff4,4423
+      sha256: d87d84c3f760c1b2540f74e4a301cd4e8294df891e8e4262e8bdd313bc8e0bfd
   original:
     hackage: recover-rtti-0.4.0.0@sha256:2ce1e031ec0e34d736fa45f0149bbd55026f614939dc90ffd14a9c5d24093ff4,4423
 - completed:
+    hackage: lock-file-0.7.0.0@sha256:3ad84b5e454145e1d928063b56abb96db24a99a21b493989520e58fa0ab37b00,4484
     pantry-tree:
-      sha256: 3634593ce191e82793ea0e060598ab3cf67f2ef2fe1d65345dc9335ad529d25f
       size: 718
-    hackage: lock-file-0.7.0.0@sha256:3ad84b5e454145e1d928063b56abb96db24a99a21b493989520e58fa0ab37b00,4484
+      sha256: 3634593ce191e82793ea0e060598ab3cf67f2ef2fe1d65345dc9335ad529d25f
   original:
     hackage: lock-file-0.7.0.0@sha256:3ad84b5e454145e1d928063b56abb96db24a99a21b493989520e58fa0ab37b00,4484
 - completed:
-    pantry-tree:
-      sha256: 8372e84e9c710097f4f80f2016ca15a5a0cd7884b8ac5ce70f26b3110f4401bd
-      size: 2547
     hackage: http-client-0.7.11@sha256:3f59ac8ffe2a3768846cdda040a0d1df2a413960529ba61c839861c948871967,5756
+    pantry-tree:
+      size: 2547
+      sha256: 8372e84e9c710097f4f80f2016ca15a5a0cd7884b8ac5ce70f26b3110f4401bd
   original:
     hackage: http-client-0.7.11
 - completed:
-    pantry-tree:
-      sha256: 87526822a8ffb514d355975bca3a3f5ceb9a19eaf664cbdcde2f866c4d33878c
-      size: 1551
     hackage: lsp-1.5.0.0@sha256:1ad138526f9177965d4b5b01f9074fe0475636b2c563dcc7036fb6908f8e6189,5382
+    pantry-tree:
+      size: 1551
+      sha256: 87526822a8ffb514d355975bca3a3f5ceb9a19eaf664cbdcde2f866c4d33878c
   original:
     hackage: lsp-1.5.0.0
 - completed:
-    pantry-tree:
-      sha256: e45ef86a4301beb45ae7ec527e69880944a03c2d959cb0a051bf58dd0a5579f4
-      size: 4160
     hackage: lsp-types-1.5.0.0@sha256:7ed97bbc9290ad6ffb9b5a8e082226783c710fff9e4ca2df4c578b065997b1ea,4301
+    pantry-tree:
+      size: 4160
+      sha256: e45ef86a4301beb45ae7ec527e69880944a03c2d959cb0a051bf58dd0a5579f4
   original:
     hackage: lsp-types-1.5.0.0
 - completed:
-    pantry-tree:
-      sha256: 51b22419f8d9bfd2a8aa3efa16b80a48e4b0c915a1d27fefe5f0b6d2d9e48312
-      size: 1180
     hackage: text-rope-0.2@sha256:53b9b4cef0b278b9c591cd4ca76543acacf64c9d1bfbc06d0d9a88960446d9a7,2087
+    pantry-tree:
+      size: 1180
+      sha256: 51b22419f8d9bfd2a8aa3efa16b80a48e4b0c915a1d27fefe5f0b6d2d9e48312
   original:
     hackage: text-rope-0.2@sha256:53b9b4cef0b278b9c591cd4ca76543acacf64c9d1bfbc06d0d9a88960446d9a7,2087
 - completed:
-    pantry-tree:
-      sha256: d4cc089c40c5052ee02f91eafa567e0a239908aabc561dfa6080ba3bfc8c25bd
-      size: 584
     hackage: co-log-core-0.3.1.0@sha256:9794bdedd1391decd0e22bdfe2b11abcb42e6cff7a4531e1f8882890828f4e63,3816
+    pantry-tree:
+      size: 584
+      sha256: d4cc089c40c5052ee02f91eafa567e0a239908aabc561dfa6080ba3bfc8c25bd
   original:
     hackage: co-log-core-0.3.1.0
 - completed:
-    pantry-tree:
-      sha256: 2a9669ed392657d34ec2e180ddac68c9ef657e54bf4b5fbc9b9efaa7b1d341be
-      size: 580
     hackage: terminal-size-0.3.3@sha256:bd5f02333982bc8d6017db257b2a0b91870a295b4a37142a0c0525d8f533a48f,1255
+    pantry-tree:
+      size: 580
+      sha256: 2a9669ed392657d34ec2e180ddac68c9ef657e54bf4b5fbc9b9efaa7b1d341be
   original:
     hackage: terminal-size-0.3.3
 - completed:
-    pantry-tree:
-      sha256: 1981a732d1917213de7f51d26255af733a61918c59eebb6c6f6ca939856839ef
-      size: 3971
     hackage: network-3.1.2.7@sha256:e3d78b13db9512aeb106e44a334ab42b7aa48d26c097299084084cb8be5c5568,4888
+    pantry-tree:
+      size: 3971
+      sha256: 1981a732d1917213de7f51d26255af733a61918c59eebb6c6f6ca939856839ef
   original:
     hackage: network-3.1.2.7
 snapshots:
 - completed:
-    sha256: 428ec8d5ce932190d3cbe266b9eb3c175cd81e984babf876b64019e2cbe4ea68
     size: 590100
     url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/28.yaml
+    sha256: 428ec8d5ce932190d3cbe266b9eb3c175cd81e984babf876b64019e2cbe4ea68
   original: lts-18.28
diff --git a/unison-core/package.yaml b/unison-core/package.yaml
index 205b65e2f..5a598f1cf 100644
--- a/unison-core/package.yaml
+++ b/unison-core/package.yaml
@@ -19,7 +19,6 @@ library:
     - fuzzyfind
     - generic-lens
     - lens
-    - prelude-extras
     - memory
     - mtl
     - rfc5051
diff --git a/unison-core/src/Unison/DataDeclaration.hs b/unison-core/src/Unison/DataDeclaration.hs
index ba581fbde..138a24ca1 100644
--- a/unison-core/src/Unison/DataDeclaration.hs
+++ b/unison-core/src/Unison/DataDeclaration.hs
@@ -43,7 +43,6 @@ import Control.Monad.State (evalState)
 import Data.Bifunctor (bimap, first, second)
 import qualified Data.Map as Map
 import qualified Data.Set as Set
-import Prelude.Extras (Show1)
 import qualified Unison.ABT as ABT
 import Unison.ConstructorReference (GConstructorReference (..))
 import qualified Unison.ConstructorType as CT
@@ -273,7 +272,7 @@ data F a
   | LetRec [a] a
   | Constructors [a]
   | Modified Modifier a
-  deriving (Functor, Foldable, Show, Show1)
+  deriving (Functor, Foldable, Show)
 
 updateDependencies :: Ord v => Map Reference Reference -> Decl v a -> Decl v a
 updateDependencies typeUpdates decl =
diff --git a/unison-core/src/Unison/Term.hs b/unison-core/src/Unison/Term.hs
index fc49f246a..a3f9bc3d9 100644
--- a/unison-core/src/Unison/Term.hs
+++ b/unison-core/src/Unison/Term.hs
@@ -21,7 +21,6 @@ import qualified Data.Sequence as Sequence
 import qualified Data.Set as Set
 import qualified Data.Set.NonEmpty as NES
 import qualified Data.Text as Text
-import Prelude.Extras (Eq1 (..), Show1 (..))
 import Text.Show
 import qualified Unison.ABT as ABT
 import qualified Unison.Blank as B
@@ -1354,10 +1353,6 @@ fromReferent a = \case
 
 -- mostly boring serialization code below ...
 
-instance (Eq a, ABT.Var v) => Eq1 (F v a p) where (==#) = (==)
-
-instance (Show v) => Show1 (F v a p) where showsPrec1 = showsPrec
-
 instance (ABT.Var vt, Eq at, Eq a) => Eq (F vt at p a) where
   Int x == Int y = x == y
   Nat x == Nat y = x == y
diff --git a/unison-core/src/Unison/Type.hs b/unison-core/src/Unison/Type.hs
index ad973b9d2..e394d4bf5 100644
--- a/unison-core/src/Unison/Type.hs
+++ b/unison-core/src/Unison/Type.hs
@@ -16,7 +16,6 @@ import Data.List.Extra (nubOrd)
 import qualified Data.Map as Map
 import Data.Monoid (Any (..))
 import qualified Data.Set as Set
-import Prelude.Extras (Eq1 (..), Ord1 (..), Show1 (..))
 import qualified Unison.ABT as ABT
 import qualified Unison.Kind as K
 import qualified Unison.Name as Name
@@ -43,12 +42,6 @@ data F a
   -- variables
   deriving (Foldable, Functor, Generic, Generic1, Eq, Ord, Traversable)
 
-instance Eq1 F where (==#) = (==)
-
-instance Ord1 F where compare1 = compare
-
-instance Show1 F where showsPrec1 = showsPrec
-
 _Ref :: Prism' (F a) Reference
 _Ref = _Ctor @"Ref"
 
diff --git a/unison-core/unison-core1.cabal b/unison-core/unison-core1.cabal
index 4fc9cf3a6..77104263c 100644
--- a/unison-core/unison-core1.cabal
+++ b/unison-core/unison-core1.cabal
@@ -94,7 +94,6 @@ library
     , memory
     , mtl
     , nonempty-containers
-    , prelude-extras
     , rfc5051
     , safe
     , text

From 60d665bdda36f7d256b9cafd0ac136deba6c8ee1 Mon Sep 17 00:00:00 2001
From: Mitchell Rosen <mitchellwrosen@gmail.com>
Date: Mon, 21 Nov 2022 15:34:33 -0500
Subject: [PATCH 28/41] remove unused strings dependency

---
 parser-typechecker/package.yaml               |   1 -
 .../unison-parser-typechecker.cabal           |   2 -
 stack.yaml                                    |   1 -
 stack.yaml.lock                               | 131 +++++++++---------
 4 files changed, 62 insertions(+), 73 deletions(-)

diff --git a/parser-typechecker/package.yaml b/parser-typechecker/package.yaml
index 8c2949c36..89a16e27c 100644
--- a/parser-typechecker/package.yaml
+++ b/parser-typechecker/package.yaml
@@ -91,7 +91,6 @@ dependencies:
   - servant-server
   - shellmet
   - stm
-  - strings
   - tagged
   - temporary
   - terminal-size
diff --git a/parser-typechecker/unison-parser-typechecker.cabal b/parser-typechecker/unison-parser-typechecker.cabal
index 5652aaf4e..04f424114 100644
--- a/parser-typechecker/unison-parser-typechecker.cabal
+++ b/parser-typechecker/unison-parser-typechecker.cabal
@@ -258,7 +258,6 @@ library
     , servant-server
     , shellmet
     , stm
-    , strings
     , tagged
     , temporary
     , terminal-size
@@ -445,7 +444,6 @@ test-suite parser-typechecker-tests
     , shellmet
     , split
     , stm
-    , strings
     , tagged
     , temporary
     , terminal-size
diff --git a/stack.yaml b/stack.yaml
index 83716f37d..5b2b45203 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -56,7 +56,6 @@ extra-deps:
 - guid-0.1.0@sha256:a7c975be473f6f142d5cc1b39bc807a99043d20b1bb0873fdfe7a3ce84d2faf1,1078
 - prelude-extras-0.4.0.3@sha256:1c10b0123ea13a6423d74a8fcbaeb2d5249b472588abde418a36b47b7c4f48c8,1163
 - sandi-0.5@sha256:b278d072ca717706ea38f9bd646e023f7f2576a778fb43565b434f93638849aa,3010
-- strings-1.1@sha256:0285dec4c8ab262359342b3e5ef1eb567074669461b9b38404f1cb870c881c5c,1617
 - fuzzyfind-3.0.0@sha256:d79a5d3ed194dd436c6b839bf187211d880cf773b2febaca456e5ccf93f5ac65,1814
 - monad-validate-1.2.0.0@sha256:9850f408431098b28806dd464b6825a88a0b56c84f380d7fe0454c1df9d6f881,3505
 - NanoID-3.1.0@sha256:9118ab00e8650b5a56a10c90295d357eb77a8057a598b7e56dfedc9c6d53c77d,1524
diff --git a/stack.yaml.lock b/stack.yaml.lock
index 22747c804..837d58840 100644
--- a/stack.yaml.lock
+++ b/stack.yaml.lock
@@ -5,173 +5,166 @@
 
 packages:
 - completed:
-    sha256: d4fd87fb7bfc5d8e9fbc3e4ee7302c6b1500cdc00fdb9b659d0f4849b6ebe2d5
-    name: configurator
     size: 15989
     url: https://github.com/unisonweb/configurator/archive/e47e9e9fe1f576f8c835183b9def52d73c01327a.tar.gz
-    pantry-tree:
-      sha256: 90547cd983fd15ebdc803e057d3ef8735fe93a75e29a00f8a74eadc13ee0f6e9
-      size: 955
+    name: configurator
     version: 0.3.0.0
+    sha256: d4fd87fb7bfc5d8e9fbc3e4ee7302c6b1500cdc00fdb9b659d0f4849b6ebe2d5
+    pantry-tree:
+      size: 955
+      sha256: 90547cd983fd15ebdc803e057d3ef8735fe93a75e29a00f8a74eadc13ee0f6e9
   original:
     url: https://github.com/unisonweb/configurator/archive/e47e9e9fe1f576f8c835183b9def52d73c01327a.tar.gz
 - completed:
-    sha256: 6e642163070a217cc3363bdbefde571ff6c1878f4fc3d92e9c910db7fa88eaf2
-    name: shellmet
     size: 10460
     url: https://github.com/unisonweb/shellmet/archive/2fd348592c8f51bb4c0ca6ba4bc8e38668913746.tar.gz
-    pantry-tree:
-      sha256: 05a169a7a6b68100630e885054dc1821d31cd06571b0317ec90c75ac2c41aeb7
-      size: 654
+    name: shellmet
     version: 0.0.4.0
+    sha256: 6e642163070a217cc3363bdbefde571ff6c1878f4fc3d92e9c910db7fa88eaf2
+    pantry-tree:
+      size: 654
+      sha256: 05a169a7a6b68100630e885054dc1821d31cd06571b0317ec90c75ac2c41aeb7
   original:
     url: https://github.com/unisonweb/shellmet/archive/2fd348592c8f51bb4c0ca6ba4bc8e38668913746.tar.gz
 - completed:
-    sha256: a45eb3dbe7333c108aef4afce7f763c7661919b09641ef9d241c7ca4a78bf735
-    name: ki
-    subdir: ki
     size: 15840
+    subdir: ki
     url: https://github.com/awkward-squad/ki/archive/563e96238dfe392dccf68d93953c8f30fd53bec8.tar.gz
-    pantry-tree:
-      sha256: c63220c438c076818e09061b117c56055e154f6abb66ea9bc44a3900fcabd654
-      size: 704
+    name: ki
     version: 1.0.0
+    sha256: a45eb3dbe7333c108aef4afce7f763c7661919b09641ef9d241c7ca4a78bf735
+    pantry-tree:
+      size: 704
+      sha256: c63220c438c076818e09061b117c56055e154f6abb66ea9bc44a3900fcabd654
   original:
     subdir: ki
     url: https://github.com/awkward-squad/ki/archive/563e96238dfe392dccf68d93953c8f30fd53bec8.tar.gz
 - completed:
-    sha256: ef827ea5e8581cd68da9600660b2e584877d4fcdcf1cd2eb4652e0e51d817465
-    name: haskeline
     size: 74363
     url: https://github.com/judah/haskeline/archive/d6c2643b0d5c19be7e440615c6f84d603d4bc648.tar.gz
-    pantry-tree:
-      sha256: e30301b5389893948e25d39978d09948b11479b5b2a3517b978466fde548fc48
-      size: 3769
+    name: haskeline
     version: 0.8.0.0
+    sha256: ef827ea5e8581cd68da9600660b2e584877d4fcdcf1cd2eb4652e0e51d817465
+    pantry-tree:
+      size: 3769
+      sha256: e30301b5389893948e25d39978d09948b11479b5b2a3517b978466fde548fc48
   original:
     url: https://github.com/judah/haskeline/archive/d6c2643b0d5c19be7e440615c6f84d603d4bc648.tar.gz
 - completed:
+    hackage: guid-0.1.0@sha256:a7c975be473f6f142d5cc1b39bc807a99043d20b1bb0873fdfe7a3ce84d2faf1,1078
     pantry-tree:
-      sha256: a33838b7b1c54f6ac3e1b436b25674948713a4189658e4d82e639b9a689bc90d
       size: 364
-    hackage: guid-0.1.0@sha256:a7c975be473f6f142d5cc1b39bc807a99043d20b1bb0873fdfe7a3ce84d2faf1,1078
+      sha256: a33838b7b1c54f6ac3e1b436b25674948713a4189658e4d82e639b9a689bc90d
   original:
     hackage: guid-0.1.0@sha256:a7c975be473f6f142d5cc1b39bc807a99043d20b1bb0873fdfe7a3ce84d2faf1,1078
 - completed:
+    hackage: prelude-extras-0.4.0.3@sha256:1c10b0123ea13a6423d74a8fcbaeb2d5249b472588abde418a36b47b7c4f48c8,1163
     pantry-tree:
-      sha256: a03f60a1250c9d0daaf208ba58ccf24e05e0807f2e3dc7892fad3f2f3a196f7f
       size: 476
-    hackage: prelude-extras-0.4.0.3@sha256:1c10b0123ea13a6423d74a8fcbaeb2d5249b472588abde418a36b47b7c4f48c8,1163
+      sha256: a03f60a1250c9d0daaf208ba58ccf24e05e0807f2e3dc7892fad3f2f3a196f7f
   original:
     hackage: prelude-extras-0.4.0.3@sha256:1c10b0123ea13a6423d74a8fcbaeb2d5249b472588abde418a36b47b7c4f48c8,1163
 - completed:
+    hackage: sandi-0.5@sha256:b278d072ca717706ea38f9bd646e023f7f2576a778fb43565b434f93638849aa,3010
     pantry-tree:
-      sha256: 5ca7ce4bc22ab9d4427bb149b5e283ab9db43375df14f7131fdfd48775f36350
       size: 3455
-    hackage: sandi-0.5@sha256:b278d072ca717706ea38f9bd646e023f7f2576a778fb43565b434f93638849aa,3010
+      sha256: 5ca7ce4bc22ab9d4427bb149b5e283ab9db43375df14f7131fdfd48775f36350
   original:
     hackage: sandi-0.5@sha256:b278d072ca717706ea38f9bd646e023f7f2576a778fb43565b434f93638849aa,3010
 - completed:
+    hackage: fuzzyfind-3.0.0@sha256:d79a5d3ed194dd436c6b839bf187211d880cf773b2febaca456e5ccf93f5ac65,1814
     pantry-tree:
-      sha256: 876e5a679244143e2a7e74357427c7522a8d61f68a4cc3ae265fe4960b75a2e2
-      size: 212
-    hackage: strings-1.1@sha256:0285dec4c8ab262359342b3e5ef1eb567074669461b9b38404f1cb870c881c5c,1617
-  original:
-    hackage: strings-1.1@sha256:0285dec4c8ab262359342b3e5ef1eb567074669461b9b38404f1cb870c881c5c,1617
-- completed:
-    pantry-tree:
-      sha256: 0e6c6d4f89083c8385de5adc4f36ad01b2b0ff45261b47f7d90d919969c8b5ed
       size: 542
-    hackage: fuzzyfind-3.0.0@sha256:d79a5d3ed194dd436c6b839bf187211d880cf773b2febaca456e5ccf93f5ac65,1814
+      sha256: 0e6c6d4f89083c8385de5adc4f36ad01b2b0ff45261b47f7d90d919969c8b5ed
   original:
     hackage: fuzzyfind-3.0.0@sha256:d79a5d3ed194dd436c6b839bf187211d880cf773b2febaca456e5ccf93f5ac65,1814
 - completed:
+    hackage: monad-validate-1.2.0.0@sha256:9850f408431098b28806dd464b6825a88a0b56c84f380d7fe0454c1df9d6f881,3505
     pantry-tree:
-      sha256: 8e049bd12ce2bd470909578f2ee8eb80b89d5ff88860afa30e29dd4eafecfa3e
       size: 713
-    hackage: monad-validate-1.2.0.0@sha256:9850f408431098b28806dd464b6825a88a0b56c84f380d7fe0454c1df9d6f881,3505
+      sha256: 8e049bd12ce2bd470909578f2ee8eb80b89d5ff88860afa30e29dd4eafecfa3e
   original:
     hackage: monad-validate-1.2.0.0@sha256:9850f408431098b28806dd464b6825a88a0b56c84f380d7fe0454c1df9d6f881,3505
 - completed:
+    hackage: NanoID-3.1.0@sha256:9118ab00e8650b5a56a10c90295d357eb77a8057a598b7e56dfedc9c6d53c77d,1524
     pantry-tree:
-      sha256: d33d603a2f0d1a220ff0d5e7edb6273def89120e6bb958c2d836cae89e788334
       size: 363
-    hackage: NanoID-3.1.0@sha256:9118ab00e8650b5a56a10c90295d357eb77a8057a598b7e56dfedc9c6d53c77d,1524
+      sha256: d33d603a2f0d1a220ff0d5e7edb6273def89120e6bb958c2d836cae89e788334
   original:
     hackage: NanoID-3.1.0@sha256:9118ab00e8650b5a56a10c90295d357eb77a8057a598b7e56dfedc9c6d53c77d,1524
 - completed:
-    pantry-tree:
-      sha256: c7f5afe70db567e2cf9f3119b49f4b402705e6bd08ed8ba98747a64a8a0bef41
-      size: 770
     hackage: direct-sqlite-2.3.27@sha256:94207d3018da3bda84bc6ce00d2c0236ced7edb37afbd726ed2a0bfa236e149b,3771
+    pantry-tree:
+      size: 770
+      sha256: c7f5afe70db567e2cf9f3119b49f4b402705e6bd08ed8ba98747a64a8a0bef41
   original:
     hackage: direct-sqlite-2.3.27
 - completed:
+    hackage: recover-rtti-0.4.0.0@sha256:2ce1e031ec0e34d736fa45f0149bbd55026f614939dc90ffd14a9c5d24093ff4,4423
     pantry-tree:
-      sha256: d87d84c3f760c1b2540f74e4a301cd4e8294df891e8e4262e8bdd313bc8e0bfd
       size: 2410
-    hackage: recover-rtti-0.4.0.0@sha256:2ce1e031ec0e34d736fa45f0149bbd55026f614939dc90ffd14a9c5d24093ff4,4423
+      sha256: d87d84c3f760c1b2540f74e4a301cd4e8294df891e8e4262e8bdd313bc8e0bfd
   original:
     hackage: recover-rtti-0.4.0.0@sha256:2ce1e031ec0e34d736fa45f0149bbd55026f614939dc90ffd14a9c5d24093ff4,4423
 - completed:
+    hackage: lock-file-0.7.0.0@sha256:3ad84b5e454145e1d928063b56abb96db24a99a21b493989520e58fa0ab37b00,4484
     pantry-tree:
-      sha256: 3634593ce191e82793ea0e060598ab3cf67f2ef2fe1d65345dc9335ad529d25f
       size: 718
-    hackage: lock-file-0.7.0.0@sha256:3ad84b5e454145e1d928063b56abb96db24a99a21b493989520e58fa0ab37b00,4484
+      sha256: 3634593ce191e82793ea0e060598ab3cf67f2ef2fe1d65345dc9335ad529d25f
   original:
     hackage: lock-file-0.7.0.0@sha256:3ad84b5e454145e1d928063b56abb96db24a99a21b493989520e58fa0ab37b00,4484
 - completed:
-    pantry-tree:
-      sha256: 8372e84e9c710097f4f80f2016ca15a5a0cd7884b8ac5ce70f26b3110f4401bd
-      size: 2547
     hackage: http-client-0.7.11@sha256:3f59ac8ffe2a3768846cdda040a0d1df2a413960529ba61c839861c948871967,5756
+    pantry-tree:
+      size: 2547
+      sha256: 8372e84e9c710097f4f80f2016ca15a5a0cd7884b8ac5ce70f26b3110f4401bd
   original:
     hackage: http-client-0.7.11
 - completed:
-    pantry-tree:
-      sha256: 87526822a8ffb514d355975bca3a3f5ceb9a19eaf664cbdcde2f866c4d33878c
-      size: 1551
     hackage: lsp-1.5.0.0@sha256:1ad138526f9177965d4b5b01f9074fe0475636b2c563dcc7036fb6908f8e6189,5382
+    pantry-tree:
+      size: 1551
+      sha256: 87526822a8ffb514d355975bca3a3f5ceb9a19eaf664cbdcde2f866c4d33878c
   original:
     hackage: lsp-1.5.0.0
 - completed:
-    pantry-tree:
-      sha256: e45ef86a4301beb45ae7ec527e69880944a03c2d959cb0a051bf58dd0a5579f4
-      size: 4160
     hackage: lsp-types-1.5.0.0@sha256:7ed97bbc9290ad6ffb9b5a8e082226783c710fff9e4ca2df4c578b065997b1ea,4301
+    pantry-tree:
+      size: 4160
+      sha256: e45ef86a4301beb45ae7ec527e69880944a03c2d959cb0a051bf58dd0a5579f4
   original:
     hackage: lsp-types-1.5.0.0
 - completed:
-    pantry-tree:
-      sha256: 51b22419f8d9bfd2a8aa3efa16b80a48e4b0c915a1d27fefe5f0b6d2d9e48312
-      size: 1180
     hackage: text-rope-0.2@sha256:53b9b4cef0b278b9c591cd4ca76543acacf64c9d1bfbc06d0d9a88960446d9a7,2087
+    pantry-tree:
+      size: 1180
+      sha256: 51b22419f8d9bfd2a8aa3efa16b80a48e4b0c915a1d27fefe5f0b6d2d9e48312
   original:
     hackage: text-rope-0.2@sha256:53b9b4cef0b278b9c591cd4ca76543acacf64c9d1bfbc06d0d9a88960446d9a7,2087
 - completed:
-    pantry-tree:
-      sha256: d4cc089c40c5052ee02f91eafa567e0a239908aabc561dfa6080ba3bfc8c25bd
-      size: 584
     hackage: co-log-core-0.3.1.0@sha256:9794bdedd1391decd0e22bdfe2b11abcb42e6cff7a4531e1f8882890828f4e63,3816
+    pantry-tree:
+      size: 584
+      sha256: d4cc089c40c5052ee02f91eafa567e0a239908aabc561dfa6080ba3bfc8c25bd
   original:
     hackage: co-log-core-0.3.1.0
 - completed:
-    pantry-tree:
-      sha256: 2a9669ed392657d34ec2e180ddac68c9ef657e54bf4b5fbc9b9efaa7b1d341be
-      size: 580
     hackage: terminal-size-0.3.3@sha256:bd5f02333982bc8d6017db257b2a0b91870a295b4a37142a0c0525d8f533a48f,1255
+    pantry-tree:
+      size: 580
+      sha256: 2a9669ed392657d34ec2e180ddac68c9ef657e54bf4b5fbc9b9efaa7b1d341be
   original:
     hackage: terminal-size-0.3.3
 - completed:
-    pantry-tree:
-      sha256: 1981a732d1917213de7f51d26255af733a61918c59eebb6c6f6ca939856839ef
-      size: 3971
     hackage: network-3.1.2.7@sha256:e3d78b13db9512aeb106e44a334ab42b7aa48d26c097299084084cb8be5c5568,4888
+    pantry-tree:
+      size: 3971
+      sha256: 1981a732d1917213de7f51d26255af733a61918c59eebb6c6f6ca939856839ef
   original:
     hackage: network-3.1.2.7
 snapshots:
 - completed:
-    sha256: 428ec8d5ce932190d3cbe266b9eb3c175cd81e984babf876b64019e2cbe4ea68
     size: 590100
     url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/28.yaml
+    sha256: 428ec8d5ce932190d3cbe266b9eb3c175cd81e984babf876b64019e2cbe4ea68
   original: lts-18.28

From 840ef664c430222a7eb4b32d8d002ac43132e933 Mon Sep 17 00:00:00 2001
From: Dan Doel <dan.doel@gmail.com>
Date: Mon, 21 Nov 2022 16:34:59 -0500
Subject: [PATCH 29/41] Check for scheme binary before run/compile

- If it isn't found, print out a message indicating where to get the
  scheme compiler we need.
---
 .../src/Unison/Codebase/Editor/HandleInput.hs | 20 +++++++++++++++++++
 1 file changed, 20 insertions(+)

diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs
index b72c40729..a72468063 100644
--- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs
+++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs
@@ -2598,8 +2598,27 @@ typecheckAndEval ppe tm = do
     a = External
     rendered = P.toPlainUnbroken $ TP.pretty ppe tm
 
+ensureSchemeExists :: Cli ()
+ensureSchemeExists = liftIO callScheme >>= \case
+    True -> pure ()
+    False -> Cli.returnEarly (PrintMessage msg)
+  where
+  msg = P.lines [
+    "I can't seem to call scheme. See",
+    "",
+    P.indentN 2
+      "https://github.com/cisco/ChezScheme/blob/main/BUILDING",
+    "",
+    "for how to install Chez Scheme."]
+
+  callScheme =
+    catch
+      (True <$ readCreateProcess (shell "scheme -q") "")
+      (\(_ :: IOException) -> pure False)
+
 runScheme :: String -> Cli ()
 runScheme file = do
+  ensureSchemeExists
   gendir <- getSchemeGenLibDir
   statdir <- getSchemeStaticLibDir
   let includes = gendir ++ ":" ++ statdir
@@ -2615,6 +2634,7 @@ runScheme file = do
 
 buildScheme :: String -> String -> Cli ()
 buildScheme main file = do
+  ensureSchemeExists
   statDir <- getSchemeStaticLibDir
   genDir <- getSchemeGenLibDir
   let cmd = shell "scheme -q --optimize-level 3"

From 3487220a6a09ec562a0023c960d2cc0e5021ca86 Mon Sep 17 00:00:00 2001
From: Dan Doel <dan.doel@gmail.com>
Date: Mon, 21 Nov 2022 16:55:15 -0500
Subject: [PATCH 30/41] Add Chez scheme readme

---
 chez-libs/readme.md | 49 +++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 49 insertions(+)
 create mode 100644 chez-libs/readme.md

diff --git a/chez-libs/readme.md b/chez-libs/readme.md
new file mode 100644
index 000000000..2e242c814
--- /dev/null
+++ b/chez-libs/readme.md
@@ -0,0 +1,49 @@
+This directory contains libraries necessary for building and running
+unison programs via Chez Scheme. At the moment, they need to be
+manually installed in the expected location. The default location is
+the `unisonlanguage` directory in the XDG data directory.
+Specifically, the `unison` subdirectory should be (recursively) copied
+to:
+
+    $XDG_DATA_DIRECTORY/unisonlanguage/scheme-libs
+
+On unix systems, the XDG directory is ~/.local/share by default, ~
+being the home directory. On Windows, this is instead the %APPDATA%
+directory. See:
+
+    https://hackage.haskell.org/package/directory/docs/System-Directory.html#t:XdgDirectory
+
+for more information.
+
+UCM can also be told to look in another directory by setting the
+`SchemeLibs.Static` item in the unison config file. If this path is
+denoted by `$CUSTOM`, then the compiler commands will look in:
+
+    $CUSTOM/scheme-libs/
+
+for the `unison/` directory containing the library files.
+
+The compiler commands also expect Chez Scheme to be installed
+separately, and for `scheme` to be callable on the user's path. For
+information on how to install, see:
+
+    https://github.com/cisco/ChezScheme/blob/main/BUILDING
+
+For more information on Chez Scheme in general, see:
+
+    https://cisco.github.io/ChezScheme/csug9.5/csug.html
+
+There are two ways to run code via scheme. The first is to use
+`run.native`, which compiles and immediately runs a given unison
+definition. The second is `compile.native`, which produces a Chez
+scheme `.boot` file with a specified name. The boot file can then be
+used with the scheme binary to run the precompiled program, like so:
+
+    scheme -b ./my-program.boot
+
+It is also possible to install the boot file in a particular
+directory, and make a renamed copy of the scheme binary, which will
+automatically execute the boot file with the corresponding name on
+start up. For more information on how to accomplish that, see:
+
+    https://cisco.github.io/ChezScheme/csug9.5/use.html#./use:h8

From 48420454b72d8501ae21bb2a141aff8aab9d9762 Mon Sep 17 00:00:00 2001
From: Chris Penner <christopher.penner@gmail.com>
Date: Mon, 21 Nov 2022 16:15:40 -0600
Subject: [PATCH 31/41] Swap name priority so shorter fqn come first (#3618)

* Swap name priority so shorter fqn come first

* Update transcripts
---
 parser-typechecker/src/Unison/PrettyPrintEnv/Names.hs | 8 ++++----
 unison-src/transcripts/name-selection.md              | 5 +++--
 unison-src/transcripts/name-selection.output.md       | 7 ++++---
 3 files changed, 11 insertions(+), 9 deletions(-)

diff --git a/parser-typechecker/src/Unison/PrettyPrintEnv/Names.hs b/parser-typechecker/src/Unison/PrettyPrintEnv/Names.hs
index 90f600eee..e213ecfad 100644
--- a/parser-typechecker/src/Unison/PrettyPrintEnv/Names.hs
+++ b/parser-typechecker/src/Unison/PrettyPrintEnv/Names.hs
@@ -32,13 +32,13 @@ fromNames len names = PrettyPrintEnv terms' types'
 --
 -- 1. Prefer Relative Names to Absolute Names
 -- 2. Prefer names that aren't hash qualified to those that are
--- 3. Prefer names which have fewer segments in their suffixified form (if applicable)
--- 4. Prefer names which have fewer segments in their fully-qualified form
+-- 3. Prefer names which have fewer segments in their fully-qualified form
+-- 4. Prefer names which have fewer segments in their suffixified form (if applicable)
 prioritize :: [(HQ'.HashQualified Name, HQ'.HashQualified Name)] -> [(HQ'.HashQualified Name, HQ'.HashQualified Name)]
 prioritize =
   sortOn \case
-    (fqn, HQ'.NameOnly name) -> (Name.isAbsolute name, Nothing, Name.countSegments name, Name.countSegments (HQ'.toName fqn))
-    (fqn, HQ'.HashQualified name hash) -> (Name.isAbsolute name, Just hash, Name.countSegments name, Name.countSegments (HQ'.toName fqn))
+    (fqn, HQ'.NameOnly name) -> (Name.isAbsolute name, Nothing, Name.countSegments (HQ'.toName fqn), Name.countSegments name)
+    (fqn, HQ'.HashQualified name hash) -> (Name.isAbsolute name, Just hash, Name.countSegments (HQ'.toName fqn), Name.countSegments name)
 
 fromSuffixNames :: Int -> NamesWithHistory -> PrettyPrintEnv
 fromSuffixNames len names = PrettyPrintEnv terms' types'
diff --git a/unison-src/transcripts/name-selection.md b/unison-src/transcripts/name-selection.md
index aeb9cf87c..fe3e76034 100644
--- a/unison-src/transcripts/name-selection.md
+++ b/unison-src/transcripts/name-selection.md
@@ -55,7 +55,7 @@ d = c + 10
 
 At this point, `a3` is conflicted for symbols `c` and `d`, so those are deprioritized. 
 The original `a2` namespace has an unconflicted definition for `c` and `d`, but since there are multiple 'c's in scope, 
-`long.name.but.shortest.suffixification` is chosen because its suffixified version has the fewest segments.
+`a2.c` is chosen because although the suffixified version has fewer segments, its fully-qualified name has the fewest segments.
 
 ```ucm
 .> view a b c d
@@ -88,7 +88,8 @@ other.value = 20
 
 ```ucm
 .biasing> add
--- nested.value should still be preferred even if the suffixification requires more segments than `a`
+-- nested.value should be preferred over the shorter name `a` due to biasing
+-- because `deeply.nested.value` is nearby to the term being viewed.
 .biasing> view deeply.nested.term
 ```
 
diff --git a/unison-src/transcripts/name-selection.output.md b/unison-src/transcripts/name-selection.output.md
index ffce4a7ad..f65b342f8 100644
--- a/unison-src/transcripts/name-selection.output.md
+++ b/unison-src/transcripts/name-selection.output.md
@@ -1373,7 +1373,7 @@ d = c + 10
 ```
 At this point, `a3` is conflicted for symbols `c` and `d`, so those are deprioritized. 
 The original `a2` namespace has an unconflicted definition for `c` and `d`, but since there are multiple 'c's in scope, 
-`long.name.but.shortest.suffixification` is chosen because its suffixified version has the fewest segments.
+`a2.c` is chosen because although the suffixified version has fewer segments, its fully-qualified name has the fewest segments.
 
 ```ucm
 .> view a b c d
@@ -1394,7 +1394,7 @@ The original `a2` namespace has an unconflicted definition for `c` and `d`, but
   a2.d : Nat
   a2.d =
     use Nat +
-    suffixification + 10
+    a2.c + 10
   
   a3.c#dcgdua2lj6 : Nat
   a3.c#dcgdua2lj6 = 2
@@ -1475,7 +1475,8 @@ other.value = 20
   
     other.value : Nat
 
--- nested.value should still be preferred even if the suffixification requires more segments than `a`
+-- nested.value should be preferred over the shorter name `a` due to biasing
+-- because `deeply.nested.value` is nearby to the term being viewed.
 .biasing> view deeply.nested.term
 
   deeply.nested.term : Nat

From b1c0aded8892ddec1a3077cb86995ec9e2cda652 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?R=C3=BAnar?= <runarorama@gmail.com>
Date: Tue, 22 Nov 2022 10:42:08 -0500
Subject: [PATCH 32/41] Don't try to justify if the pattern doesn't fit

---
 .../src/Unison/Syntax/TermPrinter.hs          | 36 +++++++++++++------
 1 file changed, 26 insertions(+), 10 deletions(-)

diff --git a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs
index 71fd58aaa..4cf47664c 100644
--- a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs
+++ b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs
@@ -710,7 +710,10 @@ printCase ::
   DocLiteralContext ->
   [MatchCase' () (Term3 v PrintAnnotation)] ->
   m (Pretty SyntaxText)
-printCase im doc ms0 = PP.lines . alignGrid <$> grid
+printCase im doc ms0 =
+  PP.orElse
+    <$> (PP.lines . alignGrid True <$> grid)
+    <*> (PP.lines . alignGrid False <$> grid)
   where
     ms = groupCases ms0
     justify rows =
@@ -718,16 +721,29 @@ printCase im doc ms0 = PP.lines . alignGrid <$> grid
       where
         alignPatterns (p, _, _) = (p, Just "")
         gbs (_, gs, bs) = zip gs bs
-    alignGrid = fmap alignCase . justify
-    alignCase (p, gbs) =
-      if not (null (drop 1 gbs))
-        then PP.hang p guardBlock
-        else p <> guardBlock
+    nojustify = map f
       where
-        guardBlock =
-          PP.lines $
-            fmap (\(g, (a, b)) -> PP.hang (PP.group (g <> a)) b) justified
-        justified = PP.leftJustify $ fmap (\(g, b) -> (g, (arrow, b))) gbs
+        f (p, gs, bs) = (p, zip gs bs)
+    alignGrid alignArrows grid =
+      fmap alignCase $ if alignArrows then justify grid else nojustify grid
+      where
+        alignCase (p, gbs) =
+          if not (null (drop 1 gbs))
+            then PP.hang p guardBlock
+            else p <> guardBlock
+          where
+            guardBlock =
+              PP.lines $
+                fmap
+                  ( \(g, (a, b)) ->
+                      PP.hang
+                        ( PP.group
+                            (g <> (if alignArrows then "" else " ") <> a)
+                        )
+                        b
+                  )
+                  justified
+            justified = PP.leftJustify $ fmap (\(g, b) -> (g, (arrow, b))) gbs
     grid = traverse go ms
     patLhs env vs pats =
       case pats of

From 97bea4f599b4e147a7f112a20139748e9bd27299 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?R=C3=BAnar?= <runarorama@gmail.com>
Date: Tue, 22 Nov 2022 11:06:28 -0500
Subject: [PATCH 33/41] Update transcripts

---
 unison-src/transcripts/lambdacase.output.md | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/unison-src/transcripts/lambdacase.output.md b/unison-src/transcripts/lambdacase.output.md
index 12fa3b6c4..573138be6 100644
--- a/unison-src/transcripts/lambdacase.output.md
+++ b/unison-src/transcripts/lambdacase.output.md
@@ -105,8 +105,8 @@ Notice that Unison detects this as an alias of `merge`, and if we view `merge`
 
   merge : [a] -> [a] -> [a]
   merge = cases
-    [], ys           -> ys
-    xs, []           -> xs
+    [], ys -> ys
+    xs, [] -> xs
     h +: t, h2 +: t2 ->
       if h <= h2 then h +: merge t (h2 +: t2)
       else h2 +: merge (h +: t) t2

From 79d1a129ec730006a7662ca5ee91d524defd356d Mon Sep 17 00:00:00 2001
From: Mitchell Rosen <mitchellwrosen@gmail.com>
Date: Tue, 22 Nov 2022 11:20:35 -0500
Subject: [PATCH 34/41] format

---
 .../src/Unison/Syntax/TermPrinter.hs          | 146 +++++++++---------
 1 file changed, 74 insertions(+), 72 deletions(-)

diff --git a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs
index 71fd58aaa..ef4f2bbc1 100644
--- a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs
+++ b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs
@@ -193,6 +193,7 @@ pretty0
           fmt S.LinkKeyword "termLink "
             <> parenIfInfix name ic (styleHashQualified'' (fmt $ S.TermReference r) name)
         where
+
       TypeLink' r -> do
         n <- getPPE
         let name = elideFQN im $ PrettyPrintEnv.typeName n r
@@ -200,6 +201,7 @@ pretty0
           fmt S.LinkKeyword "typeLink "
             <> parenIfInfix name ic (styleHashQualified'' (fmt $ S.TypeReference r) name)
         where
+
       Ann' tm t -> do
         tm' <- pretty0 (ac 10 Normal im doc) tm
         tp' <- TypePrinter.pretty0 im 0 t
@@ -259,21 +261,21 @@ pretty0
           fmt S.DelayForceChar (l "!") <> px
       Delay' x
         | Lets' _ _ <- x -> do
-          px <- pretty0 (ac 0 Block im doc) x
-          pure . paren (p >= 3) $
-            fmt S.ControlKeyword "do" `PP.hang` px
+            px <- pretty0 (ac 0 Block im doc) x
+            pure . paren (p >= 3) $
+              fmt S.ControlKeyword "do" `PP.hang` px
         | otherwise -> do
-          px <- pretty0 (ac 10 Normal im doc) x
-          pure . paren (p >= 11 || isBlock x && p >= 3) $
-            fmt S.DelayForceChar (l "'")
-              <> ( case x of
-                     Lets' _ _ -> id
-                     -- Add indentation below if we're opening parens with '(
-                     -- This is in case the contents are a long function application
-                     -- in which case the arguments should be indented.
-                     _ -> PP.indentAfterNewline "  "
-                 )
-                px
+            px <- pretty0 (ac 10 Normal im doc) x
+            pure . paren (p >= 11 || isBlock x && p >= 3) $
+              fmt S.DelayForceChar (l "'")
+                <> ( case x of
+                       Lets' _ _ -> id
+                       -- Add indentation below if we're opening parens with '(
+                       -- This is in case the contents are a long function application
+                       -- in which case the arguments should be indented.
+                       _ -> PP.indentAfterNewline "  "
+                   )
+                  px
       List' xs ->
         PP.group <$> do
           xs' <- traverse (pretty0 (ac 0 Normal im doc)) xs
@@ -327,30 +329,30 @@ pretty0
       -- See `isDestructuringBind` definition.
       Match' scrutinee cs@[MatchCase pat guard (AbsN' vs body)]
         | p < 1 && isDestructuringBind scrutinee cs -> do
-          n <- getPPE
-          let letIntro = case bc of
-                Block -> id
-                Normal -> \x ->
-                  -- We don't call calcImports here, because we can't easily do the
-                  -- corequisite step in immediateChildBlockTerms (because it doesn't
-                  -- know bc.)  So we'll fail to take advantage of any opportunity
-                  -- this let block provides to add a use statement.  Not so bad.
-                  fmt S.ControlKeyword "let" `PP.hang` x
-          lhs <- do
-            let (lhs, _) = prettyPattern n (ac 0 Block im doc) 10 vs pat
-            guard' <- printGuard guard
-            pure $ PP.group lhs `PP.hang` guard'
-          let eq = fmt S.BindingEquals "="
-          rhs <- do
-            let (im', uses) = calcImports im scrutinee
-            uses <$> sequence [pretty0 (ac (-1) Block im' doc) scrutinee]
-          letIntro <$> do
-            prettyBody <- pretty0 (ac (-1) Block im doc) body
-            pure $
-              PP.lines
-                [ (lhs <> eq) `PP.hang` rhs,
-                  prettyBody
-                ]
+            n <- getPPE
+            let letIntro = case bc of
+                  Block -> id
+                  Normal -> \x ->
+                    -- We don't call calcImports here, because we can't easily do the
+                    -- corequisite step in immediateChildBlockTerms (because it doesn't
+                    -- know bc.)  So we'll fail to take advantage of any opportunity
+                    -- this let block provides to add a use statement.  Not so bad.
+                    fmt S.ControlKeyword "let" `PP.hang` x
+            lhs <- do
+              let (lhs, _) = prettyPattern n (ac 0 Block im doc) 10 vs pat
+              guard' <- printGuard guard
+              pure $ PP.group lhs `PP.hang` guard'
+            let eq = fmt S.BindingEquals "="
+            rhs <- do
+              let (im', uses) = calcImports im scrutinee
+              uses <$> sequence [pretty0 (ac (-1) Block im' doc) scrutinee]
+            letIntro <$> do
+              prettyBody <- pretty0 (ac (-1) Block im doc) body
+              pure $
+                PP.lines
+                  [ (lhs <> eq) `PP.hang` rhs,
+                    prettyBody
+                  ]
         where
           printGuard Nothing = pure mempty
           printGuard (Just g') = do
@@ -391,9 +393,9 @@ pretty0
             case (term, binaryOpsPred) of
               (DD.Doc, _)
                 | doc == MaybeDoc ->
-                  if isDocLiteral term
-                    then applyPPE3 prettyDoc im term
-                    else pretty0 (a {docContext = NoDoc}) term
+                    if isDocLiteral term
+                      then applyPPE3 prettyDoc im term
+                      else pretty0 (a {docContext = NoDoc}) term
               (TupleTerm' [x], _) -> do
                 let conRef = DD.pairCtorRef
                 name <- elideFQN im <$> applyPPE2 PrettyPrintEnv.termName conRef
@@ -465,12 +467,12 @@ pretty0
               _ -> case (term, nonForcePred) of
                 OverappliedBinaryAppPred' f a b r
                   | binaryOpsPred f ->
-                    -- Special case for overapplied binary op
-                    do
-                      prettyB <- pretty0 (ac 3 Normal im doc) b
-                      prettyR <- PP.spacedTraverse (pretty0 (ac 10 Normal im doc)) r
-                      prettyA <- binaryApps [(f, a)] prettyB
-                      pure $ paren True $ PP.hang prettyA prettyR
+                      -- Special case for overapplied binary op
+                      do
+                        prettyB <- pretty0 (ac 3 Normal im doc) b
+                        prettyR <- PP.spacedTraverse (pretty0 (ac 10 Normal im doc)) r
+                        prettyA <- binaryApps [(f, a)] prettyB
+                        pure $ paren True $ PP.hang prettyA prettyR
                 AppsPred' f args ->
                   paren (p >= 10) <$> do
                     f' <- pretty0 (ac 10 Normal im doc) f
@@ -611,8 +613,8 @@ prettyPattern n c@AmbientContext {imports = im} p vs patt = case patt of
   Pattern.Text _ t -> (fmt S.TextLiteral $ l $ show t, vs)
   TuplePattern pats
     | length pats /= 1 ->
-      let (pats_printed, tail_vs) = patterns (-1) vs pats
-       in (PP.parenthesizeCommas pats_printed, tail_vs)
+        let (pats_printed, tail_vs) = patterns (-1) vs pats
+         in (PP.parenthesizeCommas pats_printed, tail_vs)
   Pattern.Constructor _ ref [] ->
     (styleHashQualified'' (fmt $ S.TermReference conRef) name, vs)
     where
@@ -858,14 +860,14 @@ prettyBinding0 a@AmbientContext {imports = im, docContext = doc} v term =
       where
         defnLhs v vs
           | infix' = case vs of
-            x : y : _ ->
-              PP.sep
-                " "
-                [ fmt S.Var $ PP.text (Var.name x),
-                  styleHashQualified'' (fmt $ S.HashQualifier v) $ elideFQN im v,
-                  fmt S.Var $ PP.text (Var.name y)
-                ]
-            _ -> l "error"
+              x : y : _ ->
+                PP.sep
+                  " "
+                  [ fmt S.Var $ PP.text (Var.name x),
+                    styleHashQualified'' (fmt $ S.HashQualifier v) $ elideFQN im v,
+                    fmt S.Var $ PP.text (Var.name y)
+                  ]
+              _ -> l "error"
           | null vs = renderName v
           | otherwise = renderName v `PP.hang` args vs
         args = PP.spacedMap $ fmt S.Var . PP.text . Var.name
@@ -1466,7 +1468,7 @@ unLetBlock t = rec t
       Just (_isTop, bindings, body) -> case rec body of
         Just (innerBindings, innerBody)
           | dontIntersect bindings innerBindings ->
-            Just (bindings ++ innerBindings, innerBody)
+              Just (bindings ++ innerBindings, innerBody)
         _ -> Just (bindings, body)
     nonrec t = case unLet t of
       Nothing -> Nothing
@@ -1475,7 +1477,7 @@ unLetBlock t = rec t
          in case rec body of
               Just (innerBindings, innerBody)
                 | dontIntersect bindings innerBindings ->
-                  Just (bindings ++ innerBindings, innerBody)
+                    Just (bindings ++ innerBindings, innerBody)
               _ -> Just (bindings, body)
 
 pattern LamsNamedMatch' ::
@@ -1528,7 +1530,7 @@ unLamsMatch' t = case unLamsUntilDelay' t of
     | -- if `v1'` is referenced in any of the branches, we can't use lambda case
       -- syntax as we need to keep the `v1'` name that was introduced
       v1 == v1' && Set.notMember v1' (Set.unions $ freeVars <$> branches) ->
-      Just (reverse vs, [([p], guard, body) | MatchCase p guard body <- branches])
+        Just (reverse vs, [([p], guard, body) | MatchCase p guard body <- branches])
   -- x y z -> match (x,y,z) with (pat1, pat2, pat3) -> ...
   --   becomes
   -- cases pat1 pat2 pat3 -> ...`
@@ -1541,7 +1543,7 @@ unLamsMatch' t = case unLamsUntilDelay' t of
         all notFree (take len vs)
         && all isRightArity branches
         && len /= 0 -> -- all patterns need to match arity of scrutes
-      Just (reverse (drop len vs), branches')
+        Just (reverse (drop len vs), branches')
     where
       isRightArity (MatchCase (TuplePattern ps) _ _) = length ps == len
       isRightArity MatchCase {} = False
@@ -1793,7 +1795,7 @@ toDocExample' suffix ppe (Apps' (Ref' r) [Nat' n, l@(LamsNamed' vs tm)])
   | nameEndsWith ppe suffix r,
     ABT.freeVars l == mempty,
     ok tm =
-    Just (lam' (ABT.annotation l) (drop (fromIntegral n + 1) vs) tm)
+      Just (lam' (ABT.annotation l) (drop (fromIntegral n + 1) vs) tm)
   where
     ok (Apps' f _) = ABT.freeVars f == mempty
     ok tm = ABT.freeVars tm == mempty
@@ -1807,9 +1809,9 @@ toDocTransclude _ _ = Nothing
 toDocLink :: Ord v => PrettyPrintEnv -> Term3 v PrintAnnotation -> Maybe (Either Reference Referent)
 toDocLink ppe (App' (Ref' r) tm)
   | nameEndsWith ppe ".docLink" r = case tm of
-    (toDocEmbedTermLink ppe -> Just tm) -> Just (Right tm)
-    (toDocEmbedTypeLink ppe -> Just tm) -> Just (Left tm)
-    _ -> Nothing
+      (toDocEmbedTermLink ppe -> Just tm) -> Just (Right tm)
+      (toDocEmbedTypeLink ppe -> Just tm) -> Just (Left tm)
+      _ -> Nothing
 toDocLink _ _ = Nothing
 
 toDocNamedLink :: PrettyPrintEnv -> Term3 v PrintAnnotation -> Maybe (Term3 v PrintAnnotation, Term3 v PrintAnnotation)
@@ -1848,7 +1850,7 @@ toDocSourceAnnotations _ppe _tm = Just [] -- todo fetch annotations
 toDocSourceElement :: Ord v => PrettyPrintEnv -> Term3 v PrintAnnotation -> Maybe (Either Reference Referent, [Referent])
 toDocSourceElement ppe (Apps' (Ref' r) [tm, toDocSourceAnnotations ppe -> Just annotations])
   | nameEndsWith ppe ".docSourceElement" r =
-    (,annotations) <$> ok tm
+      (,annotations) <$> ok tm
   where
     ok tm =
       Right <$> toDocEmbedTermLink ppe tm
@@ -1863,9 +1865,9 @@ toDocSource' ::
   Maybe [(Either Reference Referent, [Referent])]
 toDocSource' suffix ppe (App' (Ref' r) (List' tms))
   | nameEndsWith ppe suffix r =
-    case [tm | Just tm <- toDocSourceElement ppe <$> toList tms] of
-      tms' | length tms' == length tms -> Just tms'
-      _ -> Nothing
+      case [tm | Just tm <- toDocSourceElement ppe <$> toList tms] of
+        tms' | length tms' == length tms -> Just tms'
+        _ -> Nothing
 toDocSource' _ _ _ = Nothing
 
 toDocSource,
@@ -1903,9 +1905,9 @@ toDocEmbedSignatureLink _ _ = Nothing
 toDocSignature :: Ord v => PrettyPrintEnv -> Term3 v PrintAnnotation -> Maybe [Referent]
 toDocSignature ppe (App' (Ref' r) (List' tms))
   | nameEndsWith ppe ".docSignature" r =
-    case [tm | Just tm <- toDocEmbedSignatureLink ppe <$> toList tms] of
-      tms' | length tms' == length tms -> Just tms'
-      _ -> Nothing
+      case [tm | Just tm <- toDocEmbedSignatureLink ppe <$> toList tms] of
+        tms' | length tms' == length tms -> Just tms'
+        _ -> Nothing
 toDocSignature _ _ = Nothing
 
 toDocBulletedList :: PrettyPrintEnv -> Term3 v PrintAnnotation -> Maybe [Term3 v PrintAnnotation]

From 4b0bff74ab0bc520bee69d82483f2610e2703c37 Mon Sep 17 00:00:00 2001
From: Mitchell Rosen <mitchellwrosen@gmail.com>
Date: Tue, 22 Nov 2022 11:21:00 -0500
Subject: [PATCH 35/41] delete inaccessible case

---
 parser-typechecker/src/Unison/Syntax/TermPrinter.hs | 12 ++++--------
 1 file changed, 4 insertions(+), 8 deletions(-)

diff --git a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs
index ef4f2bbc1..c7ea6530f 100644
--- a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs
+++ b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs
@@ -268,14 +268,10 @@ pretty0
             px <- pretty0 (ac 10 Normal im doc) x
             pure . paren (p >= 11 || isBlock x && p >= 3) $
               fmt S.DelayForceChar (l "'")
-                <> ( case x of
-                       Lets' _ _ -> id
-                       -- Add indentation below if we're opening parens with '(
-                       -- This is in case the contents are a long function application
-                       -- in which case the arguments should be indented.
-                       _ -> PP.indentAfterNewline "  "
-                   )
-                  px
+                -- Add indentation below since we're opening parens with '(
+                -- This is in case the contents are a long function application
+                -- in which case the arguments should be indented.
+                <> PP.indentAfterNewline "  " px
       List' xs ->
         PP.group <$> do
           xs' <- traverse (pretty0 (ac 0 Normal im doc)) xs

From 1a8e9b08066b4abe36bd7989ff2a1adc84d345a8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?R=C3=BAnar?= <runarorama@gmail.com>
Date: Tue, 22 Nov 2022 11:56:51 -0500
Subject: [PATCH 36/41] Eta-reduce term links to undo compiler expansion

---
 unison-cli/src/Unison/CommandLine/DisplayValues.hs | 13 ++++++++-----
 1 file changed, 8 insertions(+), 5 deletions(-)

diff --git a/unison-cli/src/Unison/CommandLine/DisplayValues.hs b/unison-cli/src/Unison/CommandLine/DisplayValues.hs
index d821a8650..e1f817b39 100644
--- a/unison-cli/src/Unison/CommandLine/DisplayValues.hs
+++ b/unison-cli/src/Unison/CommandLine/DisplayValues.hs
@@ -193,11 +193,14 @@ displayPretty pped terms typeOf eval types tm = go tm
             go = pure . P.underline . P.syntaxToColor . NP.prettyHashQualified
          in case e of
               DD.EitherLeft' (Term.TypeLink' ref) -> go $ PPE.typeName ppe ref
-              DD.EitherRight' (DD.Doc2Term (Term.Ref' ref)) -> go $ PPE.termName ppe (Referent.Ref ref)
-              DD.EitherRight' (DD.Doc2Term (Term.Request' ref)) ->
-                go $ PPE.termName ppe (Referent.Con ref CT.Effect)
-              DD.EitherRight' (DD.Doc2Term (Term.Constructor' ref)) ->
-                go $ PPE.termName ppe (Referent.Con ref CT.Data)
+              -- Eta-reduce the term, as the compiler may have eta-expanded it.
+              DD.EitherRight' (DD.Doc2Term t) -> case Term.etaNormalForm t of
+                Term.Ref' ref -> go $ PPE.termName ppe (Referent.Ref ref)
+                Term.Request' ref ->
+                  go $ PPE.termName ppe (Referent.Con ref CT.Effect)
+                Term.Constructor' ref ->
+                  go $ PPE.termName ppe (Referent.Con ref CT.Data)
+                _ -> P.red <$> displayTerm pped terms typeOf eval types t
               _ -> P.red <$> displayTerm pped terms typeOf eval types e
       -- Signature [Doc2.Term]
       DD.Doc2SpecialFormSignature (Term.List' tms) ->

From 3cc896e90cc12db0b1ea08ad47ab72edf5aa3fee Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?R=C3=BAnar?= <runarorama@gmail.com>
Date: Tue, 22 Nov 2022 16:00:54 -0500
Subject: [PATCH 37/41] added transcript

---
 unison-src/transcripts/fix3634.md        | 22 +++++++++++++
 unison-src/transcripts/fix3634.output.md | 41 ++++++++++++++++++++++++
 2 files changed, 63 insertions(+)
 create mode 100644 unison-src/transcripts/fix3634.md
 create mode 100644 unison-src/transcripts/fix3634.output.md

diff --git a/unison-src/transcripts/fix3634.md b/unison-src/transcripts/fix3634.md
new file mode 100644
index 000000000..5ec2ca0da
--- /dev/null
+++ b/unison-src/transcripts/fix3634.md
@@ -0,0 +1,22 @@
+```ucm:hide
+.> builtins.merge
+.> builtins.mergeio
+```
+
+
+```unison
+structural type M a = N | J a
+
+d = {{
+
+{{ docExample 0 '(x -> J x) }}
+
+{J}
+
+}}
+```
+
+```ucm
+.> add
+.> display d
+```
\ No newline at end of file
diff --git a/unison-src/transcripts/fix3634.output.md b/unison-src/transcripts/fix3634.output.md
new file mode 100644
index 000000000..912c63353
--- /dev/null
+++ b/unison-src/transcripts/fix3634.output.md
@@ -0,0 +1,41 @@
+```unison
+structural type M a = N | J a
+
+d = {{
+
+{{ docExample 0 '(x -> J x) }}
+
+{J}
+
+}}
+```
+
+```ucm
+
+  I found and typechecked these definitions in scratch.u. If you
+  do an `add` or `update`, here's how your codebase would
+  change:
+  
+    ⍟ These new definitions are ok to `add`:
+    
+      structural type M a
+        (also named builtin.Optional)
+      d : Doc2
+
+```
+```ucm
+.> add
+
+  ⍟ I've added these definitions:
+  
+    structural type M a
+      (also named builtin.Optional)
+    d : Doc2
+
+.> display d
+
+  `x -> J x`
+  
+  J
+
+```

From 957ec74d59b2a4d00ea722d5a43ede1392a4ca17 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?R=C3=BAnar?= <runarorama@gmail.com>
Date: Tue, 22 Nov 2022 17:29:35 -0500
Subject: [PATCH 38/41] Also fix ui

---
 unison-share-api/src/Unison/Server/Doc.hs | 5 ++++-
 unison-src/transcripts/fix3634.md         | 1 -
 2 files changed, 4 insertions(+), 2 deletions(-)

diff --git a/unison-share-api/src/Unison/Server/Doc.hs b/unison-share-api/src/Unison/Server/Doc.hs
index 87aa2f41e..ea0c9eb44 100644
--- a/unison-share-api/src/Unison/Server/Doc.hs
+++ b/unison-share-api/src/Unison/Server/Doc.hs
@@ -220,7 +220,10 @@ renderDoc pped terms typeOf eval types tm =
             ty r = (NP.styleHashQualified'' (NP.fmt (S.TypeReference r)) . PPE.typeName ppe) r
          in Link <$> case e of
               DD.EitherLeft' (Term.TypeLink' r) -> (pure . formatPretty . ty) r
-              DD.EitherRight' (DD.Doc2Term (Term.Referent' r)) -> (pure . formatPretty . tm) r
+              DD.EitherRight' (DD.Doc2Term t) ->
+                case Term.etaNormalForm t of
+                  Term.Referent' r -> (pure . formatPretty . tm) r
+                  x -> source x
               _ -> source e
       DD.Doc2SpecialFormSignature (Term.List' tms) ->
         let rs = [r | DD.Doc2Term (Term.Referent' r) <- toList tms]
diff --git a/unison-src/transcripts/fix3634.md b/unison-src/transcripts/fix3634.md
index 5ec2ca0da..0cb5f88dd 100644
--- a/unison-src/transcripts/fix3634.md
+++ b/unison-src/transcripts/fix3634.md
@@ -1,5 +1,4 @@
 ```ucm:hide
-.> builtins.merge
 .> builtins.mergeio
 ```
 

From 048d70a025c00407135c3b2ba8fca8d34af29951 Mon Sep 17 00:00:00 2001
From: Travis Staton <hello@travisstaton.com>
Date: Fri, 18 Nov 2022 16:04:10 -0500
Subject: [PATCH 39/41] Create option for unison that will write RTS stats to a
 file

fixes #3597
---
 unison-cli/package.yaml       |  2 +-
 unison-cli/unison-cli.cabal   |  3 ++-
 unison-cli/unison/ArgParse.hs | 18 +++++++++++++---
 unison-cli/unison/Main.hs     |  8 +++++--
 unison-cli/unison/Stats.hs    | 39 +++++++++++++++++++++++++++++++++++
 5 files changed, 63 insertions(+), 7 deletions(-)
 create mode 100644 unison-cli/unison/Stats.hs

diff --git a/unison-cli/package.yaml b/unison-cli/package.yaml
index 4eabb681f..564646295 100644
--- a/unison-cli/package.yaml
+++ b/unison-cli/package.yaml
@@ -118,7 +118,7 @@ executables:
         other-modules: Paths_unison_cli
     source-dirs: unison
     main: Main.hs
-    ghc-options: -threaded -rtsopts "-with-rtsopts=-I0 -N -qn4 -qg1" -optP-Wno-nonportable-include-path
+    ghc-options: -threaded -rtsopts "-with-rtsopts=-I0 -N -qn4 -qg1 -T" -optP-Wno-nonportable-include-path
     dependencies:
       - code-page
       - optparse-applicative >= 0.16.1.0
diff --git a/unison-cli/unison-cli.cabal b/unison-cli/unison-cli.cabal
index 040d553a1..29616f879 100644
--- a/unison-cli/unison-cli.cabal
+++ b/unison-cli/unison-cli.cabal
@@ -451,6 +451,7 @@ executable unison
   main-is: Main.hs
   other-modules:
       ArgParse
+      Stats
       System.Path
       Version
   hs-source-dirs:
@@ -485,7 +486,7 @@ executable unison
       TupleSections
       TypeApplications
       ViewPatterns
-  ghc-options: -Wall -threaded -rtsopts "-with-rtsopts=-I0 -N -qn4 -qg1" -optP-Wno-nonportable-include-path
+  ghc-options: -Wall -threaded -rtsopts "-with-rtsopts=-I0 -N -qn4 -qg1 -T" -optP-Wno-nonportable-include-path
   build-depends:
       IntervalMap
     , ListLike
diff --git a/unison-cli/unison/ArgParse.hs b/unison-cli/unison/ArgParse.hs
index 8c3b85bf6..207e5b39b 100644
--- a/unison-cli/unison/ArgParse.hs
+++ b/unison-cli/unison/ArgParse.hs
@@ -53,6 +53,7 @@ import qualified Options.Applicative as OptParse
 import Options.Applicative.Builder.Internal (noGlobal {- https://github.com/pcapriotti/optparse-applicative/issues/461 -})
 import Options.Applicative.Help (bold, (<+>))
 import qualified Options.Applicative.Help.Pretty as P
+import Stats
 import System.Environment (lookupEnv)
 import Text.Read (readMaybe)
 import qualified Unison.Codebase.Path as Path
@@ -116,7 +117,7 @@ data Command
   | -- @deprecated in trunk after M2g. Remove the Init command completely after M2h has been released
     Init
   | Run RunSource [String]
-  | Transcript ShouldForkCodebase ShouldSaveCodebase (NonEmpty FilePath)
+  | Transcript ShouldForkCodebase ShouldSaveCodebase (Maybe RtsStatsPath) (NonEmpty FilePath)
   deriving (Show, Eq)
 
 -- | Options shared by sufficiently many subcommands.
@@ -381,6 +382,15 @@ runCompiledParser :: Parser Command
 runCompiledParser =
   Run . RunCompiled <$> fileArgument "path/to/file" <*> runArgumentParser
 
+rtsStatsOption :: Parser (Maybe RtsStatsPath)
+rtsStatsOption =
+  let meta =
+        metavar "FILE.json"
+          <> long "rts-stats"
+          <> help "Write json summary of rts stats to FILE"
+          <> noGlobal
+   in optional (option OptParse.str meta)
+
 saveCodebaseFlag :: Parser ShouldSaveCodebase
 saveCodebaseFlag = flag DontSaveCodebase SaveCodebase (long "save-codebase" <> help saveHelp)
   where
@@ -448,15 +458,17 @@ transcriptParser :: Parser Command
 transcriptParser = do
   -- ApplicativeDo
   shouldSaveCodebase <- saveCodebaseFlag
+  mrtsStatsFp <- rtsStatsOption
   files <- liftA2 (NE.:|) (fileArgument "FILE") (many (fileArgument "FILES..."))
-  pure (Transcript DontFork shouldSaveCodebase files)
+  pure (Transcript DontFork shouldSaveCodebase mrtsStatsFp files)
 
 transcriptForkParser :: Parser Command
 transcriptForkParser = do
   -- ApplicativeDo
   shouldSaveCodebase <- saveCodebaseFlag
+  mrtsStatsFp <- rtsStatsOption
   files <- liftA2 (NE.:|) (fileArgument "FILE") (many (fileArgument "FILES..."))
-  pure (Transcript UseFork shouldSaveCodebase files)
+  pure (Transcript UseFork shouldSaveCodebase mrtsStatsFp files)
 
 unisonHelp :: String -> String -> P.Doc
 unisonHelp (P.text -> executable) (P.text -> version) =
diff --git a/unison-cli/unison/Main.hs b/unison-cli/unison/Main.hs
index a4f41367a..33b5a624e 100644
--- a/unison-cli/unison/Main.hs
+++ b/unison-cli/unison/Main.hs
@@ -42,6 +42,7 @@ import qualified Language.Haskell.TH as TH
 import qualified Language.Haskell.TH.Syntax as TH
 import qualified Network.HTTP.Client as HTTP
 import qualified Network.HTTP.Client.TLS as HTTP
+import Stats (recordRtsStats)
 import System.Directory (canonicalizePath, getCurrentDirectory, removeDirectoryRecursive)
 import System.Environment (getProgName, lookupEnv, withArgs)
 import qualified System.Exit as Exit
@@ -246,8 +247,11 @@ main = withCP65001 . runInUnboundThread . Ki.scoped $ \scope -> do
                         "to produce a new compiled program \
                         \that matches your version of Unison."
                     ]
-      Transcript shouldFork shouldSaveCodebase transcriptFiles ->
-        runTranscripts renderUsageInfo shouldFork shouldSaveCodebase mCodePathOption transcriptFiles
+      Transcript shouldFork shouldSaveCodebase mrtsStatsFp transcriptFiles -> do
+        let action = runTranscripts renderUsageInfo shouldFork shouldSaveCodebase mCodePathOption transcriptFiles
+        case mrtsStatsFp of
+          Nothing -> action
+          Just fp -> recordRtsStats fp action
       Launch isHeadless codebaseServerOpts downloadBase mayStartingPath shouldWatchFiles -> do
         getCodebaseOrExit mCodePathOption SC.MigrateAfterPrompt \(initRes, _, theCodebase) -> do
           runtime <- RTI.startRuntime False RTI.Persistent Version.gitDescribeWithDate
diff --git a/unison-cli/unison/Stats.hs b/unison-cli/unison/Stats.hs
new file mode 100644
index 000000000..cc96073b4
--- /dev/null
+++ b/unison-cli/unison/Stats.hs
@@ -0,0 +1,39 @@
+module Stats
+  ( RtsStatsPath (..),
+    recordRtsStats,
+  )
+where
+
+import Control.Exception (finally)
+import Data.Aeson (encode, object, (.=))
+import qualified Data.ByteString.Lazy as BL
+import Data.Function
+import Data.String (IsString)
+import GHC.Stats
+
+newtype RtsStatsPath
+  = RtsStatsPath FilePath
+  deriving stock (Show, Eq)
+  deriving newtype (IsString)
+
+recordRtsStats :: RtsStatsPath -> IO a -> IO a
+recordRtsStats (RtsStatsPath fp) action = do
+  r0 <- getRTSStats
+  action `finally` do
+    r1 <- getRTSStats
+    BL.writeFile fp (encode (produceStats r0 r1))
+  where
+    produceStats r0 r1 =
+      object
+        [ "gcs" .= on (-) gcs r1 r0,
+          "major_gcs" .= on (-) major_gcs r1 r0,
+          "allocated_bytes" .= on (-) allocated_bytes r1 r0,
+          "max_live_bytes" .= on (-) max_live_bytes r1 r0,
+          "copied_bytes" .= on (-) copied_bytes r1 r0,
+          "mutator_cpu_ns" .= on (-) mutator_cpu_ns r1 r0,
+          "mutator_elapsed_ns" .= on (-) mutator_elapsed_ns r1 r0,
+          "gc_cpu_ns" .= on (-) mutator_cpu_ns r1 r0,
+          "gc_elapsed_ns" .= on (-) mutator_elapsed_ns r1 r0,
+          "cpu_ns" .= on (-) cpu_ns r1 r0,
+          "elapsed_ns" .= on (-) cpu_ns r1 r0
+        ]

From 61a3264be5ad694d5a9b79248199f12349f2707e Mon Sep 17 00:00:00 2001
From: Arya Irani <538571+aryairani@users.noreply.github.com>
Date: Mon, 28 Nov 2022 15:04:21 -0500
Subject: [PATCH 40/41] Update
 unison-cli/src/Unison/CommandLine/OutputMessages.hs

---
 unison-cli/src/Unison/CommandLine/OutputMessages.hs | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs
index 2b4aa402f..533f8c0da 100644
--- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs
+++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs
@@ -1134,8 +1134,7 @@ notifyUser dir o = case o of
     GitSqliteCodebaseError e -> case e of
       CodebaseFileLockFailed ->
         P.wrap $
-          "Failed to obtain a file lock on the codebase. "
-            <> "Perhaps you are running multiple ucm processes against the same codebase."
+          "It looks to me like another ucm process is using this codebase. Only one ucm process can use a codebase at a time."
       NoDatabaseFile repo localPath ->
         P.wrap $
           "I didn't find a codebase in the repository at"

From eb2800984280b5682ebd151a063eefb4ea8900fc Mon Sep 17 00:00:00 2001
From: Stew O'Connor <mikeyo@gmail.com>
Date: Wed, 30 Nov 2022 10:22:55 -0800
Subject: [PATCH 41/41] Update LICENSE

update copyright year to 2022
---
 LICENSE | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/LICENSE b/LICENSE
index 9b2da73fd..be1b6d45f 100644
--- a/LICENSE
+++ b/LICENSE
@@ -1,4 +1,4 @@
-Copyright (c) 2013-2021, Unison Computing, public benefit corp and contributors
+Copyright (c) 2013-2022, Unison Computing, public benefit corp and contributors
 
 Permission is hereby granted, free of charge, to any person obtaining a copy
 of this software and associated documentation files (the "Software"), to deal