⅄ trunk → 22-12-14-tidy-up-hashing-package

2024-10-05 06:07:21 +03:00 · 2022-12-21 16:55:42 -05:00 · 2022-12-21 16:55:42 -05:00 · 68bc9e1561
commit 68bc9e1561
parent 09413134fd 4d7b6953c9
43 changed files with 4628 additions and 708 deletions
--- a/codebase2/codebase/U/Codebase/Referent.hs
+++ b/codebase2/codebase/U/Codebase/Referent.hs
@ -49,6 +49,11 @@ toReference = \case
  Ref termRef -> termRef
  Con typeRef _ -> typeRef

+toTermReference :: Referent' termRef typeRef -> Maybe termRef
+toTermReference = \case
+  Ref termRef -> Just termRef
+  Con _ _ -> Nothing
+
 type Id = Id' Hash Hash

 data Id' hTm hTp
--- a/lib/unison-util-relation/src/Unison/Util/Relation3.hs
+++ b/lib/unison-util-relation/src/Unison/Util/Relation3.hs
@ -94,6 +94,10 @@ mapD2Monotonic f Relation3 {d1, d2, d3} =
 member :: (Ord a, Ord b, Ord c) => a -> b -> c -> Relation3 a b c -> Bool
 member a b c = R.member b c . lookupD1 a

+memberD2 :: Ord b => b -> Relation3 a b c -> Bool
+memberD2 b =
+  Map.member b . d2
+
 lookupD1 :: (Ord a, Ord b, Ord c) => a -> Relation3 a b c -> Relation b c
 lookupD1 a = fromMaybe mempty . Map.lookup a . d1

--- a/lib/unison-util-relation/src/Unison/Util/Relation4.hs
+++ b/lib/unison-util-relation/src/Unison/Util/Relation4.hs
@ -55,6 +55,12 @@ fromList xs = insertAll xs empty
 filter :: (Ord a, Ord b, Ord c, Ord d) => ((a, b, c, d) -> Bool) -> Relation4 a b c d -> Relation4 a b c d
 filter f = fromList . Prelude.filter f . toList

+memberD13 :: (Ord a, Ord c) => a -> c -> Relation4 a b c d -> Bool
+memberD13 a c r4 =
+  case Map.lookup a (d1 r4) of
+    Nothing -> False
+    Just r3 -> R3.memberD2 c r3
+
 selectD3 ::
  (Ord a, Ord b, Ord c, Ord d) =>
  c ->
--- a/parser-typechecker/package.yaml
+++ b/parser-typechecker/package.yaml
@ -8,10 +8,15 @@ flags:
  optimized:
    manual: true
    default: true
+  arraychecks:
+    manual: true
+    default: false

 when:
  - condition: flag(optimized)
    ghc-options: -funbox-strict-fields -O2
+  - condition: flag(arraychecks)
+    cpp-options: -DARRAY_CHECK

 dependencies:
  - ListLike
--- a/parser-typechecker/src/U/Codebase/Branch/Diff.hs
+++ b/parser-typechecker/src/U/Codebase/Branch/Diff.hs
@ -3,8 +3,10 @@ module U.Codebase.Branch.Diff
    NameChanges (..),
    DefinitionDiffs (..),
    Diff (..),
+    NameBasedDiff (..),
    diffBranches,
    nameChanges,
+    nameBasedDiff,
  )
 where

@ -20,10 +22,13 @@ import qualified U.Codebase.Branch.Type as Branch
 import qualified U.Codebase.Causal as Causal
 import U.Codebase.Reference (Reference)
 import U.Codebase.Referent (Referent)
+import qualified U.Codebase.Referent as Referent
 import Unison.Name (Name)
 import qualified Unison.Name as Name
 import Unison.NameSegment (NameSegment)
 import Unison.Prelude
+import Unison.Util.Relation (Relation)
+import qualified Unison.Util.Relation as Relation

 data Diff a = Diff
  { adds :: Set a,
@ -83,56 +88,70 @@ data NameChanges = NameChanges
  }

 instance Semigroup NameChanges where
-  (NameChanges a b c d) <> (NameChanges a2 b2 c2 d2) =
+  NameChanges a b c d <> NameChanges a2 b2 c2 d2 =
    NameChanges (a <> a2) (b <> b2) (c <> c2) (d <> d2)

 instance Monoid NameChanges where
  mempty = NameChanges mempty mempty mempty mempty

+-- | A name-based diff for namespaces `N1` and `N2` is (for both terms and types) a relation between references, where
+-- `a R b` if:
+--
+--   1. `a` has name `n` in `N1`, and `b` has the same name `n` in `N2`
+--   2. `a` != `b`
+data NameBasedDiff = NameBasedDiff
+  { terms :: Relation Reference Reference,
+    types :: Relation Reference Reference
+  }
+  deriving stock (Generic, Show)
+
+instance Monoid NameBasedDiff where
+  mempty = NameBasedDiff mempty mempty
+
+instance Semigroup NameBasedDiff where
+  NameBasedDiff terms0 types0 <> NameBasedDiff terms1 types1 =
+    NameBasedDiff (terms0 <> terms1) (types0 <> types1)
+
 -- | Diff two Branches, returning a tree containing all of the changes
 diffBranches :: forall m. Monad m => Branch m -> Branch m -> m TreeDiff
 diffBranches from to = do
-  let termDiffs = diffMap (terms from) (terms to)
-  let typeDiffs = diffMap (types from) (types to)
+  let termDiffs = diffMap (Branch.terms from) (Branch.terms to)
+  let typeDiffs = diffMap (Branch.types from) (Branch.types to)
  let defDiff = DefinitionDiffs {termDiffs, typeDiffs}
  childDiff <- do
    Align.align (children from) (children to)
-      & wither
-        ( \case
-            This ca -> do
-              -- TODO: For the names index we really don't need to know which exact
-              -- names were removed, we just need to delete from the index using a
-              -- prefix query, this would be faster than crawling to get all the deletes.
-              removedChildBranch <- Causal.value ca
-              Just . unTreeDiff <$> diffBranches removedChildBranch Branch.empty
-            That ca -> do
-              newChildBranch <- Causal.value ca
-              Just . unTreeDiff <$> diffBranches Branch.empty newChildBranch
-            These fromC toC
-              | Causal.valueHash fromC == Causal.valueHash toC -> do
-                  -- This child didn't change.
-                  pure Nothing
-              | otherwise -> do
-                  fromChildBranch <- Causal.value fromC
-                  toChildBranch <- Causal.value toC
-                  diffBranches fromChildBranch toChildBranch >>= \case
-                    Lens.Empty -> pure Nothing
-                    TreeDiff cfr -> pure . Just $ cfr
-        )
+      & wither \case
+        This ca -> do
+          -- TODO: For the names index we really don't need to know which exact
+          -- names were removed, we just need to delete from the index using a
+          -- prefix query, this would be faster than crawling to get all the deletes.
+          removedChildBranch <- Causal.value ca
+          Just . unTreeDiff <$> diffBranches removedChildBranch Branch.empty
+        That ca -> do
+          newChildBranch <- Causal.value ca
+          Just . unTreeDiff <$> diffBranches Branch.empty newChildBranch
+        These fromC toC
+          | Causal.valueHash fromC == Causal.valueHash toC -> do
+              -- This child didn't change.
+              pure Nothing
+          | otherwise -> do
+              fromChildBranch <- Causal.value fromC
+              toChildBranch <- Causal.value toC
+              diffBranches fromChildBranch toChildBranch >>= \case
+                Lens.Empty -> pure Nothing
+                TreeDiff cfr -> pure . Just $ cfr
  pure $ TreeDiff (defDiff :< childDiff)
  where
    diffMap :: forall ref. Ord ref => Map NameSegment (Map ref (m MdValues)) -> Map NameSegment (Map ref (m MdValues)) -> Map NameSegment (Diff ref)
    diffMap l r =
      Align.align l r
-        & fmap
-          ( \case
-              (This refs) -> (Diff {removals = Map.keysSet refs, adds = mempty})
-              (That refs) -> (Diff {removals = mempty, adds = Map.keysSet refs})
-              (These l' r') ->
-                let lRefs = Map.keysSet l'
-                    rRefs = Map.keysSet r'
-                 in (Diff {removals = lRefs `Set.difference` rRefs, adds = rRefs `Set.difference` lRefs})
-          )
+        & fmap \case
+          This refs -> Diff {removals = Map.keysSet refs, adds = mempty}
+          That refs -> Diff {removals = mempty, adds = Map.keysSet refs}
+          These l' r' ->
+            let lRefs = Map.keysSet l'
+                rRefs = Map.keysSet r'
+             in Diff {removals = lRefs `Set.difference` rRefs, adds = rRefs `Set.difference` lRefs}

 -- | Get a summary of all of the name adds and removals from a tree diff.
 --
@ -144,22 +163,19 @@ nameChanges ::
  NameChanges
 nameChanges namePrefix (TreeDiff (DefinitionDiffs {termDiffs, typeDiffs} :< children)) =
  let (termNameAdds, termNameRemovals) =
-        ( termDiffs
-            & ifoldMap \ns diff ->
-              let name = appendName ns
-               in (listifyNames name $ adds diff, listifyNames name $ removals diff)
-        )
+        termDiffs
+          & ifoldMap \ns diff ->
+            let name = appendName ns
+             in (listifyNames name $ adds diff, listifyNames name $ removals diff)
      (typeNameAdds, typeNameRemovals) =
-        ( typeDiffs
-            & ifoldMap \ns diff ->
-              let name = appendName ns
-               in (listifyNames name $ adds diff, listifyNames name $ removals diff)
-        )
+        typeDiffs
+          & ifoldMap \ns diff ->
+            let name = appendName ns
+             in (listifyNames name $ adds diff, listifyNames name $ removals diff)
      childNameChanges =
-        ( children
-            & ifoldMap \ns childTree ->
-              nameChanges (Just $ appendName ns) (TreeDiff childTree)
-        )
+        children
+          & ifoldMap \ns childTree ->
+            nameChanges (Just $ appendName ns) (TreeDiff childTree)
   in NameChanges {termNameAdds, termNameRemovals, typeNameAdds, typeNameRemovals} <> childNameChanges
  where
    appendName :: NameSegment -> Name
@ -172,3 +188,26 @@ nameChanges namePrefix (TreeDiff (DefinitionDiffs {termDiffs, typeDiffs} :< chil
      xs
        & Set.toList
        & fmap (name,)
+
+-- | Get a 'NameBasedDiff' from a 'TreeDiff'.
+nameBasedDiff :: TreeDiff -> NameBasedDiff
+nameBasedDiff (TreeDiff defnDiffs) =
+  defnDiffs & foldMap \DefinitionDiffs {termDiffs, typeDiffs} ->
+    NameBasedDiff
+      { terms = foldMap nameBasedTermDiff termDiffs,
+        types = foldMap nameBasedTypeDiff typeDiffs
+      }
+  where
+    nameBasedTermDiff :: Diff Referent -> Relation Reference Reference
+    nameBasedTermDiff Diff {adds, removals} =
+      let termAdds = mapMaybe Referent.toTermReference (Set.toList adds)
+          termRemovals = mapMaybe Referent.toTermReference (Set.toList removals)
+       in ((,) <$> termRemovals <*> termAdds)
+            & filter (\(r0, r1) -> r0 /= r1)
+            & Relation.fromList
+
+    nameBasedTypeDiff :: Diff Reference -> Relation Reference Reference
+    nameBasedTypeDiff Diff {adds, removals} =
+      ((,) <$> Set.toList removals <*> Set.toList adds)
+        & filter (\(r0, r1) -> r0 /= r1)
+        & Relation.fromList
--- a/parser-typechecker/src/Unison/Codebase/Metadata.hs
+++ b/parser-typechecker/src/Unison/Codebase/Metadata.hs
@ -7,7 +7,6 @@ import Unison.Reference (Reference)
 import qualified Unison.Util.List as List
 import Unison.Util.Relation (Relation)
 import qualified Unison.Util.Relation as R
-import qualified Unison.Util.Relation3 as R3
 import Unison.Util.Relation4 (Relation4)
 import qualified Unison.Util.Relation4 as R4
 import Unison.Util.Star3 (Star3)
@ -44,8 +43,8 @@ hasMetadata :: Ord a => a -> Type -> Value -> Star a n -> Bool
 hasMetadata a t v = Set.member (t, v) . R.lookupDom a . Star3.d3

 hasMetadataWithType' :: Ord a => a -> Type -> R4 a n -> Bool
-hasMetadataWithType' a t r =
-  fromMaybe False $ Set.member t . R3.d2s <$> (Map.lookup a $ R4.d1 r)
+hasMetadataWithType' =
+  R4.memberD13

 hasMetadataWithType :: Ord a => a -> Type -> Star a n -> Bool
 hasMetadataWithType a t = Set.member t . R.lookupDom a . Star3.d2
--- a/parser-typechecker/src/Unison/Codebase/Watch.hs
+++ b/parser-typechecker/src/Unison/Codebase/Watch.hs
@ -97,9 +97,11 @@ watchDirectory dir allow = do
        if allow file
          then
            let handle :: IOException -> IO ()
-                handle e = do
-                  liftIO $ putStrLn $ "‼  Got an exception while reading: " <> file
-                  liftIO $ print (e :: IOException)
+                handle _e =
+                  -- Sometimes we notice a change and try to read a file while it's being written.
+                  -- This typically occurs when UCM is writing to the scratch file and can be
+                  -- ignored anyways.
+                  pure ()
                go :: IO (Maybe (FilePath, Text))
                go = liftIO $ do
                  contents <- readUtf8 file
--- a/parser-typechecker/src/Unison/Runtime/ANF.hs
+++ b/parser-typechecker/src/Unison/Runtime/ANF.hs
@ -58,6 +58,8 @@ module Unison.Runtime.ANF
    ANFM,
    Branched (.., MatchDataCover),
    Func (..),
+    SGEqv(..),
+    equivocate,
    superNormalize,
    anfTerm,
    valueTermLinks,
@ -66,6 +68,8 @@ module Unison.Runtime.ANF
    groupLinks,
    normalLinks,
    prettyGroup,
+    prettySuperNormal,
+    prettyANF,
  )
 where

@ -600,8 +604,9 @@ data ANormalF v e
  | AApp (Func v) [v]
  | AFrc v
  | AVar v
-  deriving (Show)
+  deriving (Show, Eq)

+  
 -- Types representing components that will go into the runtime tag of
 -- a data type value. RTags correspond to references, while CTags
 -- correspond to constructors.
@ -701,6 +706,109 @@ instance Bifoldable ANormalF where
  bifoldMap f _ (AFrc v) = f v
  bifoldMap f _ (AApp func args) = foldMap f func <> foldMap f args

+instance ABTN.Align ANormalF where
+  align f _ (AVar u) (AVar v) = Just $ AVar <$> f u v
+  align _ _ (ALit l) (ALit r)
+    | l == r = Just $ pure (ALit l)
+  align _ g (ALet dl ccl bl el) (ALet dr ccr br er)
+    | dl == dr, ccl == ccr =
+      Just $ ALet dl ccl <$> g bl br <*> g el er
+  align f g (AName hl asl el) (AName hr asr er)
+    | length asl == length asr
+    , Just hs <- alignEither f hl hr =
+    Just $
+      AName <$> hs
+            <*> traverse (uncurry f) (zip asl asr)
+            <*> g el er
+  align f g (AMatch vl bsl) (AMatch vr bsr)
+    | Just bss <- alignBranch g bsl bsr =
+    Just $ AMatch <$> f vl vr <*> bss
+  align f g (AHnd rl hl bl) (AHnd rr hr br)
+    | rl == rr = Just $ AHnd rl <$> f hl hr <*> g bl br
+  align _ g (AShift rl bl) (AShift rr br)
+    | rl == rr = Just $ AShift rl <$> g bl br
+  align f _ (AFrc u) (AFrc v) = Just $ AFrc <$> f u v
+  align f _ (AApp hl asl) (AApp hr asr)
+    | Just hs <- alignFunc f hl hr
+    , length asl == length asr
+    = Just $ AApp <$> hs <*> traverse (uncurry f) (zip asl asr)
+  align _ _ _ _ = Nothing
+
+alignEither ::
+  Applicative f =>
+  (l -> r -> f s) ->
+  Either Reference l -> Either Reference r -> Maybe (f (Either Reference s))
+alignEither _ (Left rl) (Left rr) | rl == rr = Just . pure $ Left rl
+alignEither f (Right u) (Right v) = Just $ Right <$> f u v
+alignEither _ _ _ = Nothing
+
+alignMaybe ::
+  Applicative f =>
+  (l -> r -> f s) ->
+  Maybe l -> Maybe r -> Maybe (f (Maybe s))
+alignMaybe f (Just l) (Just r) = Just $ Just <$> f l r
+alignMaybe _ Nothing Nothing = Just (pure Nothing)
+alignMaybe _ _ _ = Nothing
+
+alignFunc ::
+  Applicative f =>
+  (vl -> vr -> f vs) ->
+  Func vl -> Func vr -> Maybe (f (Func vs))
+alignFunc f (FVar u) (FVar v) = Just $ FVar <$> f u v
+alignFunc _ (FComb rl) (FComb rr) | rl == rr = Just . pure $ FComb rl
+alignFunc f (FCont u) (FCont v) = Just $ FCont <$> f u v
+alignFunc _ (FCon rl tl) (FCon rr tr)
+  | rl == rr, tl == tr = Just . pure $ FCon rl tl
+alignFunc _ (FReq rl tl) (FReq rr tr)
+  | rl == rr, tl == tr = Just . pure $ FReq rl tl
+alignFunc _ (FPrim ol) (FPrim or)
+  | ol == or = Just . pure $ FPrim ol
+alignFunc _ _ _ = Nothing
+
+alignBranch ::
+  Applicative f =>
+  (el -> er -> f es) ->
+  Branched el -> Branched er -> Maybe (f (Branched es))
+alignBranch _ MatchEmpty MatchEmpty = Just $ pure MatchEmpty
+alignBranch f (MatchIntegral bl dl) (MatchIntegral br dr)
+  | keysSet bl == keysSet br
+  , Just ds <- alignMaybe f dl dr
+  = Just $ MatchIntegral
+             <$> interverse f bl br
+             <*> ds
+alignBranch f (MatchText bl dl) (MatchText br dr)
+  | Map.keysSet bl == Map.keysSet br
+  , Just ds <- alignMaybe f dl dr
+  = Just $ MatchText
+             <$> traverse id (Map.intersectionWith f bl br)
+             <*> ds
+alignBranch f (MatchRequest bl pl) (MatchRequest br pr)
+  | Map.keysSet bl == Map.keysSet br
+  , all p (Map.keysSet bl)
+  = Just $ MatchRequest
+      <$> traverse id (Map.intersectionWith (interverse (alignCCs f)) bl br)
+      <*> f pl pr
+  where
+    p r = keysSet hsl == keysSet hsr && all q (keys hsl)
+      where
+        hsl = bl Map.! r
+        hsr = br Map.! r
+        q t = fst (hsl ! t) == fst (hsr ! t)
+alignBranch f (MatchData rfl bl dl) (MatchData rfr br dr)
+  | rfl == rfr
+  , keysSet bl == keysSet br
+  , all (\t -> fst (bl ! t) == fst (br ! t)) (keys bl)
+  , Just ds <- alignMaybe f dl dr
+  = Just $ MatchData rfl <$> interverse (alignCCs f) bl br <*> ds
+alignBranch f (MatchSum bl) (MatchSum br)
+  | keysSet bl == keysSet br
+  , all (\w -> fst (bl ! w) == fst (br ! w)) (keys bl)
+  = Just $ MatchSum <$> interverse (alignCCs f) bl br
+alignBranch _ _ _ = Nothing
+
+alignCCs :: Functor f => (l -> r -> f s) -> (a, l) -> (a, r) -> f (a, s)
+alignCCs f (ccs, l) (_, r) = (,) ccs <$> f l r
+
 matchLit :: Term v a -> Maybe Lit
 matchLit (Int' i) = Just $ I i
 matchLit (Nat' n) = Just $ N n
@ -927,7 +1035,7 @@ data Branched e
  | MatchEmpty
  | MatchData Reference (EnumMap CTag ([Mem], e)) (Maybe e)
  | MatchSum (EnumMap Word64 ([Mem], e))
-  deriving (Show, Functor, Foldable, Traversable)
+  deriving (Show, Eq, Functor, Foldable, Traversable)

 -- Data cases expected to cover all constructors
 pattern MatchDataCover :: Reference -> EnumMap CTag ([Mem], e) -> Branched e
@ -1038,7 +1146,7 @@ data Func v
    FReq !Reference !CTag
  | -- prim op
    FPrim (Either POp FOp)
-  deriving (Show, Functor, Foldable, Traversable)
+  deriving (Show, Eq, Functor, Foldable, Traversable)

 data Lit
  = I Int64
@ -1048,7 +1156,7 @@ data Lit
  | C Char
  | LM Referent
  | LY Reference
-  deriving (Show)
+  deriving (Show, Eq)

 litRef :: Lit -> Reference
 litRef (I _) = Ty.intRef
@ -1227,7 +1335,7 @@ type DNormal v = Directed () (ANormal v)

 -- Should be a completely closed term
 data SuperNormal v = Lambda {conventions :: [Mem], bound :: ANormal v}
-  deriving (Show)
+  deriving (Show, Eq)

 data SuperGroup v = Rec
  { group :: [(v, SuperNormal v)],
@ -1235,6 +1343,40 @@ data SuperGroup v = Rec
  }
  deriving (Show)

+instance Var v => Eq (SuperGroup v) where
+  g0 == g1 | Left _ <- equivocate g0 g1 = False | otherwise = True
+
+-- Failure modes for SuperGroup alpha equivalence test
+data SGEqv v
+  -- mismatch number of definitions in group
+  = NumDefns (SuperGroup v) (SuperGroup v)
+  -- mismatched SuperNormal calling conventions
+  | DefnConventions (SuperNormal v) (SuperNormal v)
+  -- mismatched subterms in corresponding definition
+  | Subterms (ANormal v) (ANormal v)
+
+-- Checks if two SuperGroups are equivalent up to renaming. The rest
+-- of the structure must match on the nose. If the two groups are not
+-- equivalent, an example of conflicting structure is returned.
+equivocate ::
+  Var v =>
+  SuperGroup v -> SuperGroup v -> Either (SGEqv v) ()
+equivocate g0@(Rec bs0 e0) g1@(Rec bs1 e1)
+  | length bs0 == length bs1 =
+    traverse_ eqvSN (zip ns0 ns1) *> eqvSN (e0, e1)
+  | otherwise = Left $ NumDefns g0 g1
+  where
+  (vs0, ns0) = unzip bs0
+  (vs1, ns1) = unzip bs1
+  vm = Map.fromList (zip vs1 vs0)
+
+  promote (Left (l, r)) = Left $ Subterms l r
+  promote (Right v) = Right v
+
+  eqvSN (Lambda ccs0 e0, Lambda ccs1 e1)
+    | ccs0 == ccs1 = promote $ ABTN.alpha vm e0 e1
+  eqvSN (n0, n1) = Left $ DefnConventions n0 n1
+
 type ANFM v =
  ReaderT
    (Set v)
--- a/parser-typechecker/src/Unison/Runtime/Array.hs
+++ b/parser-typechecker/src/Unison/Runtime/Array.hs
@ -0,0 +1,378 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
+
+-- This module wraps the operations in the primitive package so that
+-- bounds checks can be toggled on during the build for debugging
+-- purposes. It exports the entire API for the three array types
+-- needed, and adds wrappers for the operations that are unchecked in
+-- the base library.
+--
+-- Checking is toggled using the `arraychecks` flag.
+module Unison.Runtime.Array
+  ( module EPA,
+    readArray,
+    writeArray,
+    copyArray,
+    copyMutableArray,
+    cloneMutableArray,
+    readByteArray,
+    writeByteArray,
+    indexByteArray,
+    copyByteArray,
+    copyMutableByteArray,
+    moveByteArray,
+    readPrimArray,
+    writePrimArray,
+    indexPrimArray,
+  )
+where
+
+import Control.Monad.Primitive
+import Data.Kind (Constraint)
+import Data.Primitive.Array as EPA hiding
+  ( cloneMutableArray,
+    copyArray,
+    copyMutableArray,
+    readArray,
+    writeArray,
+  )
+import qualified Data.Primitive.Array as PA
+import Data.Primitive.ByteArray as EPA hiding
+  ( copyByteArray,
+    copyMutableByteArray,
+    indexByteArray,
+    moveByteArray,
+    readByteArray,
+    writeByteArray,
+  )
+import qualified Data.Primitive.ByteArray as PA
+import Data.Primitive.PrimArray as EPA hiding
+  ( indexPrimArray,
+    readPrimArray,
+    writePrimArray,
+  )
+import qualified Data.Primitive.PrimArray as PA
+import Data.Primitive.Types
+
+#ifdef ARRAY_CHECK
+import GHC.Stack
+
+type CheckCtx :: Constraint
+type CheckCtx = HasCallStack
+
+type MA = MutableArray
+type MBA = MutableByteArray
+type A = Array
+type BA = ByteArray
+
+-- check index mutable array
+checkIMArray
+  :: CheckCtx
+  => String
+  -> (MA s a -> Int -> r)
+  -> MA s a -> Int -> r
+checkIMArray name f arr i
+  | i < 0 || sizeofMutableArray arr <= i
+  = error $ name ++ " unsafe check out of bounds: " ++ show i
+  | otherwise = f arr i
+{-# inline checkIMArray #-}
+
+-- check copy array
+checkCArray
+  :: CheckCtx
+  => String
+  -> (MA s a -> Int -> A a -> Int -> Int -> r)
+  -> MA s a -> Int -> A a -> Int -> Int -> r
+checkCArray name f dst d src s l
+  | d < 0
+  || s < 0
+  || sizeofMutableArray dst < d + l
+  || sizeofArray src < s + l
+  = error $ name ++ " unsafe check out of bounds: " ++ show (d, s, l)
+  | otherwise = f dst d src s l
+{-# inline checkCArray #-}
+
+-- check copy mutable array
+checkCMArray
+  :: CheckCtx
+  => String
+  -> (MA s a -> Int -> MA s a -> Int -> Int -> r)
+  -> MA s a -> Int -> MA s a -> Int -> Int -> r
+checkCMArray name f dst d src s l
+  | d < 0
+  || s < 0
+  || sizeofMutableArray dst < d + l
+  || sizeofMutableArray src < s + l
+  = error $ name ++ " unsafe check out of bounds: " ++ show (d, s, l)
+  | otherwise = f dst d src s l
+{-# inline checkCMArray #-}
+
+-- check range mutable array
+checkRMArray
+  :: CheckCtx
+  => String
+  -> (MA s a -> Int -> Int -> r)
+  -> MA s a -> Int -> Int -> r
+checkRMArray name f arr o l
+  | o < 0 || sizeofMutableArray arr < o+l
+  = error $ name ++ "unsafe check out of bounds: " ++ show (o, l)
+  | otherwise = f arr o l
+{-# inline checkRMArray #-}
+
+-- check index byte array
+checkIBArray
+  :: CheckCtx
+  => Prim a
+  => String
+  -> a
+  -> (ByteArray -> Int -> r)
+  -> ByteArray -> Int -> r
+checkIBArray name a f arr i
+  | i < 0 || sizeofByteArray arr `quot` sizeOf a <= i
+  = error $ name ++ " unsafe check out of bounds: " ++ show i
+  | otherwise = f arr i
+{-# inline checkIBArray #-}
+
+-- check index mutable byte array
+checkIMBArray
+  :: CheckCtx
+  => Prim a
+  => String
+  -> a
+  -> (MutableByteArray s -> Int -> r)
+  -> MutableByteArray s -> Int -> r
+checkIMBArray name a f arr i
+  | i < 0 || sizeofMutableByteArray arr `quot` sizeOf a <= i
+  = error $ name ++ " unsafe check out of bounds: " ++ show i
+  | otherwise = f arr i
+{-# inline checkIMBArray #-}
+
+-- check copy byte array
+checkCBArray
+  :: CheckCtx
+  => String
+  -> (MBA s -> Int -> BA -> Int -> Int -> r)
+  -> MBA s -> Int -> BA -> Int -> Int -> r
+checkCBArray name f dst d src s l
+  | d < 0
+  || s < 0
+  || sizeofMutableByteArray dst < d + l
+  || sizeofByteArray src < s + l
+  = error $ name ++ " unsafe check out of bounds: " ++ show (d, s, l)
+  | otherwise = f dst d src s l
+{-# inline checkCBArray #-}
+
+-- check copy mutable byte array
+checkCMBArray
+  :: CheckCtx
+  => String
+  -> (MBA s -> Int -> MBA s -> Int -> Int -> r)
+  -> MBA s -> Int -> MBA s -> Int -> Int -> r
+checkCMBArray name f dst d src s l
+  | d < 0
+  || s < 0
+  || sizeofMutableByteArray dst < d + l
+  || sizeofMutableByteArray src < s + l
+  = error $ name ++ " unsafe check out of bounds: " ++ show (d, s, l)
+  | otherwise = f dst d src s l
+{-# inline checkCMBArray #-}
+
+-- check index prim array
+checkIPArray
+  :: CheckCtx
+  => Prim a
+  => String
+  -> (PrimArray a -> Int -> r)
+  -> PrimArray a -> Int -> r
+checkIPArray name f arr i
+  | i < 0 || sizeofPrimArray arr <= i
+  = error $ name ++ " unsafe check out of bounds: " ++ show i
+  | otherwise = f arr i
+{-# inline checkIPArray #-}
+
+-- check index mutable prim array
+checkIMPArray
+  :: CheckCtx
+  => Prim a
+  => String
+  -> (MutablePrimArray s a -> Int -> r)
+  -> MutablePrimArray s a -> Int -> r
+checkIMPArray name f arr i
+  | i < 0 || sizeofMutablePrimArray arr <= i
+  = error $ name ++ " unsafe check out of bounds: " ++ show i
+  | otherwise = f arr i
+{-# inline checkIMPArray #-}
+
+#else
+type CheckCtx :: Constraint
+type CheckCtx = ()
+
+checkIMArray, checkIMPArray, checkIPArray :: String -> r -> r
+checkCArray, checkCMArray, checkRMArray :: String -> r -> r
+checkIMArray _ = id
+checkIMPArray _ = id
+checkCArray _ = id
+checkCMArray _ = id
+checkRMArray _ = id
+checkIPArray _ = id
+
+checkIBArray, checkIMBArray :: String -> a -> r -> r
+checkCBArray, checkCMBArray :: String -> r -> r
+checkIBArray _ _ = id
+checkIMBArray _ _ = id
+checkCBArray _ = id
+checkCMBArray _ = id
+#endif
+
+readArray ::
+  CheckCtx =>
+  PrimMonad m =>
+  MutableArray (PrimState m) a ->
+  Int ->
+  m a
+readArray = checkIMArray "readArray" PA.readArray
+{-# INLINE readArray #-}
+
+writeArray ::
+  CheckCtx =>
+  PrimMonad m =>
+  MutableArray (PrimState m) a ->
+  Int ->
+  a ->
+  m ()
+writeArray = checkIMArray "writeArray" PA.writeArray
+{-# INLINE writeArray #-}
+
+copyArray ::
+  CheckCtx =>
+  PrimMonad m =>
+  MutableArray (PrimState m) a ->
+  Int ->
+  Array a ->
+  Int ->
+  Int ->
+  m ()
+copyArray = checkCArray "copyArray" PA.copyArray
+{-# INLINE copyArray #-}
+
+cloneMutableArray ::
+  CheckCtx =>
+  PrimMonad m =>
+  MutableArray (PrimState m) a ->
+  Int ->
+  Int ->
+  m (MutableArray (PrimState m) a)
+cloneMutableArray = checkRMArray "cloneMutableArray" PA.cloneMutableArray
+{-# INLINE cloneMutableArray #-}
+
+copyMutableArray ::
+  CheckCtx =>
+  PrimMonad m =>
+  MutableArray (PrimState m) a ->
+  Int ->
+  MutableArray (PrimState m) a ->
+  Int ->
+  Int ->
+  m ()
+copyMutableArray = checkCMArray "copyMutableArray" PA.copyMutableArray
+{-# INLINE copyMutableArray #-}
+
+readByteArray ::
+  forall a m.
+  CheckCtx =>
+  PrimMonad m =>
+  Prim a =>
+  MutableByteArray (PrimState m) ->
+  Int ->
+  m a
+readByteArray = checkIMBArray @a "readByteArray" undefined PA.readByteArray
+{-# INLINE readByteArray #-}
+
+writeByteArray ::
+  forall a m.
+  CheckCtx =>
+  PrimMonad m =>
+  Prim a =>
+  MutableByteArray (PrimState m) ->
+  Int ->
+  a ->
+  m ()
+writeByteArray = checkIMBArray @a "writeByteArray" undefined PA.writeByteArray
+{-# INLINE writeByteArray #-}
+
+indexByteArray ::
+  forall a.
+  CheckCtx =>
+  Prim a =>
+  ByteArray ->
+  Int ->
+  a
+indexByteArray = checkIBArray @a "indexByteArray" undefined PA.indexByteArray
+{-# INLINE indexByteArray #-}
+
+copyByteArray ::
+  CheckCtx =>
+  PrimMonad m =>
+  MutableByteArray (PrimState m) ->
+  Int ->
+  ByteArray ->
+  Int ->
+  Int ->
+  m ()
+copyByteArray = checkCBArray "copyByteArray" PA.copyByteArray
+{-# INLINE copyByteArray #-}
+
+copyMutableByteArray ::
+  CheckCtx =>
+  PrimMonad m =>
+  MutableByteArray (PrimState m) ->
+  Int ->
+  MutableByteArray (PrimState m) ->
+  Int ->
+  Int ->
+  m ()
+copyMutableByteArray = checkCMBArray "copyMutableByteArray" PA.copyMutableByteArray
+{-# INLINE copyMutableByteArray #-}
+
+moveByteArray ::
+  CheckCtx =>
+  PrimMonad m =>
+  MutableByteArray (PrimState m) ->
+  Int ->
+  MutableByteArray (PrimState m) ->
+  Int ->
+  Int ->
+  m ()
+moveByteArray = checkCMBArray "moveByteArray" PA.moveByteArray
+{-# INLINE moveByteArray #-}
+
+readPrimArray ::
+  CheckCtx =>
+  PrimMonad m =>
+  Prim a =>
+  MutablePrimArray (PrimState m) a ->
+  Int ->
+  m a
+readPrimArray = checkIMPArray "readPrimArray" PA.readPrimArray
+{-# INLINE readPrimArray #-}
+
+writePrimArray ::
+  CheckCtx =>
+  PrimMonad m =>
+  Prim a =>
+  MutablePrimArray (PrimState m) a ->
+  Int ->
+  a ->
+  m ()
+writePrimArray = checkIMPArray "writePrimArray" PA.writePrimArray
+{-# INLINE writePrimArray #-}
+
+indexPrimArray ::
+  CheckCtx =>
+  Prim a =>
+  PrimArray a ->
+  Int ->
+  a
+indexPrimArray = checkIPArray "indexPrimArray" PA.indexPrimArray
+{-# INLINE indexPrimArray #-}
--- a/parser-typechecker/src/Unison/Runtime/Builtin.hs
+++ b/parser-typechecker/src/Unison/Runtime/Builtin.hs
@ -51,7 +51,6 @@ import Data.IORef as SYS
  )
 import qualified Data.Map as Map
 import Data.PEM (PEM, pemContent, pemParseLBS)
-import qualified Data.Primitive as PA
 import Data.Set (insert)
 import qualified Data.Set as Set
 import qualified Data.Text
@ -131,6 +130,7 @@ import Unison.Reference
 import Unison.Referent (pattern Ref)
 import Unison.Runtime.ANF as ANF
 import Unison.Runtime.ANF.Serialize as ANF
+import qualified Unison.Runtime.Array as PA
 import Unison.Runtime.Exception (die)
 import Unison.Runtime.Foreign
  ( Foreign (Wrap),
@ -1970,7 +1970,7 @@ declareForeign sand name op func0 = do
          | sanitize,
            Tracked <- sand,
            FF r w _ <- func0 =
-            FF r w (bomb name)
+              FF r w (bomb name)
          | otherwise = func0
        code = (name, (sand, uncurry Lambda (op w)))
     in (w + 1, code : codes, mapInsert w (name, func) funcs)
--- a/parser-typechecker/src/Unison/Runtime/Foreign.hs
+++ b/parser-typechecker/src/Unison/Runtime/Foreign.hs
@ -44,6 +44,68 @@ data Foreign where
 promote :: (a -> a -> r) -> b -> c -> r
 promote (~~) x y = unsafeCoerce x ~~ unsafeCoerce y

+-- These functions are explicit aliases of the overloaded function.
+-- When the overloaded function is used in their place, it seems to
+-- cause issues with regard to `promote` above. Somehow, the
+-- unsafeCoerce can cause memory faults, even when the values are
+-- being coerced to appropriate types. Having an explicit, noinline
+-- alias seems to prevent the faults.
+txtEq :: Text -> Text -> Bool
+txtEq l r = l == r
+{-# NOINLINE txtEq #-}
+
+txtCmp :: Text -> Text -> Ordering
+txtCmp l r = compare l r
+{-# NOINLINE txtCmp #-}
+
+bytesEq :: Bytes -> Bytes -> Bool
+bytesEq l r = l == r
+{-# NOINLINE bytesEq #-}
+
+bytesCmp :: Bytes -> Bytes -> Ordering
+bytesCmp l r = compare l r
+{-# NOINLINE bytesCmp #-}
+
+mvarEq :: MVar () -> MVar () -> Bool
+mvarEq l r = l == r
+{-# NOINLINE mvarEq #-}
+
+refEq :: IORef () -> IORef () -> Bool
+refEq l r = l == r
+{-# NOINLINE refEq #-}
+
+tidEq :: ThreadId -> ThreadId -> Bool
+tidEq l r = l == r
+{-# NOINLINE tidEq #-}
+
+tidCmp :: ThreadId -> ThreadId -> Ordering
+tidCmp l r = compare l r
+{-# NOINLINE tidCmp #-}
+
+marrEq :: MutableArray () () -> MutableArray () () -> Bool
+marrEq l r = l == r
+{-# NOINLINE marrEq #-}
+
+mbarrEq :: MutableByteArray () -> MutableByteArray () -> Bool
+mbarrEq l r = l == r
+{-# NOINLINE mbarrEq #-}
+
+barrEq :: ByteArray -> ByteArray -> Bool
+barrEq l r = l == r
+{-# NOINLINE barrEq #-}
+
+barrCmp :: ByteArray -> ByteArray -> Ordering
+barrCmp l r = compare l r
+{-# NOINLINE barrCmp #-}
+
+cpatEq :: CPattern -> CPattern -> Bool
+cpatEq l r = l == r
+{-# NOINLINE cpatEq #-}
+
+cpatCmp :: CPattern -> CPattern -> Ordering
+cpatCmp l r = compare l r
+{-# NOINLINE cpatCmp #-}
+
 tylEq :: Reference -> Reference -> Bool
 tylEq r l = r == l
 {-# NOINLINE tylEq #-}
@ -62,31 +124,31 @@ tmlCmp r l = compare r l

 ref2eq :: Reference -> Maybe (a -> b -> Bool)
 ref2eq r
-  | r == Ty.textRef = Just $ promote ((==) @Text)
+  | r == Ty.textRef = Just $ promote txtEq
  | r == Ty.termLinkRef = Just $ promote tmlEq
  | r == Ty.typeLinkRef = Just $ promote tylEq
-  | r == Ty.bytesRef = Just $ promote ((==) @Bytes)
+  | r == Ty.bytesRef = Just $ promote bytesEq
  -- Note: MVar equality is just reference equality, so it shouldn't
  -- matter what type the MVar holds.
-  | r == Ty.mvarRef = Just $ promote ((==) @(MVar ()))
+  | r == Ty.mvarRef = Just $ promote mvarEq
  -- Ditto
-  | r == Ty.refRef = Just $ promote ((==) @(IORef ()))
-  | r == Ty.threadIdRef = Just $ promote ((==) @ThreadId)
-  | r == Ty.marrayRef = Just $ promote ((==) @(MutableArray () ()))
-  | r == Ty.mbytearrayRef = Just $ promote ((==) @(MutableByteArray ()))
-  | r == Ty.ibytearrayRef = Just $ promote ((==) @ByteArray)
-  | r == Ty.patternRef = Just $ promote ((==) @CPattern)
+  | r == Ty.refRef = Just $ promote refEq
+  | r == Ty.threadIdRef = Just $ promote tidEq
+  | r == Ty.marrayRef = Just $ promote marrEq
+  | r == Ty.mbytearrayRef = Just $ promote mbarrEq
+  | r == Ty.ibytearrayRef = Just $ promote barrEq
+  | r == Ty.patternRef = Just $ promote cpatEq
  | otherwise = Nothing

 ref2cmp :: Reference -> Maybe (a -> b -> Ordering)
 ref2cmp r
-  | r == Ty.textRef = Just $ promote (compare @Text)
+  | r == Ty.textRef = Just $ promote txtCmp
  | r == Ty.termLinkRef = Just $ promote tmlCmp
  | r == Ty.typeLinkRef = Just $ promote tylCmp
-  | r == Ty.bytesRef = Just $ promote (compare @Bytes)
-  | r == Ty.threadIdRef = Just $ promote (compare @ThreadId)
-  | r == Ty.ibytearrayRef = Just $ promote (compare @ByteArray)
-  | r == Ty.patternRef = Just $ promote (compare @CPattern)
+  | r == Ty.bytesRef = Just $ promote bytesCmp
+  | r == Ty.threadIdRef = Just $ promote tidCmp
+  | r == Ty.ibytearrayRef = Just $ promote barrCmp
+  | r == Ty.patternRef = Just $ promote cpatCmp
  | otherwise = Nothing

 instance Eq Foreign where
--- a/parser-typechecker/src/Unison/Runtime/Machine.hs
+++ b/parser-typechecker/src/Unison/Runtime/Machine.hs
@ -15,8 +15,6 @@ import Control.Exception
 import Data.Bits
 import qualified Data.Map.Strict as M
 import Data.Ord (comparing)
-import qualified Data.Primitive.Array as PA
-import qualified Data.Primitive.PrimArray as PA
 import qualified Data.Sequence as Sq
 import qualified Data.Set as S
 import qualified Data.Set as Set
@ -40,6 +38,7 @@ import Unison.Runtime.ANF as ANF
    valueLinks,
  )
 import qualified Unison.Runtime.ANF as ANF
+import Unison.Runtime.Array as PA
 import Unison.Runtime.Builtin
 import Unison.Runtime.Exception
 import Unison.Runtime.Foreign
--- a/parser-typechecker/src/Unison/Runtime/Stack.hs
+++ b/parser-typechecker/src/Unison/Runtime/Stack.hs
@ -48,15 +48,13 @@ import Control.Monad (when)
 import Control.Monad.Primitive
 import Data.Foldable as F (for_)
 import qualified Data.Kind as Kind
-import Data.Primitive.Array
-import Data.Primitive.ByteArray
-import Data.Primitive.PrimArray
 import Data.Sequence (Seq)
 import Data.Word
 import GHC.Exts as L (IsList (..))
 import GHC.Stack (HasCallStack)
 import Unison.Reference (Reference)
 import Unison.Runtime.ANF as ANF (Mem (..))
+import Unison.Runtime.Array
 import Unison.Runtime.Foreign
 import Unison.Runtime.MCode
 import qualified Unison.Type as Ty
@ -111,12 +109,13 @@ data Closure
  deriving (Show, Eq, Ord)

 traceK :: Reference -> K -> [(Reference, Int)]
-traceK begin = dedup (begin, 1) where
-  dedup p (Mark _ _ _ _ k) = dedup p k
-  dedup p@(cur,n) (Push _ _ _ _ (CIx r _ _) k)
-    | cur == r = dedup (cur,1+n) k
-    | otherwise = p : dedup (r,1) k
-  dedup p _ = [p]
+traceK begin = dedup (begin, 1)
+  where
+    dedup p (Mark _ _ _ _ k) = dedup p k
+    dedup p@(cur, n) (Push _ _ _ _ (CIx r _ _) k)
+      | cur == r = dedup (cur, 1 + n) k
+      | otherwise = p : dedup (r, 1) k
+    dedup p _ = [p]

 splitData :: Closure -> Maybe (Reference, Word64, [Int], [Closure])
 splitData (Enum r t) = Just (r, t, [], [])
--- a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs
+++ b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs
@ -1,4 +1,16 @@
-module Unison.Syntax.TermPrinter (emptyAc, pretty, prettyBlock, prettyBlock', pretty', prettyBinding, prettyBinding', pretty0, runPretty) where
+module Unison.Syntax.TermPrinter
+  ( emptyAc,
+    pretty,
+    prettyBlock,
+    prettyBlock',
+    pretty',
+    prettyBinding,
+    prettyBinding',
+    prettyBindingWithoutTypeSignature,
+    pretty0,
+    runPretty,
+  )
+where

 import Control.Lens (unsnoc, (^.))
 import Control.Monad.State (evalState)
@ -508,7 +520,7 @@ pretty0
          printBinding (v, binding) =
            if Var.isAction v
              then pretty0 (ac (-1) Normal im doc) binding
-              else prettyBinding0 (ac (-1) Normal im doc) (HQ.unsafeFromVar v) binding
+              else renderPrettyBinding <$> prettyBinding0 (ac (-1) Normal im doc) (HQ.unsafeFromVar v) binding
          letIntro = case sc of
            Block -> id
            Normal -> \x -> fmt S.ControlKeyword "let" `PP.hang` x
@ -775,27 +787,63 @@ printCase im doc ms0 =
            <$> pretty0 (ac 2 Normal im doc) g
        printBody b = let (im', uses) = calcImports im b in goBody im' uses b

-{- Render a binding, producing output of the form
+-- A pretty term binding, split into the type signature (possibly empty) and the term.
+data PrettyBinding = PrettyBinding
+  { typeSignature :: Maybe (Pretty SyntaxText),
+    term :: Pretty SyntaxText
+  }

-foo : t -> u
-foo a = ...
+-- Render a pretty binding.
+renderPrettyBinding :: PrettyBinding -> Pretty SyntaxText
+renderPrettyBinding PrettyBinding {typeSignature, term} =
+  case typeSignature of
+    Nothing -> term
+    Just ty -> PP.lines [ty, term]

-The first line is only output if the term has a type annotation as the
-outermost constructor.
+-- Render a pretty binding without a type signature.
+renderPrettyBindingWithoutTypeSignature :: PrettyBinding -> Pretty SyntaxText
+renderPrettyBindingWithoutTypeSignature PrettyBinding {term} =
+  term

-Binary functions with symbolic names are output infix, as follows:
-
-(+) : t -> t -> t
-a + b = ...
-
-}
+-- | Render a binding, producing output of the form
+--
+-- foo : t -> u
+-- foo a = ...
+--
+-- The first line is only output if the term has a type annotation as the
+-- outermost constructor.
+--
+-- Binary functions with symbolic names are output infix, as follows:
+--
+-- (+) : t -> t -> t
+-- a + b = ...
 prettyBinding ::
  Var v =>
  PrettyPrintEnv ->
  HQ.HashQualified Name ->
  Term2 v at ap v a ->
  Pretty SyntaxText
-prettyBinding ppe n = runPretty ppe . prettyBinding0 (ac (-1) Block Map.empty MaybeDoc) n
+prettyBinding =
+  prettyBinding_ renderPrettyBinding
+
+-- | Like 'prettyBinding', but elides the type signature (if any).
+prettyBindingWithoutTypeSignature ::
+  Var v =>
+  PrettyPrintEnv ->
+  HQ.HashQualified Name ->
+  Term2 v at ap v a ->
+  Pretty SyntaxText
+prettyBindingWithoutTypeSignature =
+  prettyBinding_ renderPrettyBindingWithoutTypeSignature
+
+prettyBinding_ ::
+  Var v =>
+  (PrettyBinding -> Pretty SyntaxText) ->
+  PrettyPrintEnv ->
+  HQ.HashQualified Name ->
+  Term2 v at ap v a ->
+  Pretty SyntaxText
+prettyBinding_ go ppe n = runPretty ppe . fmap go . prettyBinding0 (ac (-1) Block Map.empty MaybeDoc) n

 prettyBinding' ::
  Var v =>
@ -812,7 +860,7 @@ prettyBinding0 ::
  AmbientContext ->
  HQ.HashQualified Name ->
  Term2 v at ap v a ->
-  m (Pretty SyntaxText)
+  m PrettyBinding
 prettyBinding0 a@AmbientContext {imports = im, docContext = doc} v term =
  go (symbolic && isBinary term) term
  where
@ -831,26 +879,26 @@ prettyBinding0 a@AmbientContext {imports = im, docContext = doc} v term =
                _ -> id
          tp' <- TypePrinter.pretty0 im (-1) tp
          tm' <- avoidCapture (prettyBinding0 a v tm)
-          pure $
-            PP.lines
-              [ PP.group
-                  ( renderName v
-                      <> PP.hang
-                        (fmt S.TypeAscriptionColon " :")
-                        tp'
-                  ),
-                PP.group tm'
-              ]
+          pure
+            PrettyBinding
+              { typeSignature = Just (PP.group (renderName v <> PP.hang (fmt S.TypeAscriptionColon " :") tp')),
+                term = PP.group (renderPrettyBinding tm')
+              }
        (printAnnotate env -> LamsNamedMatch' vs branches) -> do
          branches' <- printCase im doc branches
-          pure . PP.group $
-            PP.group
-              ( defnLhs v vs <> fmt S.BindingEquals " =" <> " "
-                  <> fmt
-                    S.ControlKeyword
-                    "cases"
-              )
-              `PP.hang` branches'
+          pure
+            PrettyBinding
+              { typeSignature = Nothing,
+                term =
+                  PP.group $
+                    PP.group
+                      ( defnLhs v vs <> fmt S.BindingEquals " =" <> " "
+                          <> fmt
+                            S.ControlKeyword
+                            "cases"
+                      )
+                      `PP.hang` branches'
+              }
        LamsNamedOrDelay' vs body -> do
          -- In the case where we're being called from inside `pretty0`, this
          -- call to printAnnotate is unfortunately repeating work we've already
@ -862,10 +910,15 @@ prettyBinding0 a@AmbientContext {imports = im, docContext = doc} v term =
          let hang = case body' of
                Delay' (Lets' _ _) -> PP.softHang
                _ -> PP.hang
-          pure . PP.group $
-            PP.group (defnLhs v vs <> fmt S.BindingEquals " =")
-              `hang` uses [prettyBody]
-        t -> pure $ l "error: " <> l (show t)
+          pure
+            PrettyBinding
+              { typeSignature = Nothing,
+                term =
+                  PP.group $
+                    PP.group (defnLhs v vs <> fmt S.BindingEquals " =")
+                      `hang` uses [prettyBody]
+              }
+        t -> error ("prettyBinding0: unexpected term: " ++ show t)
      where
        defnLhs v vs
          | infix' = case vs of
--- a/parser-typechecker/src/Unison/Util/EnumContainers.hs
+++ b/parser-typechecker/src/Unison/Util/EnumContainers.hs
@ -9,6 +9,7 @@ module Unison.Util.EnumContainers
    setSingleton,
    mapInsert,
    unionWith,
+    intersectionWith,
    hasKey,
    keys,
    keysSet,
@ -22,7 +23,9 @@ module Unison.Util.EnumContainers
    mapToList,
    (!),
    findMin,
+    interverse,
    traverseSet_,
+    traverseWithKey,
    setSize,
  )
 where
@ -89,7 +92,6 @@ mapInsert :: EnumKey k => k -> a -> EnumMap k a -> EnumMap k a
 mapInsert e x (EM m) = EM $ IM.insert (keyToInt e) x m

 unionWith ::
-  EnumKey k =>
  EnumKey k =>
  (a -> a -> a) ->
  EnumMap k a ->
@ -97,6 +99,13 @@ unionWith ::
  EnumMap k a
 unionWith f (EM l) (EM r) = EM $ IM.unionWith f l r

+intersectionWith ::
+  (a -> b -> c) ->
+  EnumMap k a ->
+  EnumMap k b ->
+  EnumMap k c
+intersectionWith f (EM l) (EM r) = EM $ IM.intersectionWith f l r
+
 keys :: EnumKey k => EnumMap k a -> [k]
 keys (EM m) = fmap intToKey . IM.keys $ m

@ -141,5 +150,22 @@ traverseSet_ ::
 traverseSet_ f (ES s) =
  IS.foldr (\i r -> f (intToKey i) *> r) (pure ()) s

+interverse ::
+  Applicative f =>
+  (a -> b -> f c) ->
+  EnumMap k a ->
+  EnumMap k b ->
+  f (EnumMap k c)
+interverse f (EM l) (EM r) =
+  fmap EM . traverse id $ IM.intersectionWith f l r
+
+traverseWithKey ::
+  Applicative f =>
+  EnumKey k =>
+  (k -> a -> f b) ->
+  EnumMap k a ->
+  f (EnumMap k b)
+traverseWithKey f (EM m) = EM <$> IM.traverseWithKey (f . intToKey) m
+
 setSize :: EnumSet k -> Int
 setSize (ES s) = IS.size s
--- a/parser-typechecker/unison-parser-typechecker.cabal
+++ b/parser-typechecker/unison-parser-typechecker.cabal
@ -17,6 +17,10 @@ source-repository head
  type: git
  location: https://github.com/unisonweb/unison

+flag arraychecks
+  manual: True
+  default: False
+
 flag optimized
  manual: True
  default: True
@ -103,6 +107,7 @@ library
      Unison.Result
      Unison.Runtime.ANF
      Unison.Runtime.ANF.Serialize
+      Unison.Runtime.Array
      Unison.Runtime.Builtin
      Unison.Runtime.Debug
      Unison.Runtime.Decompile
@ -302,6 +307,8 @@ library
    , zlib
  if flag(optimized)
    ghc-options: -funbox-strict-fields -O2
+  if flag(arraychecks)
+    cpp-options: -DARRAY_CHECK
  default-language: Haskell2010

 test-suite parser-typechecker-tests
@ -490,4 +497,6 @@ test-suite parser-typechecker-tests
    , zlib
  if flag(optimized)
    ghc-options: -funbox-strict-fields -O2
+  if flag(arraychecks)
+    cpp-options: -DARRAY_CHECK
  default-language: Haskell2010
--- a/unison-cli/src/Unison/Cli/Monad.hs
+++ b/unison-cli/src/Unison/Cli/Monad.hs
@ -1,5 +1,4 @@
 {-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DefaultSignatures #-}

 -- | The main CLI monad.
 module Unison.Cli.Monad
@ -38,6 +37,7 @@ module Unison.Cli.Monad

    -- * Running transactions
    runTransaction,
+    runEitherTransaction,

    -- * Misc types
    LoadSourceResult (..),
@ -381,3 +381,8 @@ runTransaction :: Sqlite.Transaction a -> Cli a
 runTransaction action = do
  Env {codebase} <- ask
  liftIO (Codebase.runTransaction codebase action)
+
+-- | Return early if a transaction returns Left.
+runEitherTransaction :: Sqlite.Transaction (Either Output a) -> Cli a
+runEitherTransaction action =
+  runTransaction action & onLeftM returnEarly
--- a/unison-cli/src/Unison/Cli/MonadUtils.hs
+++ b/unison-cli/src/Unison/Cli/MonadUtils.hs
@ -13,7 +13,9 @@ module Unison.Cli.MonadUtils

    -- ** Resolving branch identifiers
    resolveAbsBranchId,
+    resolveAbsBranchIdV2,
    resolveBranchId,
+    resolveBranchIdToAbsBranchId,
    resolveShortCausalHash,

    -- ** Getting/setting branches
@ -78,6 +80,7 @@ import Control.Monad.State
 import qualified Data.Configurator as Configurator
 import qualified Data.Configurator.Types as Configurator
 import qualified Data.Set as Set
+import qualified U.Codebase.Branch as V2 (Branch)
 import qualified U.Codebase.Branch as V2Branch
 import qualified U.Codebase.Causal as V2Causal
 import U.Codebase.HashTags (CausalHash (..))
@ -101,6 +104,7 @@ import Unison.Parser.Ann (Ann (..))
 import Unison.Prelude
 import Unison.Reference (TypeReference)
 import Unison.Referent (Referent)
+import qualified Unison.Sqlite as Sqlite
 import Unison.Symbol (Symbol)
 import Unison.UnisonFile (TypecheckedUnisonFile)
 import qualified Unison.Util.Set as Set
@ -144,32 +148,54 @@ resolveAbsBranchId = \case
  Left hash -> resolveShortCausalHash hash
  Right path -> getBranchAt path

+-- | V2 version of 'resolveAbsBranchId2'.
+resolveAbsBranchIdV2 :: Input.AbsBranchId -> Sqlite.Transaction (Either Output.Output (V2.Branch Sqlite.Transaction))
+resolveAbsBranchIdV2 = \case
+  Left shortHash -> do
+    resolveShortCausalHashToCausalHash shortHash >>= \case
+      Left output -> pure (Left output)
+      Right hash -> succeed (Codebase.expectCausalBranchByCausalHash hash)
+  Right path -> succeed (Codebase.getShallowCausalFromRoot Nothing (Path.unabsolute path))
+  where
+    succeed getCausal = do
+      causal <- getCausal
+      branch <- V2Causal.value causal
+      pure (Right branch)
+
 -- | Resolve a @BranchId@ to the corresponding @Branch IO@, or fail if no such branch hash is found. (Non-existent
 -- branches by path are OK - the empty branch will be returned).
 resolveBranchId :: Input.BranchId -> Cli (Branch IO)
 resolveBranchId branchId = do
-  absBranchId <- traverseOf _Right resolvePath' branchId
+  absBranchId <- resolveBranchIdToAbsBranchId branchId
  resolveAbsBranchId absBranchId

+-- | Resolve a @BranchId@ to an @AbsBranchId@.
+resolveBranchIdToAbsBranchId :: Input.BranchId -> Cli Input.AbsBranchId
+resolveBranchIdToAbsBranchId =
+  traverseOf _Right resolvePath'
+
 -- | Resolve a @ShortCausalHash@ to the corresponding @Branch IO@, or fail if no such branch hash is found.
 resolveShortCausalHash :: ShortCausalHash -> Cli (Branch IO)
-resolveShortCausalHash hash = do
+resolveShortCausalHash shortHash = do
  Cli.time "resolveShortCausalHash" do
    Cli.Env {codebase} <- ask
-    (hashSet, len) <-
-      Cli.runTransaction do
-        hashSet <- Codebase.causalHashesByPrefix hash
-        len <- Codebase.branchHashLength
-        pure (hashSet, len)
-    h <-
-      Set.asSingleton hashSet & onNothing do
-        Cli.returnEarly
-          if Set.null hashSet
-            then Output.NoBranchWithHash hash
-            else Output.BranchHashAmbiguous hash (Set.map (SCH.fromHash len) hashSet)
-    branch <- liftIO (Codebase.getBranchForHash codebase h)
+    hash <- Cli.runEitherTransaction (resolveShortCausalHashToCausalHash shortHash)
+    branch <- liftIO (Codebase.getBranchForHash codebase hash)
    pure (fromMaybe Branch.empty branch)

+resolveShortCausalHashToCausalHash :: ShortCausalHash -> Sqlite.Transaction (Either Output.Output CausalHash)
+resolveShortCausalHashToCausalHash shortHash = do
+  hashes <- Codebase.causalHashesByPrefix shortHash
+  case Set.asSingleton hashes of
+    Nothing ->
+      fmap Left do
+        if Set.null hashes
+          then pure (Output.NoBranchWithHash shortHash)
+          else do
+            len <- Codebase.branchHashLength
+            pure (Output.BranchHashAmbiguous shortHash (Set.map (SCH.fromHash len) hashes))
+    Just hash -> pure (Right hash)
+
 ------------------------------------------------------------------------------------------------------------------------
 -- Getting/Setting branches

--- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs
+++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs
@ -12,6 +12,7 @@ import Control.Lens
 import Control.Monad.Reader (ask)
 import Control.Monad.State (StateT)
 import qualified Control.Monad.State as State
+import Control.Monad.Trans.Except (ExceptT (..), runExceptT)
 import Control.Monad.Writer (WriterT (..))
 import Data.Bifunctor (first, second)
 import qualified Data.Foldable as Foldable
@ -41,6 +42,7 @@ import qualified Text.Megaparsec as P
 import qualified U.Codebase.Branch.Diff as V2Branch
 import qualified U.Codebase.Causal as V2Causal
 import U.Codebase.HashTags (CausalHash (..))
+import qualified U.Codebase.Reference as V2 (Reference)
 import qualified U.Codebase.Reflog as Reflog
 import qualified U.Codebase.Sqlite.Operations as Ops
 import qualified U.Codebase.Sqlite.Queries as Queries
@ -61,7 +63,6 @@ import Unison.Codebase.Branch (Branch (..), Branch0 (..))
 import qualified Unison.Codebase.Branch as Branch
 import qualified Unison.Codebase.Branch.Merge as Branch
 import qualified Unison.Codebase.Branch.Names as Branch
-import qualified Unison.Codebase.BranchDiff as BranchDiff (diff0)
 import qualified Unison.Codebase.BranchUtil as BranchUtil
 import qualified Unison.Codebase.Causal as Causal
 import Unison.Codebase.Editor.AuthorInfo (AuthorInfo (..))
@ -115,6 +116,7 @@ import Unison.Codebase.PushBehavior (PushBehavior)
 import qualified Unison.Codebase.PushBehavior as PushBehavior
 import qualified Unison.Codebase.Runtime as Runtime
 import qualified Unison.Codebase.ShortCausalHash as SCH
+import qualified Unison.Codebase.SqliteCodebase.Conversions as Conversions
 import qualified Unison.Codebase.SyncMode as SyncMode
 import Unison.Codebase.TermEdit (TermEdit (..))
 import qualified Unison.Codebase.TermEdit as TermEdit
@ -162,8 +164,6 @@ import qualified Unison.Reference as Reference
 import Unison.Referent (Referent)
 import qualified Unison.Referent as Referent
 import qualified Unison.Result as Result
-import Unison.Runtime.IOSource (isTest)
-import qualified Unison.Runtime.IOSource as DD
 import qualified Unison.Runtime.IOSource as IOSource
 import Unison.Server.Backend (ShallowListEntry (..))
 import qualified Unison.Server.Backend as Backend
@ -269,7 +269,7 @@ loop e = do
            go (ann, kind, _hash, _uneval, eval, isHit) = (ann, kind, eval, isHit)
        when (not (null e')) do
          Cli.respond $ Evaluated text ppe bindings e'
-        #latestTypecheckedFile .= (Just unisonFile)
+        #latestTypecheckedFile .= Just unisonFile

  case e of
    Left (IncomingRootBranch hashes) -> Cli.time "IncomingRootBranch" do
@ -1186,41 +1186,7 @@ loop e = do
            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
-              let testType = Runtime.ioTestType runtime
-              parseNames <- (`NamesWithHistory.NamesWithHistory` mempty) <$> basicParseNames
-              ppe <- suffixifiedPPE parseNames
-              -- use suffixed names for resolving the argument to display
-              let oks results =
-                    [ (r, msg)
-                      | (r, Term.List' ts) <- results,
-                        Term.App' (Term.Constructor' (ConstructorReference ref cid)) (Term.Text' msg) <- toList ts,
-                        cid == DD.okConstructorId && ref == DD.testResultRef
-                    ]
-                  fails results =
-                    [ (r, msg)
-                      | (r, Term.List' ts) <- results,
-                        Term.App' (Term.Constructor' (ConstructorReference ref cid)) (Term.Text' msg) <- toList ts,
-                        cid == DD.failConstructorId && ref == DD.testResultRef
-                    ]
-
-                  results = NamesWithHistory.lookupHQTerm main parseNames
-              ref <- do
-                let noMain = Cli.returnEarly $ NoMainFunction (HQ.toString main) ppe [testType]
-                case toList results of
-                  [Referent.Ref ref] -> do
-                    Cli.runTransaction (loadTypeOfTerm codebase (Referent.Ref ref)) >>= \case
-                      Just typ | Typechecker.isSubtype typ testType -> pure ref
-                      _ -> noMain
-                  _ -> noMain
-              let a = ABT.annotation tm
-                  tm = DD.forceTerm a a (Term.ref a ref)
-              -- Don't cache IO tests
-              tm' <- evalUnisonTerm False ppe False tm
-              Cli.respond $ TestResults Output.NewlyComputed ppe True True (oks [(ref, tm')]) (fails [(ref, tm')])
-
+            IOTestI main -> handleIOTest main
            -- UpdateBuiltinsI -> do
            --   stepAt updateBuiltins
            --   checkTodo
@ -1410,8 +1376,8 @@ loop e = do
                ([fromCH], [toCH]) -> pure (fromCH, toCH)
              output <-
                Cli.runTransaction do
-                  fromBranch <- (Codebase.expectCausalBranchByCausalHash fromCH) >>= V2Causal.value
-                  toBranch <- (Codebase.expectCausalBranchByCausalHash toCH) >>= V2Causal.value
+                  fromBranch <- Codebase.expectCausalBranchByCausalHash fromCH >>= V2Causal.value
+                  toBranch <- Codebase.expectCausalBranchByCausalHash toCH >>= V2Causal.value
                  treeDiff <- V2Branch.diffBranches fromBranch toBranch
                  let nameChanges = V2Branch.nameChanges Nothing treeDiff
                  pure (DisplayDebugNameDiff nameChanges)
@ -1804,58 +1770,34 @@ handleDiffNamespaceToPatch :: Text -> DiffNamespaceToPatchInput -> Cli ()
 handleDiffNamespaceToPatch description input = do
  Cli.Env {codebase} <- ask

-  branch1 <- Branch.head <$> Cli.resolveBranchId (input ^. #branchId1)
-  branch2 <- Branch.head <$> Cli.resolveBranchId (input ^. #branchId2)
-  branchDiff <- liftIO (BranchDiff.diff0 branch1 branch2)
+  absBranchId1 <- Cli.resolveBranchIdToAbsBranchId (input ^. #branchId1)
+  absBranchId2 <- Cli.resolveBranchIdToAbsBranchId (input ^. #branchId2)

-  -- Given {old referents} and {new referents}, create term edit patch entries as follows:
-  --
-  --   * If the {new referents} is a singleton set {new referent}, proceed. (Otherwise, the patch we might create would
-  --     not be a function, which is a bogus/conflicted patch).
-  --   * If the new referent is a term reference, not a data constructor, proceed. (Patches currently can't track
-  --     updates to data constructors).
-  --   * For each old term reference (again, throwing constructors away) in {old referents}, create a patch entry that
-  --     maps the old reference to the new. The patch entry includes the typing relationship between the terms, so we
-  --     look the references' types up in the codebase, too.
-  let termNamespaceUpdateToTermEdits :: (Set Referent, Set Referent) -> Sqlite.Transaction (Set (Reference, TermEdit))
-      termNamespaceUpdateToTermEdits (refs0, refs1) =
-        case Set.asSingleton refs1 of
-          Just (Referent.Ref ref1) ->
-            Codebase.getTypeOfTerm codebase ref1 >>= \case
-              Nothing -> pure Set.empty
-              Just ty1 ->
-                Monoid.foldMapM
-                  ( \ref0 ->
-                      Codebase.getTypeOfTerm codebase ref0 <&> \case
-                        Nothing -> Set.empty
-                        Just ty0 -> Set.singleton (ref0, TermEdit.Replace ref1 (TermEdit.typing ty0 ty1))
-                  )
-                  (mapMaybe Referent.toTermReference (Set.toList refs0))
-          _ -> pure Set.empty
-
-  -- The same idea as above, but for types: if there's one new reference in {new references}, then map each of the old
-  -- references to it.
-  let typeNamespaceUpdateToTypeEdits :: (Set Reference, Set Reference) -> Set (Reference, TypeEdit)
-      typeNamespaceUpdateToTypeEdits (refs0, refs1) =
-        case Set.asSingleton refs1 of
-          Just ref1 -> Set.map (\ref0 -> (ref0, TypeEdit.Replace ref1)) refs0
-          _ -> Set.empty
-
-  termUpdates <-
-    Cli.runTransaction do
-      (branchDiff ^. #termsDiff . #tallnamespaceUpdates)
-        & Map.elems
-        & Monoid.foldMapM termNamespaceUpdateToTermEdits
-  let typeUpdates =
-        (branchDiff ^. #typesDiff . #tallnamespaceUpdates)
-          & Map.elems
-          & foldMap typeNamespaceUpdateToTypeEdits
-
-  let patch =
-        Patch
-          { _termEdits = Relation.fromSet termUpdates,
-            _typeEdits = Relation.fromSet typeUpdates
-          }
+  patch <- do
+    Cli.runEitherTransaction do
+      runExceptT do
+        branch1 <- ExceptT (Cli.resolveAbsBranchIdV2 absBranchId1)
+        branch2 <- ExceptT (Cli.resolveAbsBranchIdV2 absBranchId2)
+        lift do
+          branchDiff <- V2Branch.nameBasedDiff <$> V2Branch.diffBranches branch1 branch2
+          termEdits <-
+            (branchDiff ^. #terms)
+              & Relation.domain
+              & Map.toList
+              & traverse \(oldRef, newRefs) -> makeTermEdit codebase oldRef newRefs
+          pure
+            Patch
+              { _termEdits =
+                  termEdits
+                    & catMaybes
+                    & Relation.fromList,
+                _typeEdits =
+                  (branchDiff ^. #types)
+                    & Relation.domain
+                    & Map.toList
+                    & mapMaybe (\(oldRef, newRefs) -> makeTypeEdit oldRef newRefs)
+                    & Relation.fromList
+              }

  -- Display the patch that we are about to create.
  ppe <- suffixifiedPPE =<< makePrintNamesFromLabeled' (Patch.labeledDependencies patch)
@ -1868,6 +1810,88 @@ handleDiffNamespaceToPatch description input = do
  Cli.stepAtM
    description
    (Path.unabsolute patchPath, Branch.modifyPatches patchName (const patch))
+  where
+    -- Given {old reference} and {new references}, create term edit patch entries as follows:
+    --
+    --   * If the {new references} is a singleton set {new reference}, proceed. (Otherwise, the patch we might create
+    --     would not be a function, which is a bogus/conflicted patch).
+    --   * Look up {old reference} and {new reference} types in the codebase (which can technically fail, due to
+    --     non-transactionality of this command, though we don't typically delete anything from SQLite), and create a
+    --     patch entry that maps {old reference} to {new reference} with the typing relationship.
+    makeTermEdit ::
+      Codebase m Symbol Ann ->
+      V2.Reference ->
+      Set V2.Reference ->
+      Sqlite.Transaction (Maybe (Reference, TermEdit))
+    makeTermEdit codebase (Conversions.reference2to1 -> oldRef) newRefs =
+      runMaybeT do
+        newRef <- Conversions.reference2to1 <$> MaybeT (pure (Set.asSingleton newRefs))
+        oldRefType <- MaybeT (Codebase.getTypeOfTerm codebase oldRef)
+        newRefType <- MaybeT (Codebase.getTypeOfTerm codebase newRef)
+        pure (oldRef, TermEdit.Replace newRef (TermEdit.typing oldRefType newRefType))
+
+    -- Same idea as 'makeTermEdit', but simpler, because there's nothing to look up in the database.
+    makeTypeEdit :: V2.Reference -> Set V2.Reference -> Maybe (Reference, TypeEdit)
+    makeTypeEdit (Conversions.reference2to1 -> oldRef) newRefs =
+      Set.asSingleton newRefs <&> \newRef -> (oldRef, TypeEdit.Replace (Conversions.reference2to1 newRef))
+
+handleIOTest :: HQ.HashQualified Name -> Cli ()
+handleIOTest main = do
+  Cli.Env {codebase, runtime} <- ask
+
+  let testType = Runtime.ioTestType runtime
+  parseNames <- (`NamesWithHistory.NamesWithHistory` mempty) <$> basicParseNames
+  -- use suffixed names for resolving the argument to display
+  ppe <- suffixifiedPPE parseNames
+  let oks results =
+        [ (r, msg)
+          | (r, Term.List' ts) <- results,
+            Term.App' (Term.Constructor' (ConstructorReference ref cid)) (Term.Text' msg) <- toList ts,
+            cid == DD.okConstructorId && ref == DD.testResultRef
+        ]
+      fails results =
+        [ (r, msg)
+          | (r, Term.List' ts) <- results,
+            Term.App' (Term.Constructor' (ConstructorReference ref cid)) (Term.Text' msg) <- toList ts,
+            cid == DD.failConstructorId && ref == DD.testResultRef
+        ]
+
+  matches <-
+    Cli.label \returnMatches -> do
+      -- First, look at the terms in the latest typechecked file for a name-match.
+      whenJustM Cli.getLatestTypecheckedFile \typecheckedFile -> do
+        whenJust (HQ.toName main) \mainName ->
+          whenJust (Map.lookup (Name.toVar mainName) (UF.hashTermsId typecheckedFile)) \(ref, _wk, _term, typ) ->
+            returnMatches [(Reference.fromId ref, typ)]
+
+      -- Then, if we get here (because nothing in the scratch file matched), look at the terms in the codebase.
+      Cli.runTransaction do
+        forMaybe (Set.toList (NamesWithHistory.lookupHQTerm main parseNames)) \ref0 ->
+          runMaybeT do
+            ref <- MaybeT (pure (Referent.toTermReference ref0))
+            typ <- MaybeT (loadTypeOfTerm codebase (Referent.Ref ref))
+            pure (ref, typ)
+
+  ref <-
+    case matches of
+      [] -> Cli.returnEarly (NoMainFunction (HQ.toString main) ppe [testType])
+      [(ref, typ)] ->
+        if Typechecker.isSubtype typ testType
+          then pure ref
+          else Cli.returnEarly (BadMainFunction "io.test" (HQ.toString main) typ ppe [testType])
+      _ -> do
+        hashLength <- Cli.runTransaction Codebase.hashLength
+        let labeledDependencies =
+              matches
+                & map (\(ref, _typ) -> LD.termRef ref)
+                & Set.fromList
+        Cli.returnEarly (LabeledReferenceAmbiguous hashLength main labeledDependencies)
+
+  let a = ABT.annotation tm
+      tm = DD.forceTerm a a (Term.ref a ref)
+  -- Don't cache IO tests
+  tm' <- evalUnisonTerm False ppe False tm
+  Cli.respond $ TestResults Output.NewlyComputed ppe True True (oks [(ref, tm')]) (fails [(ref, tm')])

 -- | Handle a @push@ command.
 handlePushRemoteBranch :: PushRemoteBranchInput -> Cli ()
@ -1962,50 +1986,46 @@ handlePushToUnisonShare remote@WriteShareRemotePath {server, repo, path = remote
  let sharePath = Share.Path (repo Nel.:| pathToSegments remotePath)
  ensureAuthenticatedWithCodeserver codeserver

-  Cli.Env {authHTTPClient, codebase} <- ask
-
  -- doesn't handle the case where a non-existent path is supplied
  localCausalHash <-
    Cli.runTransaction (Ops.loadCausalHashAtPath (pathToSegments (Path.unabsolute localPath))) & onNothingM do
      Cli.returnEarly (EmptyPush . Path.absoluteToPath' $ localPath)

-  let checkAndSetPush :: Maybe Hash32 -> IO (Either (Share.SyncError Share.CheckAndSetPushError) ())
+  let checkAndSetPush :: Maybe Hash32 -> Cli ()
      checkAndSetPush remoteHash =
-        withEntitiesUploadedProgressCallback \uploadedCallback ->
-          if Just (Hash32.fromHash (unCausalHash localCausalHash)) == remoteHash
-            then pure (Right ())
-            else
-              Share.checkAndSetPush
-                authHTTPClient
-                baseURL
-                (Codebase.withConnectionIO codebase)
-                sharePath
-                remoteHash
-                localCausalHash
-                uploadedCallback
+        when (Just (Hash32.fromHash (unCausalHash localCausalHash)) /= remoteHash) do
+          let push =
+                Cli.with withEntitiesUploadedProgressCallback \uploadedCallback -> do
+                  Share.checkAndSetPush
+                    baseURL
+                    sharePath
+                    remoteHash
+                    localCausalHash
+                    uploadedCallback
+          push & onLeftM (pushError ShareErrorCheckAndSetPush)

  case behavior of
    PushBehavior.ForcePush -> do
      maybeHashJwt <-
-        Cli.ioE (Share.getCausalHashByPath authHTTPClient baseURL sharePath) \err ->
-          Cli.returnEarly (Output.ShareError (ShareErrorGetCausalHashByPath err))
-      Cli.ioE (checkAndSetPush (Share.hashJWTHash <$> maybeHashJwt)) (pushError ShareErrorCheckAndSetPush)
+        Share.getCausalHashByPath baseURL sharePath & onLeftM \err0 ->
+          (Cli.returnEarly . Output.ShareError) case err0 of
+            Share.SyncError err -> ShareErrorGetCausalHashByPath err
+            Share.TransportError err -> ShareErrorTransport err
+      checkAndSetPush (Share.hashJWTHash <$> maybeHashJwt)
      Cli.respond (ViewOnShare remote)
    PushBehavior.RequireEmpty -> do
-      Cli.ioE (checkAndSetPush Nothing) (pushError ShareErrorCheckAndSetPush)
+      checkAndSetPush Nothing
      Cli.respond (ViewOnShare remote)
    PushBehavior.RequireNonEmpty -> do
-      let push :: IO (Either (Share.SyncError Share.FastForwardPushError) ())
-          push = do
-            withEntitiesUploadedProgressCallback \uploadedCallback ->
+      let push :: Cli (Either (Share.SyncError Share.FastForwardPushError) ())
+          push =
+            Cli.with withEntitiesUploadedProgressCallback \uploadedCallback ->
              Share.fastForwardPush
-                authHTTPClient
                baseURL
-                (Codebase.withConnectionIO codebase)
                sharePath
                localCausalHash
                uploadedCallback
-      Cli.ioE push (pushError ShareErrorFastForwardPush)
+      push & onLeftM (pushError ShareErrorFastForwardPush)
      Cli.respond (ViewOnShare remote)
  where
    pathToSegments :: Path -> [Text]
@ -2076,8 +2096,24 @@ handleShowDefinition outputLoc showDefinitionScope inputQuery = do
    Cli.runTransaction (Backend.definitionsBySuffixes codebase nameSearch includeCycles query)
  outputPath <- getOutputPath
  when (not (null types && null terms)) do
-    let ppe = PPED.biasTo (mapMaybe HQ.toName inputQuery) unbiasedPPE
-    Cli.respond (DisplayDefinitions outputPath ppe types terms)
+    -- We need an 'isTest' check in the output layer, so it can prepend "test>" to tests in a scratch file. Since we
+    -- currently have the whole branch in memory, we just use that to make our predicate, but this could/should get this
+    -- information from the database instead, once it's efficient to do so.
+    isTest <- do
+      branch <- Cli.getCurrentBranch0
+      pure \ref ->
+        branch
+          & Branch.deepTermMetadata
+          & Metadata.hasMetadataWithType' (Referent.fromTermReference ref) IOSource.isTestReference
+    Cli.respond $
+      DisplayDefinitions
+        DisplayDefinitionsOutput
+          { isTest,
+            outputFile = outputPath,
+            prettyPrintEnv = PPED.biasTo (mapMaybe HQ.toName inputQuery) unbiasedPPE,
+            terms,
+            types
+          }
  when (not (null misses)) (Cli.respond (SearchTermsNotFound misses))
  for_ outputPath \p -> do
    -- We set latestFile to be programmatically generated, if we
@ -2113,7 +2149,7 @@ handleTest TestInput {includeLibNamespace, showFailures, showSuccesses} = do
    branch <- Cli.getCurrentBranch0
    branch
      & Branch.deepTermMetadata
-      & R4.restrict34d12 isTest
+      & R4.restrict34d12 IOSource.isTest
      & (if includeLibNamespace then id else R.filterRan (not . isInLibNamespace))
      & R.dom
      & pure
@ -2251,21 +2287,13 @@ importRemoteShareBranch rrn@(ReadShareRemoteNamespace {server, repo, path}) = do
  -- Auto-login to share if pulling from a non-public path
  when (not $ RemoteRepo.isPublic rrn) $ ensureAuthenticatedWithCodeserver codeserver
  let shareFlavoredPath = Share.Path (repo Nel.:| coerce @[NameSegment] @[Text] (Path.toList path))
-  Cli.Env {authHTTPClient, codebase} <- ask
-  let pull :: IO (Either (Share.SyncError Share.PullError) CausalHash)
-      pull =
-        withEntitiesDownloadedProgressCallback \downloadedCallback ->
-          Share.pull
-            authHTTPClient
-            baseURL
-            (Codebase.withConnectionIO codebase)
-            shareFlavoredPath
-            downloadedCallback
+  Cli.Env {codebase} <- ask
  causalHash <-
-    Cli.ioE pull \err0 ->
-      (Cli.returnEarly . Output.ShareError) case err0 of
-        Share.SyncError err -> Output.ShareErrorPull err
-        Share.TransportError err -> Output.ShareErrorTransport err
+    Cli.with withEntitiesDownloadedProgressCallback \downloadedCallback ->
+      Share.pull baseURL shareFlavoredPath downloadedCallback & onLeftM \err0 ->
+        (Cli.returnEarly . Output.ShareError) case err0 of
+          Share.SyncError err -> Output.ShareErrorPull err
+          Share.TransportError err -> Output.ShareErrorTransport err
  liftIO (Codebase.getBranchForHash codebase causalHash) & onNothingM do
    error $ reportBug "E412939" "`pull` \"succeeded\", but I can't find the result in the codebase. (This is a bug.)"
  where
@ -2687,7 +2715,7 @@ typecheckAndEval ppe tm = do
      | Typechecker.fitsScheme ty mty ->
          () <$ evalUnisonTerm False ppe False tm
      | otherwise ->
-          Cli.returnEarly $ BadMainFunction rendered ty ppe [mty]
+          Cli.returnEarly $ BadMainFunction "run" rendered ty ppe [mty]
    Result.Result notes Nothing -> do
      currentPath <- Cli.getCurrentPath
      let tes = [err | Result.TypeError err <- toList notes]
@ -2960,7 +2988,7 @@ docsI srcLoc prettyPrintNames src =

    codebaseByMetadata :: Cli ()
    codebaseByMetadata = do
-      (ppe, out) <- getLinks srcLoc src (Left $ Set.fromList [DD.docRef, DD.doc2Ref])
+      (ppe, out) <- getLinks srcLoc src (Left $ Set.fromList [DD.docRef, IOSource.doc2Ref])
      case out of
        [] -> codebaseByName
        [(_name, ref, _tm)] -> do
@ -3122,7 +3150,7 @@ getTerm main =
      mainType <- Runtime.mainType <$> view #runtime
      basicPrettyPrintNames <- getBasicPrettyPrintNames
      ppe <- suffixifiedPPE (NamesWithHistory.NamesWithHistory basicPrettyPrintNames mempty)
-      Cli.returnEarly $ BadMainFunction main ty ppe [mainType]
+      Cli.returnEarly $ BadMainFunction "run" main ty ppe [mainType]
    GetTermSuccess x -> pure x

 getTerm' :: String -> Cli GetTermResult
--- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/TermResolution.hs
+++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/TermResolution.hs
@ -120,5 +120,5 @@ resolveMainRef main = do
  lookupTermRefWithType codebase main >>= \case
    [(rf, ty)]
      | Typechecker.fitsScheme ty mainType -> pure (rf, ppe)
-      | otherwise -> Cli.returnEarly (BadMainFunction smain ty ppe [mainType])
+      | otherwise -> Cli.returnEarly (BadMainFunction "main" smain ty ppe [mainType])
    _ -> Cli.returnEarly (NoMainFunction smain ppe [mainType])
--- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update.hs
+++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update.hs
@ -53,7 +53,7 @@ import qualified Unison.Reference as Reference
 import Unison.Referent (Referent)
 import qualified Unison.Referent as Referent
 import qualified Unison.Result as Result
-import Unison.Runtime.IOSource (isTest)
+import qualified Unison.Runtime.IOSource as IOSource
 import qualified Unison.Sqlite as Sqlite
 import Unison.Symbol (Symbol)
 import qualified Unison.Syntax.Name as Name (toVar, unsafeFromVar)
@ -589,7 +589,7 @@ doSlurpAdds slurp uf = Branch.batchUpdates (typeActions <> termActions)
        SC.terms slurp <> UF.constructorsForDecls (SC.types slurp) uf
    names = UF.typecheckedToNames uf
    tests = Set.fromList $ fst <$> UF.watchesOfKind WK.TestWatch (UF.discardTypes uf)
-    (isTestType, isTestValue) = isTest
+    (isTestType, isTestValue) = IOSource.isTest
    md v =
      if Set.member v tests
        then Metadata.singleton isTestType isTestValue
--- a/unison-cli/src/Unison/Codebase/Editor/Output.hs
+++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs
@ -1,7 +1,6 @@
-{-# LANGUAGE PatternSynonyms #-}
-
 module Unison.Codebase.Editor.Output
  ( Output (..),
+    DisplayDefinitionsOutput (..),
    NumberedOutput (..),
    NumberedArgs,
    ListDetailed,
@ -54,7 +53,7 @@ import Unison.Parser.Ann (Ann)
 import Unison.Prelude
 import qualified Unison.PrettyPrintEnv as PPE
 import qualified Unison.PrettyPrintEnvDecl as PPE
-import Unison.Reference (Reference)
+import Unison.Reference (Reference, TermReference)
 import qualified Unison.Reference as Reference
 import Unison.Referent (Referent)
 import Unison.Server.Backend (ShallowListEntry (..))
@ -121,8 +120,18 @@ data Output
  | SourceLoadFailed String
  | -- No main function, the [Type v Ann] are the allowed types
    NoMainFunction String PPE.PrettyPrintEnv [Type Symbol Ann]
-  | -- Main function found, but has improper type
-    BadMainFunction String (Type Symbol Ann) PPE.PrettyPrintEnv [Type Symbol Ann]
+  | -- | Function found, but has improper type
+    -- Note: the constructor name is misleading here; we weren't necessarily looking for a "main".
+    BadMainFunction
+      String
+      -- ^ what we were trying to do (e.g. "run", "io.test")
+      String
+      -- ^ name of function
+      (Type Symbol Ann)
+      -- ^ bad type of function
+      PPE.PrettyPrintEnv
+      [Type Symbol Ann]
+      -- ^ acceptable type(s) of function
  | BranchEmpty (Either ShortCausalHash Path')
  | BranchNotEmpty Path'
  | LoadPullRequest ReadRemoteNamespace ReadRemoteNamespace Path' Path' Path' Path'
@ -203,11 +212,7 @@ data Output
  | Typechecked SourceName PPE.PrettyPrintEnv SlurpResult (UF.TypecheckedUnisonFile Symbol Ann)
  | DisplayRendered (Maybe FilePath) (P.Pretty P.ColorText)
  | -- "display" definitions, possibly to a FilePath on disk (e.g. editing)
-    DisplayDefinitions
-      (Maybe FilePath)
-      PPE.PrettyPrintEnvDecl
-      (Map Reference (DisplayObject () (Decl Symbol Ann)))
-      (Map Reference (DisplayObject (Type Symbol Ann) (Term Symbol Ann)))
+    DisplayDefinitions DisplayDefinitionsOutput
  | TestIncrementalOutputStart PPE.PrettyPrintEnv (Int, Int) Reference (Term Symbol Ann)
  | TestIncrementalOutputEnd PPE.PrettyPrintEnv (Int, Int) Reference (Term Symbol Ann)
  | TestResults
@ -278,6 +283,14 @@ data Output
  | DisplayDebugNameDiff NameChanges
  | DisplayDebugCompletions [Completion.Completion]

+data DisplayDefinitionsOutput = DisplayDefinitionsOutput
+  { isTest :: TermReference -> Bool,
+    outputFile :: Maybe FilePath,
+    prettyPrintEnv :: PPE.PrettyPrintEnvDecl,
+    terms :: Map Reference (DisplayObject (Type Symbol Ann) (Term Symbol Ann)),
+    types :: Map Reference (DisplayObject () (Decl Symbol Ann))
+  }
+
 data ShareError
  = ShareErrorCheckAndSetPush Sync.CheckAndSetPushError
  | ShareErrorFastForwardPush Sync.FastForwardPushError
@ -369,7 +382,7 @@ isFailure o = case o of
  EvaluationFailure {} -> True
  Evaluated {} -> False
  Typechecked {} -> False
-  DisplayDefinitions _ _ m1 m2 -> null m1 && null m2
+  DisplayDefinitions DisplayDefinitionsOutput {terms, types} -> null terms && null types
  DisplayRendered {} -> False
  TestIncrementalOutputStart {} -> False
  TestIncrementalOutputEnd {} -> False
--- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs
+++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs
@ -1537,19 +1537,20 @@ viewReflog =
 edit :: InputPattern
 edit =
  InputPattern
-    "edit"
-    []
-    I.Visible
-    [(OnePlus, definitionQueryArg)]
-    ( P.lines
-        [ "`edit foo` prepends the definition of `foo` to the top of the most "
-            <> "recently saved file.",
-          "`edit` without arguments invokes a search to select a definition for editing, which requires that `fzf` can be found within your PATH."
-        ]
-    )
-    ( fmap (Input.ShowDefinitionI Input.LatestFileLocation Input.ShowDefinitionLocal)
-        . traverse parseHashQualifiedName
-    )
+    { patternName = "edit",
+      aliases = [],
+      visibility = I.Visible,
+      argTypes = [(OnePlus, definitionQueryArg)],
+      help =
+        P.lines
+          [ "`edit foo` prepends the definition of `foo` to the top of the most "
+              <> "recently saved file.",
+            "`edit` without arguments invokes a search to select a definition for editing, which requires that `fzf` can be found within your PATH."
+          ],
+      parse =
+        fmap (Input.ShowDefinitionI Input.LatestFileLocation Input.ShowDefinitionLocal)
+          . traverse parseHashQualifiedName
+    }

 topicNameArg :: ArgumentType
 topicNameArg =
@ -2084,20 +2085,20 @@ saveExecuteResult =
 ioTest :: InputPattern
 ioTest =
  InputPattern
-    "io.test"
-    ["test.io"]
-    I.Visible
-    [(Required, exactDefinitionTermQueryArg)]
-    ( P.wrapColumn2
-        [ ( "`io.test mytest`",
-            "Runs `!mytest`, where `mytest` is a delayed test that can use the `IO` and `Exception` abilities. Note: `mytest` must already be added to the codebase."
-          )
-        ]
-    )
-    ( \case
+    { patternName = "io.test",
+      aliases = ["test.io"],
+      visibility = I.Visible,
+      argTypes = [(Required, exactDefinitionTermQueryArg)],
+      help =
+        P.wrapColumn2
+          [ ( "`io.test mytest`",
+              "Runs `!mytest`, where `mytest` is a delayed test that can use the `IO` and `Exception` abilities."
+            )
+          ],
+      parse = \case
        [thing] -> fmap Input.IOTestI $ parseHashQualifiedName thing
        _ -> Left $ showPatternHelp ioTest
-    )
+    }

 makeStandalone :: InputPattern
 makeStandalone =
--- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs
+++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs
@ -111,7 +111,7 @@ import Unison.PrintError
    printNoteWithSource,
    renderCompilerBug,
  )
-import Unison.Reference (Reference)
+import Unison.Reference (Reference, TermReference)
 import qualified Unison.Reference as Reference
 import Unison.Referent (Referent)
 import qualified Unison.Referent as Referent
@ -124,12 +124,14 @@ import qualified Unison.Share.Sync as Share
 import Unison.Share.Sync.Types (CodeserverTransportError (..))
 import qualified Unison.ShortHash as SH
 import qualified Unison.ShortHash as ShortHash
+import Unison.Symbol (Symbol)
 import qualified Unison.Sync.Types as Share
 import qualified Unison.Syntax.DeclPrinter as DeclPrinter
 import qualified Unison.Syntax.HashQualified as HQ (toString, toText, unsafeFromVar)
 import qualified Unison.Syntax.Name as Name (toString, toText)
 import Unison.Syntax.NamePrinter
-  ( prettyHashQualified,
+  ( SyntaxText,
+    prettyHashQualified,
    prettyHashQualified',
    prettyLabeledDependency,
    prettyName,
@ -657,8 +659,7 @@ notifyUser dir o = case o of
                [prettyReadRemoteNamespace baseNS, prettyPath' squashedPath]
              <> "to push the changes."
        ]
-  DisplayDefinitions outputLoc ppe types terms ->
-    displayDefinitions outputLoc ppe types terms
+  DisplayDefinitions output -> displayDefinitions output
  DisplayRendered outputLoc pp ->
    displayRendered outputLoc pp
  TestResults stats ppe _showSuccess _showFailures oks fails -> case stats of
@ -798,14 +799,14 @@ notifyUser dir o = case o of
          "",
          P.indentN 2 $ P.lines [P.string main <> " : " <> TypePrinter.pretty ppe t | t <- ts]
        ]
-  BadMainFunction main ty ppe ts ->
+  BadMainFunction what main ty ppe ts ->
    pure . P.callout "😶" $
      P.lines
        [ P.string "I found this function:",
          "",
          P.indentN 2 $ P.string main <> " : " <> TypePrinter.pretty ppe ty,
          "",
-          P.wrap $ P.string "but in order for me to" <> P.backticked (P.string "run") <> "it needs be a subtype of:",
+          P.wrap $ P.string "but in order for me to" <> P.backticked (P.string what) <> "it needs be a subtype of:",
          "",
          P.indentN 2 $ P.lines [P.string main <> " : " <> TypePrinter.pretty ppe t | t <- ts]
        ]
@ -1320,19 +1321,25 @@ notifyUser dir o = case o of
        "",
        err
      ]
-  NoConfiguredRemoteMapping pp p ->
-    pure . P.fatalCallout . P.wrap $
-      "I don't know where to "
-        <> PushPull.fold "push to!" "pull from!" pp
-        <> ( if Path.isRoot p
-               then ""
-               else
-                 "Add a line like `RemoteMapping." <> P.shown p
-                   <> " = namespace.path' to .unisonConfig. "
-           )
-        <> "Type `help "
-        <> PushPull.fold "push" "pull" pp
-        <> "` for more information."
+  NoConfiguredRemoteMapping pp p -> do
+    let (localPathExample, sharePathExample) =
+          if Path.isRoot p
+            then ("myproject", "myuser.public.myproject")
+            else (Path.toText (Path.unabsolute p), "myuser.public." <> Path.toText (Path.unabsolute p))
+    pure . P.fatalCallout $
+      P.lines
+        [ "I don't know where to " <> PushPull.fold "push to." "pull from." pp,
+          "Add a `RemoteMapping` configuration to your .unisonConfig file. E.g.",
+          "",
+          "```",
+          "RemoteMapping {",
+          P.text ("  " <> localPathExample <> " = \"" <> sharePathExample <> "\""),
+          "}",
+          "```",
+          "",
+          "Type `help " <> PushPull.fold "push" "pull" pp <> "` for more information."
+        ]
+
  --  | ConfiguredGitUrlParseError PushPull Path' Text String
  ConfiguredRemoteMappingParseError pp p url err ->
    pure . P.fatalCallout . P.lines $
@ -1722,9 +1729,9 @@ notifyUser dir o = case o of
      (Share.FastForwardPushErrorNoWritePermission sharePath) -> noWritePermission sharePath
      (Share.FastForwardPushErrorServerMissingDependencies hashes) -> missingDependencies hashes
    ShareErrorPull e -> case e of
-      (Share.PullErrorGetCausalHashByPath err) -> handleGetCausalHashByPathError err
-      (Share.PullErrorNoHistoryAtPath sharePath) ->
+      Share.PullErrorNoHistoryAtPath sharePath ->
        P.wrap $ P.text "The server didn't find anything at" <> prettySharePath sharePath
+      Share.PullErrorNoReadPermission sharePath -> noReadPermission sharePath
    ShareErrorGetCausalHashByPath err -> handleGetCausalHashByPathError err
    ShareErrorTransport te -> case te of
      DecodeFailure msg resp ->
@ -2027,24 +2034,18 @@ displayRendered outputLoc pp =
                P.indentN 2 pp
              ]

-displayDefinitions ::
-  Var v =>
-  Ord a1 =>
-  Maybe FilePath ->
-  PPED.PrettyPrintEnvDecl ->
-  Map Reference.Reference (DisplayObject () (DD.Decl v a1)) ->
-  Map Reference.Reference (DisplayObject (Type v a1) (Term v a1)) ->
-  IO Pretty
-displayDefinitions _outputLoc _ppe types terms
-  | Map.null types && Map.null terms = pure $ P.callout "😶" "No results to display."
-displayDefinitions outputLoc ppe types terms =
-  maybe displayOnly scratchAndDisplay outputLoc
+displayDefinitions :: DisplayDefinitionsOutput -> IO Pretty
+displayDefinitions DisplayDefinitionsOutput {isTest, outputFile, prettyPrintEnv = ppe, terms, types} =
+  if Map.null types && Map.null terms
+    then pure $ P.callout "😶" "No results to display."
+    else maybe displayOnly scratchAndDisplay outputFile
  where
-    displayOnly = pure code
+    ppeDecl = PPED.unsuffixifiedPPE ppe
+    displayOnly = pure (code (const False))
    scratchAndDisplay path = do
      path' <- canonicalizePath path
-      prependToFile code path'
-      pure (message code path')
+      prependToFile (code isTest) path'
+      pure (message (code (const False)) path')
      where
        prependToFile code path = do
          existingContents <- do
@ -2071,47 +2072,63 @@ displayDefinitions outputLoc ppe types terms =
                  "You can edit them there, then do" <> makeExample' IP.update
                    <> "to replace the definitions currently in this namespace."
              ]
-    code =
-      P.syntaxToColor $ P.sep "\n\n" (prettyTypes <> prettyTerms)
+
+    code :: (TermReference -> Bool) -> Pretty
+    code isTest =
+      P.syntaxToColor $ P.sep "\n\n" (prettyTypes <> prettyTerms isTest)
+
+    prettyTypes :: [P.Pretty SyntaxText]
+    prettyTypes =
+      types
+        & Map.toList
+        & map (\(ref, dt) -> (PPE.typeName ppeDecl ref, ref, dt))
+        & List.sortBy (\(n0, _, _) (n1, _, _) -> Name.compareAlphabetical n0 n1)
+        & map prettyType
+
+    prettyTerms :: (TermReference -> Bool) -> [P.Pretty SyntaxText]
+    prettyTerms isTest =
+      terms
+        & Map.toList
+        & map (\(ref, dt) -> (PPE.termName ppeDecl (Referent.Ref ref), ref, dt))
+        & List.sortBy (\(n0, _, _) (n1, _, _) -> Name.compareAlphabetical n0 n1)
+        & map (\t -> prettyTerm (isTest (t ^. _2)) t)
+
+    prettyTerm ::
+      Bool ->
+      (HQ.HashQualified Name, Reference, DisplayObject (Type Symbol Ann) (Term Symbol Ann)) ->
+      P.Pretty SyntaxText
+    prettyTerm isTest (n, r, dt) =
+      case dt of
+        MissingObject r -> missing n r
+        BuiltinObject typ ->
+          (if isJust outputFile then P.indent "-- " else id) $
+            P.hang
+              ("builtin " <> prettyHashQualified n <> " :")
+              (TypePrinter.prettySyntax (ppeBody n r) typ)
+        UserObject tm ->
+          if isTest
+            then WK.TestWatch <> "> " <> TermPrinter.prettyBindingWithoutTypeSignature (ppeBody n r) n tm
+            else TermPrinter.prettyBinding (ppeBody n r) n tm
      where
        ppeBody n r = PPE.biasTo (maybeToList $ HQ.toName n) $ PPE.declarationPPE ppe r
-        ppeDecl = PPED.unsuffixifiedPPE ppe
-        prettyTerms =
-          terms
-            & Map.toList
-            & map (\(ref, dt) -> (PPE.termName ppeDecl (Referent.Ref ref), ref, dt))
-            & List.sortBy (\(n0, _, _) (n1, _, _) -> Name.compareAlphabetical n0 n1)
-            & map go
-        prettyTypes =
-          types
-            & Map.toList
-            & map (\(ref, dt) -> (PPE.typeName ppeDecl ref, ref, dt))
-            & List.sortBy (\(n0, _, _) (n1, _, _) -> Name.compareAlphabetical n0 n1)
-            & map go2
-        go (n, r, dt) =
-          case dt of
-            MissingObject r -> missing n r
-            BuiltinObject typ ->
-              (if isJust outputLoc then P.indent "-- " else id) $
-                P.hang
-                  ("builtin " <> prettyHashQualified n <> " :")
-                  (TypePrinter.prettySyntax (ppeBody n r) typ)
-            UserObject tm -> TermPrinter.prettyBinding (ppeBody n r) n tm
-        go2 (n, r, dt) =
-          case dt of
-            MissingObject r -> missing n r
-            BuiltinObject _ -> builtin n
-            UserObject decl -> DeclPrinter.prettyDecl (PPED.biasTo (maybeToList $ HQ.toName n) $ PPE.declarationPPEDecl ppe r) r n decl
-        builtin n = P.wrap $ "--" <> prettyHashQualified n <> " is built-in."
-        missing n r =
-          P.wrap
-            ( "-- The name " <> prettyHashQualified n <> " is assigned to the "
-                <> "reference "
-                <> fromString (show r ++ ",")
-                <> "which is missing from the codebase."
-            )
-            <> P.newline
-            <> tip "You might need to repair the codebase manually."
+
+    prettyType :: (HQ.HashQualified Name, Reference, DisplayObject () (DD.Decl Symbol Ann)) -> P.Pretty SyntaxText
+    prettyType (n, r, dt) =
+      case dt of
+        MissingObject r -> missing n r
+        BuiltinObject _ -> builtin n
+        UserObject decl -> DeclPrinter.prettyDecl (PPED.biasTo (maybeToList $ HQ.toName n) $ PPE.declarationPPEDecl ppe r) r n decl
+
+    builtin n = P.wrap $ "--" <> prettyHashQualified n <> " is built-in."
+    missing n r =
+      P.wrap
+        ( "-- The name " <> prettyHashQualified n <> " is assigned to the "
+            <> "reference "
+            <> fromString (show r ++ ",")
+            <> "which is missing from the codebase."
+        )
+        <> P.newline
+        <> tip "You might need to repair the codebase manually."

 displayTestResults ::
  Bool -> -- whether to show the tip
--- a/unison-cli/src/Unison/LSP.hs
+++ b/unison-cli/src/Unison/LSP.hs
@ -26,7 +26,7 @@ import Unison.Codebase.Runtime (Runtime)
 import qualified Unison.Debug as Debug
 import Unison.LSP.CancelRequest (cancelRequestHandler)
 import Unison.LSP.CodeAction (codeActionHandler)
-import Unison.LSP.Completion (completionHandler)
+import Unison.LSP.Completion (completionHandler, completionItemResolveHandler)
 import qualified Unison.LSP.Configuration as Config
 import qualified Unison.LSP.FileAnalysis as Analysis
 import Unison.LSP.FoldingRange (foldingRangeRequest)
@ -137,6 +137,7 @@ lspRequestHandlers =
    & SMM.insert STextDocumentCodeAction (mkHandler codeActionHandler)
    & SMM.insert STextDocumentFoldingRange (mkHandler foldingRangeRequest)
    & SMM.insert STextDocumentCompletion (mkHandler completionHandler)
+    & SMM.insert SCompletionItemResolve (mkHandler completionItemResolveHandler)
  where
    defaultTimeout = 10_000 -- 10s
    mkHandler ::
--- a/unison-cli/src/Unison/LSP/Completion.hs
+++ b/unison-cli/src/Unison/LSP/Completion.hs
@ -1,12 +1,15 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE RecordWildCards #-}

 module Unison.LSP.Completion where

 import Control.Comonad.Cofree
 import Control.Lens hiding (List, (:<))
 import Control.Monad.Reader
+import qualified Data.Aeson as Aeson
+import qualified Data.Aeson.Types as Aeson
 import Data.Bifunctor (second)
 import Data.List.Extra (nubOrdOn)
 import Data.List.NonEmpty (NonEmpty (..))
@ -17,6 +20,10 @@ import Language.LSP.Types
 import Language.LSP.Types.Lens
 import Unison.Codebase.Path (Path)
 import qualified Unison.Codebase.Path as Path
+import qualified Unison.HashQualified as HQ
+import qualified Unison.HashQualified' as HQ'
+import Unison.LSP.FileAnalysis
+import qualified Unison.LSP.Queries as LSPQ
 import Unison.LSP.Types
 import qualified Unison.LSP.VFS as VFS
 import Unison.LabeledDependency (LabeledDependency)
@ -29,20 +36,25 @@ import Unison.Names (Names (..))
 import Unison.Prelude
 import qualified Unison.PrettyPrintEnv as PPE
 import qualified Unison.PrettyPrintEnvDecl as PPED
+import qualified Unison.Reference as Reference
 import qualified Unison.Referent as Referent
-import qualified Unison.Syntax.Name as Name (toText)
+import qualified Unison.Syntax.DeclPrinter as DeclPrinter
 import qualified Unison.Syntax.HashQualified' as HQ' (toText)
+import qualified Unison.Syntax.Name as Name (fromText, toText)
+import qualified Unison.Syntax.TypePrinter as TypePrinter
 import qualified Unison.Util.Monoid as Monoid
+import qualified Unison.Util.Pretty as Pretty
 import qualified Unison.Util.Relation as Relation

 completionHandler :: RequestMessage 'TextDocumentCompletion -> (Either ResponseError (ResponseResult 'TextDocumentCompletion) -> Lsp ()) -> Lsp ()
 completionHandler m respond =
  respond . maybe (Right $ InL mempty) (Right . InR) =<< runMaybeT do
-    (range, prefix) <- MaybeT $ VFS.completionPrefix (m ^. params)
+    let fileUri = (m ^. params . textDocument . uri)
+    (range, prefix) <- VFS.completionPrefix (m ^. params)
    ppe <- PPED.suffixifiedPPE <$> lift globalPPED
-    completions <- lift getCompletions
+    codebaseCompletions <- lift getCodebaseCompletions
    Config {maxCompletions} <- lift getConfig
-    let defMatches = matchCompletions completions prefix
+    let defMatches = matchCompletions codebaseCompletions prefix
    let (isIncomplete, defCompletions) =
          defMatches
            & nubOrdOn (\(p, _name, ref) -> (p, ref))
@ -55,7 +67,7 @@ completionHandler m respond =
            & mapMaybe \(path, fqn, dep) ->
              let biasedPPE = PPE.biasTo [fqn] ppe
                  hqName = LD.fold (PPE.types biasedPPE) (PPE.terms biasedPPE) dep
-               in hqName <&> \hqName -> mkDefCompletionItem range (Name.toText fqn) path (HQ'.toText hqName) dep
+               in hqName <&> \hqName -> mkDefCompletionItem fileUri range (HQ'.toName hqName) fqn path (HQ'.toText hqName) dep
    pure . CompletionList isIncomplete . List $ defCompletionItems
  where
    -- Takes at most the specified number of completions, but also indicates with a boolean
@ -65,8 +77,8 @@ completionHandler m respond =
    takeCompletions _ [] = (False, [])
    takeCompletions n (x : xs) = second (x :) $ takeCompletions (pred n) xs

-mkDefCompletionItem :: Range -> Text -> Text -> Text -> LabeledDependency -> CompletionItem
-mkDefCompletionItem range fqn path suffixified dep =
+mkDefCompletionItem :: Uri -> Range -> Name -> Name -> Text -> Text -> LabeledDependency -> CompletionItem
+mkDefCompletionItem fileUri range relativeName fullyQualifiedName path suffixified dep =
  CompletionItem
    { _label = lbl,
      _kind = case dep of
@ -75,7 +87,7 @@ mkDefCompletionItem range fqn path suffixified dep =
          Referent.Con {} -> Just CiConstructor
          Referent.Ref {} -> Just CiValue,
      _tags = Nothing,
-      _detail = Just fqn,
+      _detail = Just (Name.toText fullyQualifiedName),
      _documentation = Nothing,
      _deprecated = Nothing,
      _preselect = Nothing,
@ -88,7 +100,7 @@ mkDefCompletionItem range fqn path suffixified dep =
      _additionalTextEdits = Nothing,
      _commitCharacters = Nothing,
      _command = Nothing,
-      _xdata = Nothing
+      _xdata = Just $ Aeson.toJSON $ CompletionItemDetails {dep, relativeName, fullyQualifiedName, fileUri}
    }
  where
    -- We should generally show the longer of the path or suffixified name in the label,
@ -240,3 +252,73 @@ matchCompletions (CompletionTree tree) txt =
      let childMatches = mkDefMatches rest <&> over _1 (Path.cons ns)
      let currentMatches = matches <&> \(name, dep) -> (Path.singleton ns, name, dep)
      currentMatches <> childMatches
+
+-- | Called to resolve additional details for a completion item that the user is considering.
+completionItemResolveHandler :: RequestMessage 'CompletionItemResolve -> (Either ResponseError CompletionItem -> Lsp ()) -> Lsp ()
+completionItemResolveHandler message respond = do
+  let completion :: CompletionItem
+      completion = message ^. params
+  respond . maybe (Right completion) Right =<< runMaybeT do
+    case Aeson.fromJSON <$> (completion ^. xdata) of
+      Just (Aeson.Success (CompletionItemDetails {dep, fullyQualifiedName, relativeName, fileUri})) -> do
+        pped <- lift $ ppedForFile fileUri
+        case dep of
+          LD.TermReferent ref -> do
+            typ <- LSPQ.getTypeOfReferent fileUri ref
+            let renderedType = ": " <> (Text.pack $ TypePrinter.prettyStr (Just typeWidth) (PPED.suffixifiedPPE pped) typ)
+            let doc = CompletionDocMarkup (toUnisonMarkup (Name.toText fullyQualifiedName))
+            pure $ (completion {_detail = Just renderedType, _documentation = Just doc} :: CompletionItem)
+          LD.TypeReference ref ->
+            case ref of
+              Reference.Builtin {} -> do
+                let renderedBuiltin = ": <builtin>"
+                let doc = CompletionDocMarkup (toUnisonMarkup (Name.toText fullyQualifiedName))
+                pure $ (completion {_detail = Just renderedBuiltin, _documentation = Just doc} :: CompletionItem)
+              Reference.DerivedId refId -> do
+                decl <- LSPQ.getTypeDeclaration fileUri refId
+                let renderedDecl = ": " <> (Text.pack . Pretty.toPlain typeWidth . Pretty.syntaxToColor $ DeclPrinter.prettyDecl pped ref (HQ.NameOnly relativeName) decl)
+                let doc = CompletionDocMarkup (toUnisonMarkup (Name.toText fullyQualifiedName))
+                pure $ (completion {_detail = Just renderedDecl, _documentation = Just doc} :: CompletionItem)
+      _ -> empty
+  where
+    toUnisonMarkup txt = MarkupContent {_kind = MkMarkdown, _value = Text.unlines ["```unison", txt, "```"]}
+    -- Completion windows can be very small, so this seems like a good default
+    typeWidth = Pretty.Width 20
+
+-- | Data which will be provided back to us in the completion resolve handler when the user considers this completion.
+data CompletionItemDetails = CompletionItemDetails
+  { dep :: LD.LabeledDependency,
+    relativeName :: Name,
+    fullyQualifiedName :: Name,
+    fileUri :: Uri
+  }
+
+instance Aeson.ToJSON CompletionItemDetails where
+  toJSON CompletionItemDetails {dep, relativeName, fullyQualifiedName, fileUri} =
+    Aeson.object
+      [ "relativeName" Aeson..= Name.toText relativeName,
+        "fullyQualifiedName" Aeson..= Name.toText fullyQualifiedName,
+        "fileUri" Aeson..= fileUri,
+        "dep" Aeson..= ldJSON dep
+      ]
+    where
+      ldJSON :: LD.LabeledDependency -> Aeson.Value
+      ldJSON = \case
+        LD.TypeReference ref -> Aeson.object ["kind" Aeson..= ("type" :: Text), "ref" Aeson..= Reference.toText ref]
+        LD.TermReferent ref -> Aeson.object ["kind" Aeson..= ("term" :: Text), "ref" Aeson..= Referent.toText ref]
+
+instance Aeson.FromJSON CompletionItemDetails where
+  parseJSON = Aeson.withObject "CompletionItemDetails" \obj -> do
+    dep <- ((obj Aeson..: "dep") >>= ldParser)
+    relativeName <- (obj Aeson..: "relativeName" >>= maybe (fail "Invalid name in CompletionItemDetails") pure . Name.fromText)
+    fullyQualifiedName <- (obj Aeson..: "fullyQualifiedName" >>= maybe (fail "Invalid name in CompletionItemDetails") pure . Name.fromText)
+    fileUri <- obj Aeson..: "fileUri"
+    pure $ CompletionItemDetails {..}
+    where
+      ldParser :: Aeson.Value -> Aeson.Parser LD.LabeledDependency
+      ldParser = Aeson.withObject "LabeledDependency" \obj -> do
+        kind <- obj Aeson..: "kind"
+        case kind of
+          ("type" :: Text) -> LD.TypeReference <$> (obj Aeson..: "ref" >>= either (const $ fail "Invalid Reference in LabeledDependency") pure . Reference.fromText)
+          ("term" :: Text) -> LD.TermReferent <$> (obj Aeson..: "ref" >>= maybe (fail "Invalid Referent in LabeledDependency") pure . Referent.fromText)
+          _ -> fail "Invalid LabeledDependency kind"
--- a/unison-cli/src/Unison/LSP/FileAnalysis.hs
+++ b/unison-cli/src/Unison/LSP/FileAnalysis.hs
@ -34,6 +34,7 @@ import Unison.LSP.Diagnostics
  )
 import Unison.LSP.Orphans ()
 import Unison.LSP.Types
+import qualified Unison.LSP.Types as LSP
 import qualified Unison.LSP.VFS as VFS
 import qualified Unison.NamesWithHistory as NamesWithHistory
 import Unison.Parser.Ann (Ann)
@ -47,10 +48,13 @@ import qualified Unison.PrintError as PrintError
 import Unison.Result (Note)
 import qualified Unison.Result as Result
 import Unison.Symbol (Symbol)
+import qualified Unison.Symbol as Symbol
 import qualified Unison.Syntax.HashQualified' as HQ' (toText)
 import qualified Unison.Syntax.Lexer as L
 import qualified Unison.Syntax.Parser as Parser
 import qualified Unison.Syntax.TypePrinter as TypePrinter
+import qualified Unison.Term as Term
+import Unison.Type (Type)
 import qualified Unison.Typechecker.Context as Context
 import qualified Unison.Typechecker.TypeError as TypeError
 import qualified Unison.UnisonFile as UF
@ -58,16 +62,17 @@ import qualified Unison.UnisonFile.Names as UF
 import Unison.Util.Monoid (foldMapM)
 import qualified Unison.Util.Pretty as Pretty
 import qualified Unison.Var as Var
+import Unison.WatchKind (pattern TestWatch)
 import UnliftIO (atomically, modifyTVar', readTVar, readTVarIO, writeTVar)

 -- | Lex, parse, and typecheck a file.
 checkFile :: HasUri d Uri => d -> Lsp (Maybe FileAnalysis)
 checkFile doc = runMaybeT $ do
  let fileUri = doc ^. uri
-  (fileVersion, contents) <- MaybeT (VFS.getFileContents doc)
+  (fileVersion, contents) <- VFS.getFileContents fileUri
  parseNames <- lift getParseNames
  let sourceName = getUri $ doc ^. uri
-  let lexedSource@(srcText, _) = (contents, L.lexer (Text.unpack sourceName) (Text.unpack contents))
+  let lexedSource@(srcText, _tokens) = (contents, L.lexer (Text.unpack sourceName) (Text.unpack contents))
  let ambientAbilities = []
  cb <- asks codebase
  let generateUniqueName = Parser.uniqueBase32Namegen <$> Random.getSystemDRG
@ -77,8 +82,7 @@ checkFile doc = runMaybeT $ do
        Nothing -> (Nothing, Nothing)
        Just (Left uf) -> (Just uf, Nothing)
        Just (Right tf) -> (Just $ UF.discardTypes tf, Just tf)
-  pped <- lift $ ppedForFileHelper parsedFile typecheckedFile
-  (diagnostics, codeActions) <- lift $ analyseFile pped fileUri srcText notes
+  (diagnostics, codeActions) <- lift $ analyseFile fileUri srcText notes
  let diagnosticRanges =
        diagnostics
          & fmap (\d -> (d ^. range, d))
@ -87,9 +91,82 @@ checkFile doc = runMaybeT $ do
        codeActions
          & foldMap (\(RangedCodeAction {_codeActionRanges, _codeAction}) -> (,_codeAction) <$> _codeActionRanges)
          & toRangeMap
-  let fileAnalysis = FileAnalysis {diagnostics = diagnosticRanges, codeActions = codeActionRanges, ..}
+  let fileSummary = mkFileSummary parsedFile typecheckedFile
+  let fileAnalysis = FileAnalysis {diagnostics = diagnosticRanges, codeActions = codeActionRanges, fileSummary, ..}
  pure $ fileAnalysis

+-- | If a symbol is a 'User' symbol, return (Just sym), otherwise return Nothing.
+assertUserSym :: Symbol -> Maybe Symbol
+assertUserSym sym = case sym of
+  Symbol.Symbol _ (Var.User {}) -> Just sym
+  _ -> Nothing
+
+-- | Summarize the information available to us from the current state of the file.
+-- See 'FileSummary' for more information.
+mkFileSummary :: Maybe (UF.UnisonFile Symbol Ann) -> Maybe (UF.TypecheckedUnisonFile Symbol Ann) -> Maybe FileSummary
+mkFileSummary parsed typechecked = case (parsed, typechecked) of
+  (Nothing, Nothing) -> Nothing
+  (_, Just tf@(UF.TypecheckedUnisonFileId {dataDeclarationsId', effectDeclarationsId', hashTermsId})) ->
+    let (trms, testWatches, exprWatches) =
+          hashTermsId & ifoldMap \sym (ref, wk, trm, typ) ->
+            case wk of
+              Nothing -> (Map.singleton sym (Just ref, trm, getUserTypeAnnotation sym <|> Just typ), mempty, mempty)
+              Just TestWatch -> (mempty, [(assertUserSym sym, Just ref, trm, getUserTypeAnnotation sym <|> Just typ)], mempty)
+              Just _ -> (mempty, mempty, [(assertUserSym sym, Just ref, trm, getUserTypeAnnotation sym <|> Just typ)])
+     in Just $
+          FileSummary
+            { dataDeclsBySymbol = dataDeclarationsId',
+              dataDeclsByReference = declsRefMap dataDeclarationsId',
+              effectDeclsBySymbol = effectDeclarationsId',
+              effectDeclsByReference = declsRefMap effectDeclarationsId',
+              termsBySymbol = trms,
+              termsByReference = termsRefMap trms,
+              testWatchSummary = testWatches,
+              exprWatchSummary = exprWatches,
+              fileNames = UF.typecheckedToNames tf
+            }
+  (Just uf@(UF.UnisonFileId {dataDeclarationsId, effectDeclarationsId, terms, watches}), _) ->
+    let trms =
+          terms & foldMap \(sym, trm) ->
+            (Map.singleton sym (Nothing, trm, Nothing))
+        (testWatches, exprWatches) =
+          watches & ifoldMap \wk tms ->
+            tms & foldMap \(v, trm) ->
+              case wk of
+                TestWatch -> ([(assertUserSym v, Nothing, trm, Nothing)], mempty)
+                _ -> (mempty, [(assertUserSym v, Nothing, trm, Nothing)])
+     in Just $
+          FileSummary
+            { dataDeclsBySymbol = dataDeclarationsId,
+              dataDeclsByReference = declsRefMap dataDeclarationsId,
+              effectDeclsBySymbol = effectDeclarationsId,
+              effectDeclsByReference = declsRefMap effectDeclarationsId,
+              termsBySymbol = trms,
+              termsByReference = termsRefMap trms,
+              testWatchSummary = testWatches,
+              exprWatchSummary = exprWatches,
+              fileNames = UF.toNames uf
+            }
+  where
+    declsRefMap :: (Ord v, Ord r) => Map v (r, a) -> Map r (Map v a)
+    declsRefMap m =
+      m & Map.toList
+        & fmap (\(v, (r, a)) -> (r, Map.singleton v a))
+        & Map.fromListWith (<>)
+    termsRefMap :: (Ord v, Ord r) => Map v (r, a, b) -> Map r (Map v (a, b))
+    termsRefMap m =
+      m & Map.toList
+        & fmap (\(v, (r, a, b)) -> (r, Map.singleton v (a, b)))
+        & Map.fromListWith (<>)
+    -- Gets the user provided type annotation for a term if there is one.
+    -- This type sig will have Ann's within the file if it exists.
+    getUserTypeAnnotation :: Symbol -> Maybe (Type Symbol Ann)
+    getUserTypeAnnotation v = do
+      UF.UnisonFileId {terms, watches} <- parsed
+      trm <- Prelude.lookup v (terms <> fold watches)
+      typ <- Term.getTypeAnnotation trm
+      pure typ
+
 fileAnalysisWorker :: Lsp ()
 fileAnalysisWorker = forever do
  dirtyFilesV <- asks dirtyFilesVar
@ -111,9 +188,10 @@ fileAnalysisWorker = forever do
  for freshlyCheckedFiles \(FileAnalysis {fileUri, fileVersion, diagnostics}) -> do
    reportDiagnostics fileUri (Just fileVersion) $ fold diagnostics

-analyseFile :: Foldable f => PPED.PrettyPrintEnvDecl -> Uri -> Text -> f (Note Symbol Ann) -> Lsp ([Diagnostic], [RangedCodeAction])
-analyseFile ppe fileUri srcText notes = do
-  analyseNotes fileUri (PPED.suffixifiedPPE ppe) (Text.unpack srcText) notes
+analyseFile :: Foldable f => Uri -> Text -> f (Note Symbol Ann) -> Lsp ([Diagnostic], [RangedCodeAction])
+analyseFile fileUri srcText notes = do
+  pped <- PPED.suffixifiedPPE <$> LSP.globalPPED
+  analyseNotes fileUri pped (Text.unpack srcText) notes

 analyseNotes :: Foldable f => Uri -> PrettyPrintEnv -> String -> f (Note Symbol Ann) -> Lsp ([Diagnostic], [RangedCodeAction])
 analyseNotes fileUri ppe src notes = do
@ -271,6 +349,11 @@ getFileAnalysis uri = do
  checkedFiles <- readTVarIO checkedFilesV
  pure $ Map.lookup uri checkedFiles

+getFileSummary :: Uri -> MaybeT Lsp FileSummary
+getFileSummary uri = do
+  FileAnalysis {fileSummary} <- MaybeT $ getFileAnalysis uri
+  MaybeT . pure $ fileSummary
+
 -- TODO memoize per file
 ppedForFile :: Uri -> Lsp PPED.PrettyPrintEnvDecl
 ppedForFile fileUri = do
--- a/unison-cli/src/Unison/LSP/Hover.hs
+++ b/unison-cli/src/Unison/LSP/Hover.hs
@ -24,7 +24,7 @@ hoverHandler :: RequestMessage 'TextDocumentHover -> (Either ResponseError (Resp
 hoverHandler m respond =
  respond . Right =<< runMaybeT do
    let p = (m ^. params)
-    txtIdentifier <- MaybeT $ identifierAtPosition p
+    txtIdentifier <- identifierAtPosition p
    hqIdentifier <- MaybeT . pure $ HQ.fromText txtIdentifier
    cb <- asks codebase
    rt <- asks runtime
--- a/unison-cli/src/Unison/LSP/Queries.hs
+++ b/unison-cli/src/Unison/LSP/Queries.hs
@ -5,14 +5,23 @@ module Unison.LSP.Queries
    findSmallestEnclosingNode,
    findSmallestEnclosingType,
    refInDecl,
+    getTypeOfReferent,
+    getTypeDeclaration,
  )
 where

 import Control.Lens
+import Control.Monad.Reader
+import Language.LSP.Types
 import qualified Unison.ABT as ABT
+import qualified Unison.Codebase as Codebase
+import Unison.ConstructorReference (GConstructorReference (..))
 import qualified Unison.ConstructorType as CT
+import Unison.DataDeclaration (Decl)
 import qualified Unison.DataDeclaration as DD
+import Unison.LSP.FileAnalysis
 import Unison.LSP.Orphans ()
+import Unison.LSP.Types
 import Unison.LabeledDependency
 import qualified Unison.LabeledDependency as LD
 import Unison.Lexer.Pos (Pos (..))
@ -20,12 +29,52 @@ import Unison.Parser.Ann (Ann)
 import qualified Unison.Parser.Ann as Ann
 import Unison.Prelude
 import Unison.Reference (TypeReference)
+import qualified Unison.Reference as Reference
+import Unison.Referent (Referent)
+import qualified Unison.Referent as Referent
 import Unison.Symbol (Symbol)
 import Unison.Term (MatchCase (MatchCase), Term)
 import qualified Unison.Term as Term
 import Unison.Type (Type)
 import qualified Unison.Type as Type

+-- | Gets the type of a reference from either the parsed file or the codebase.
+getTypeOfReferent :: Uri -> Referent -> MaybeT Lsp (Type Symbol Ann)
+getTypeOfReferent fileUri ref = do
+  getFromFile <|> getFromCodebase
+  where
+    getFromFile = do
+      FileSummary {termsByReference} <- getFileSummary fileUri
+      case ref of
+        Referent.Ref (Reference.Builtin {}) -> empty
+        Referent.Ref (Reference.DerivedId termRefId) -> do
+          MaybeT . pure $ (termsByReference ^? ix (Just termRefId) . folded . _2 . _Just)
+        Referent.Con (ConstructorReference r0 cid) _type -> do
+          case r0 of
+            Reference.DerivedId r -> do
+              decl <- getTypeDeclaration fileUri r
+              MaybeT . pure $ DD.typeOfConstructor (either DD.toDataDecl id decl) cid
+            Reference.Builtin _ -> empty
+    getFromCodebase = do
+      Env {codebase} <- ask
+      MaybeT . liftIO $ Codebase.runTransaction codebase $ Codebase.getTypeOfReferent codebase ref
+
+-- | Gets a decl from either the parsed file or the codebase.
+getTypeDeclaration :: Uri -> Reference.Id -> MaybeT Lsp (Decl Symbol Ann)
+getTypeDeclaration fileUri refId = do
+  getFromFile <|> getFromCodebase
+  where
+    getFromFile :: MaybeT Lsp (Decl Symbol Ann)
+    getFromFile = do
+      FileSummary {dataDeclsByReference, effectDeclsByReference} <- getFileSummary fileUri
+      let datas = dataDeclsByReference ^.. ix refId . folded
+      let effects = effectDeclsByReference ^.. ix refId . folded
+      MaybeT . pure . listToMaybe $ fmap Right datas <> fmap Left effects
+
+    getFromCodebase = do
+      Env {codebase} <- ask
+      MaybeT . liftIO $ Codebase.runTransaction codebase $ Codebase.getTypeDeclaration codebase refId
+
 -- | Returns the reference a given term node refers to, if any.
 refInTerm :: (Term v a -> Maybe LabeledDependency)
 refInTerm term =
--- a/unison-cli/src/Unison/LSP/Types.hs
+++ b/unison-cli/src/Unison/LSP/Types.hs
@ -29,18 +29,23 @@ import Language.LSP.VFS
 import Unison.Codebase
 import qualified Unison.Codebase.Path as Path
 import Unison.Codebase.Runtime (Runtime)
+import qualified Unison.DataDeclaration as DD
 import Unison.LSP.Orphans ()
 import Unison.LabeledDependency (LabeledDependency)
 import Unison.Name (Name)
 import Unison.NameSegment (NameSegment)
+import Unison.Names (Names)
 import Unison.NamesWithHistory (NamesWithHistory)
 import Unison.Parser.Ann
 import Unison.Prelude
 import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl)
+import qualified Unison.Reference as Reference
 import Unison.Result (Note)
 import qualified Unison.Server.Backend as Backend
 import Unison.Symbol
 import qualified Unison.Syntax.Lexer as Lexer
+import Unison.Term (Term)
+import Unison.Type (Type)
 import qualified Unison.UnisonFile as UF
 import UnliftIO

@ -109,14 +114,34 @@ data FileAnalysis = FileAnalysis
    typecheckedFile :: Maybe (UF.TypecheckedUnisonFile Symbol Ann),
    notes :: Seq (Note Symbol Ann),
    diagnostics :: IntervalMap Position [Diagnostic],
-    codeActions :: IntervalMap Position [CodeAction]
+    codeActions :: IntervalMap Position [CodeAction],
+    fileSummary :: Maybe FileSummary
  }

+-- | A file that parses might not always type-check, but often we just want to get as much
+-- information as we have available. This provides a type where we can summarize the
+-- information available in a Unison file.
+--
+-- If the file typechecked then all the Ref Ids and types will be filled in, otherwise
+-- they will be Nothing.
+data FileSummary = FileSummary
+  { dataDeclsBySymbol :: Map Symbol (Reference.Id, DD.DataDeclaration Symbol Ann),
+    dataDeclsByReference :: Map Reference.Id (Map Symbol (DD.DataDeclaration Symbol Ann)),
+    effectDeclsBySymbol :: Map Symbol (Reference.Id, DD.EffectDeclaration Symbol Ann),
+    effectDeclsByReference :: Map Reference.Id (Map Symbol (DD.EffectDeclaration Symbol Ann)),
+    termsBySymbol :: Map Symbol (Maybe Reference.Id, Term Symbol Ann, Maybe (Type Symbol Ann)),
+    termsByReference :: Map (Maybe Reference.Id) (Map Symbol (Term Symbol Ann, Maybe (Type Symbol Ann))),
+    testWatchSummary :: [(Maybe Symbol, Maybe Reference.Id, Term Symbol Ann, Maybe (Type Symbol Ann))],
+    exprWatchSummary :: [(Maybe Symbol, Maybe Reference.Id, Term Symbol Ann, Maybe (Type Symbol Ann))],
+    fileNames :: Names
+  }
+  deriving stock (Show)
+
 getCurrentPath :: Lsp Path.Absolute
 getCurrentPath = asks currentPathCache >>= liftIO

-getCompletions :: Lsp CompletionTree
-getCompletions = asks completionsVar >>= readTVarIO
+getCodebaseCompletions :: Lsp CompletionTree
+getCodebaseCompletions = asks completionsVar >>= readTVarIO

 globalPPED :: Lsp PrettyPrintEnvDecl
 globalPPED = asks ppedCache >>= liftIO
--- a/unison-cli/src/Unison/LSP/VFS.hs
+++ b/unison-cli/src/Unison/LSP/VFS.hs
@ -33,14 +33,14 @@ usingVFS m = do
  vfsVar' <- asks vfsVar
  modifyMVar vfsVar' $ \vfs -> swap <$> runStateT m vfs

-getVirtualFile :: (HasUri doc Uri) => doc -> Lsp (Maybe VirtualFile)
-getVirtualFile p = do
+getVirtualFile :: Uri -> MaybeT Lsp VirtualFile
+getVirtualFile fileUri = do
  vfs <- asks vfsVar >>= readMVar
-  pure $ vfs ^. vfsMap . at (toNormalizedUri $ p ^. uri)
+  MaybeT . pure $ vfs ^. vfsMap . at (toNormalizedUri $ fileUri)

-getFileContents :: (HasUri doc Uri) => doc -> Lsp (Maybe (FileVersion, Text))
-getFileContents p = runMaybeT $ do
-  vf <- MaybeT $ getVirtualFile p
+getFileContents :: Uri -> MaybeT Lsp (FileVersion, Text)
+getFileContents fileUri = do
+  vf <- getVirtualFile fileUri
  pure (vf ^. lsp_version, Rope.toText $ vf ^. file_text)

 vfsLogger :: Colog.LogAction (StateT VFS Lsp) (Colog.WithSeverity VfsLog)
@ -62,14 +62,14 @@ markAllFilesDirty = do
  markFilesDirty $ Map.keys (vfs ^. vfsMap)

 -- | Returns the name or symbol which the provided position is contained in.
-identifierAtPosition :: (HasPosition p Position, HasTextDocument p TextDocumentIdentifier) => p -> Lsp (Maybe Text)
+identifierAtPosition :: (HasPosition p Position, HasTextDocument p TextDocumentIdentifier) => p -> MaybeT Lsp Text
 identifierAtPosition p = do
-  identifierSplitAtPosition p <&> fmap \(before, after) -> (before <> after)
+  identifierSplitAtPosition p <&> \(before, after) -> (before <> after)

 -- | Returns the prefix and suffix of the symbol which the provided position is contained in.
-identifierSplitAtPosition :: (HasPosition p Position, HasTextDocument p docId, HasUri docId Uri) => p -> Lsp (Maybe (Text, Text))
-identifierSplitAtPosition p = runMaybeT $ do
-  vf <- MaybeT (getVirtualFile (p ^. textDocument))
+identifierSplitAtPosition :: (HasPosition p Position, HasTextDocument p docId, HasUri docId Uri) => p -> MaybeT Lsp (Text, Text)
+identifierSplitAtPosition p = do
+  vf <- getVirtualFile (p ^. textDocument . uri)
  PosPrefixInfo {fullLine, cursorPos} <- MaybeT (VFS.getCompletionPrefix (p ^. position) vf)
  let (before, after) = Text.splitAt (cursorPos ^. character . to fromIntegral) fullLine
  pure $ (Text.takeWhileEnd isIdentifierChar before, Text.takeWhile isIdentifierChar after)
@ -83,9 +83,9 @@ identifierSplitAtPosition p = runMaybeT $ do

 -- | Returns the prefix of the symbol at the provided location, and the range that prefix
 -- spans.
-completionPrefix :: (HasPosition p Position, HasTextDocument p docId, HasUri docId Uri) => p -> Lsp (Maybe (Range, Text))
-completionPrefix p = runMaybeT $ do
-  (before, _) <- MaybeT $ identifierSplitAtPosition p
+completionPrefix :: (HasPosition p Position, HasTextDocument p docId, HasUri docId Uri) => p -> MaybeT Lsp (Range, Text)
+completionPrefix p = do
+  (before, _) <- identifierSplitAtPosition p
  let posLine = p ^. position . LSP.line
  let posChar = (p ^. position . LSP.character)
  let range = mkRange posLine (posChar - fromIntegral (Text.length before)) posLine posChar
--- a/unison-cli/src/Unison/Share/Sync.hs
+++ b/unison-cli/src/Unison/Share/Sync.hs
@ -2,9 +2,7 @@
 {-# LANGUAGE TypeOperators #-}

 module Unison.Share.Sync
-  ( -- * High-level API
-
-    -- ** Get causal hash by path
+  ( -- ** Get causal hash by path
    getCausalHashByPath,
    GetCausalHashByPathError (..),

@ -22,6 +20,7 @@ where

 import Control.Concurrent.STM
 import Control.Monad.Except
+import Control.Monad.Reader (ask)
 import Control.Monad.Trans.Reader (ReaderT, runReaderT)
 import qualified Control.Monad.Trans.Reader as Reader
 import qualified Data.Foldable as Foldable (find)
@ -51,6 +50,9 @@ import qualified U.Codebase.Sqlite.Queries as Q
 import U.Codebase.Sqlite.V2.HashHandle (v2HashHandle)
 import Unison.Auth.HTTPClient (AuthenticatedHttpClient)
 import qualified Unison.Auth.HTTPClient as Auth
+import Unison.Cli.Monad (Cli)
+import qualified Unison.Cli.Monad as Cli
+import qualified Unison.Codebase as Codebase
 import qualified Unison.Debug as Debug
 import Unison.Hash32 (Hash32)
 import Unison.Prelude
@ -60,8 +62,6 @@ import qualified Unison.Sync.API as Share (API)
 import Unison.Sync.Common (causalHashToHash32, entityToTempEntity, expectEntity, hash32ToCausalHash)
 import qualified Unison.Sync.Types as Share
 import Unison.Util.Monoid (foldMapM)
-import qualified UnliftIO
-import UnliftIO.Exception (throwIO)

 ------------------------------------------------------------------------------------------------------------------------
 -- Pile of constants
@ -83,12 +83,8 @@ maxSimultaneousPushWorkers = 5
 -- This flavor of push takes the expected state of the server, and the desired state we want to set; if our expectation
 -- is off, we won't proceed with the push.
 checkAndSetPush ::
-  -- | The HTTP client to use for Unison Share requests.
-  AuthenticatedHttpClient ->
  -- | The Unison Share URL.
  BaseUrl ->
-  -- | SQLite-connection-making function, for writing entities we pull.
-  (forall a. (Sqlite.Connection -> IO a) -> IO a) ->
  -- | The repo+path to push to.
  Share.Path ->
  -- | The hash that we expect this repo+path to be at on Unison Share. If not, we'll get back a hash mismatch error.
@ -98,42 +94,54 @@ checkAndSetPush ::
  CausalHash ->
  -- | Callback that's given a number of entities we just uploaded.
  (Int -> IO ()) ->
-  IO (Either (SyncError CheckAndSetPushError) ())
-checkAndSetPush httpClient unisonShareUrl connect path expectedHash causalHash uploadedCallback = catchSyncErrors do
-  -- Maybe the server already has this causal; try just setting its remote path. Commonly, it will respond that it needs
-  -- this causal (UpdatePathMissingDependencies).
-  updatePath >>= \case
-    Share.UpdatePathSuccess -> pure (Right ())
-    Share.UpdatePathHashMismatch mismatch -> pure (Left (CheckAndSetPushErrorHashMismatch mismatch))
-    Share.UpdatePathMissingDependencies (Share.NeedDependencies dependencies) -> do
-      -- Upload the causal and all of its dependencies.
-      uploadEntities httpClient unisonShareUrl connect (Share.pathRepoName path) dependencies uploadedCallback >>= \case
-        False -> pure (Left (CheckAndSetPushErrorNoWritePermission path))
-        True ->
-          -- After uploading the causal and all of its dependencies, try setting the remote path again.
-          updatePath <&> \case
-            Share.UpdatePathSuccess -> Right ()
-            -- Between the initial updatePath attempt and this one, someone else managed to update the path. That's ok;
-            -- we still managed to upload our causal, but the push has indeed failed overall.
-            Share.UpdatePathHashMismatch mismatch -> Left (CheckAndSetPushErrorHashMismatch mismatch)
-            -- Unexpected, but possible: we thought we uploaded all we needed to, yet the server still won't accept our
-            -- causal. Bug in the client because we didn't upload enough? Bug in the server because we weren't told to
-            -- upload some dependency? Who knows.
-            Share.UpdatePathMissingDependencies (Share.NeedDependencies dependencies) ->
-              Left (CheckAndSetPushErrorServerMissingDependencies dependencies)
-            Share.UpdatePathNoWritePermission _ -> Left (CheckAndSetPushErrorNoWritePermission path)
-    Share.UpdatePathNoWritePermission _ -> pure (Left (CheckAndSetPushErrorNoWritePermission path))
-  where
-    updatePath :: IO Share.UpdatePathResponse
-    updatePath =
-      httpUpdatePath
-        httpClient
-        unisonShareUrl
-        Share.UpdatePathRequest
-          { path,
-            expectedHash,
-            newHash = causalHashToHash32 causalHash
-          }
+  Cli (Either (SyncError CheckAndSetPushError) ())
+checkAndSetPush unisonShareUrl path expectedHash causalHash uploadedCallback = do
+  Cli.Env {authHTTPClient} <- ask
+
+  Cli.label \done -> do
+    let failed :: SyncError CheckAndSetPushError -> Cli void
+        failed = done . Left
+
+    let updatePath :: Cli Share.UpdatePathResponse
+        updatePath = do
+          liftIO request & onLeftM \err -> failed (TransportError err)
+          where
+            request :: IO (Either CodeserverTransportError Share.UpdatePathResponse)
+            request =
+              httpUpdatePath
+                authHTTPClient
+                unisonShareUrl
+                Share.UpdatePathRequest
+                  { path,
+                    expectedHash,
+                    newHash = causalHashToHash32 causalHash
+                  }
+
+    -- Maybe the server already has this causal; try just setting its remote path. Commonly, it will respond that it
+    -- needs this causal (UpdatePathMissingDependencies).
+    updatePath >>= \case
+      Share.UpdatePathSuccess -> pure (Right ())
+      Share.UpdatePathHashMismatch mismatch -> pure (Left (SyncError (CheckAndSetPushErrorHashMismatch mismatch)))
+      Share.UpdatePathMissingDependencies (Share.NeedDependencies dependencies) -> do
+        -- Upload the causal and all of its dependencies.
+        uploadEntities unisonShareUrl (Share.pathRepoName path) dependencies uploadedCallback & onLeftM \err ->
+          failed $
+            err <&> \case
+              UploadEntitiesNoWritePermission -> CheckAndSetPushErrorNoWritePermission path
+
+        -- After uploading the causal and all of its dependencies, try setting the remote path again.
+        updatePath >>= \case
+          Share.UpdatePathSuccess -> pure (Right ())
+          -- Between the initial updatePath attempt and this one, someone else managed to update the path. That's ok;
+          -- we still managed to upload our causal, but the push has indeed failed overall.
+          Share.UpdatePathHashMismatch mismatch -> failed (SyncError (CheckAndSetPushErrorHashMismatch mismatch))
+          -- Unexpected, but possible: we thought we uploaded all we needed to, yet the server still won't accept our
+          -- causal. Bug in the client because we didn't upload enough? Bug in the server because we weren't told to
+          -- upload some dependency? Who knows.
+          Share.UpdatePathMissingDependencies (Share.NeedDependencies dependencies) ->
+            failed (SyncError (CheckAndSetPushErrorServerMissingDependencies dependencies))
+          Share.UpdatePathNoWritePermission _ -> failed (SyncError (CheckAndSetPushErrorNoWritePermission path))
+      Share.UpdatePathNoWritePermission _ -> failed (SyncError (CheckAndSetPushErrorNoWritePermission path))

 -- | Perform a fast-forward push (initially of just a causal hash, but ultimately all of its dependencies that the
 -- server is missing, too) to Unison Share.
@ -141,86 +149,105 @@ checkAndSetPush httpClient unisonShareUrl connect path expectedHash causalHash u
 -- This flavor of push provides the server with a chain of causal hashes leading from its current state to our desired
 -- state.
 fastForwardPush ::
-  -- | The HTTP client to use for Unison Share requests.
-  AuthenticatedHttpClient ->
  -- | The Unison Share URL.
  BaseUrl ->
-  -- | SQLite-connection-making function, for writing entities we pull.
-  (forall a. (Sqlite.Connection -> IO a) -> IO a) ->
  -- | The repo+path to push to.
  Share.Path ->
  -- | The hash of our local causal to push.
  CausalHash ->
  -- | Callback that's given a number of entities we just uploaded.
  (Int -> IO ()) ->
-  IO (Either (SyncError FastForwardPushError) ())
-fastForwardPush httpClient unisonShareUrl connect path localHeadHash uploadedCallback = catchSyncErrors do
-  getCausalHashByPath httpClient unisonShareUrl path >>= \case
-    Left (GetCausalHashByPathErrorNoReadPermission _) -> pure (Left (FastForwardPushErrorNoReadPermission path))
-    Right Nothing -> pure (Left (FastForwardPushErrorNoHistory path))
-    Right (Just (Share.hashJWTHash -> remoteHeadHash)) -> do
-      let doLoadCausalSpineBetween = do
-            -- (Temporary?) optimization - perform the "is ancestor?" check within sqlite before reconstructing the
-            -- actual path.
-            let isBefore :: Sqlite.Transaction Bool
-                isBefore = do
-                  maybeHashIds <-
-                    runMaybeT $
-                      (,)
-                        <$> MaybeT (Q.loadCausalHashIdByCausalHash (hash32ToCausalHash remoteHeadHash))
-                        <*> MaybeT (Q.loadCausalHashIdByCausalHash localHeadHash)
-                  case maybeHashIds of
-                    Nothing -> pure False
-                    Just (remoteHeadHashId, localHeadHashId) -> Q.before remoteHeadHashId localHeadHashId
-            isBefore >>= \case
-              False -> pure Nothing
-              True -> loadCausalSpineBetween remoteHeadHash (causalHashToHash32 localHeadHash)
-      (connect \conn -> Sqlite.runTransaction conn doLoadCausalSpineBetween) >>= \case
+  Cli (Either (SyncError FastForwardPushError) ())
+fastForwardPush unisonShareUrl path localHeadHash uploadedCallback = do
+  Cli.label \done -> do
+    let succeeded :: Cli void
+        succeeded =
+          done (Right ())
+
+    let failed :: SyncError FastForwardPushError -> Cli void
+        failed = done . Left
+
+    remoteHeadHash <-
+      getCausalHashByPath unisonShareUrl path >>= \case
+        Left (TransportError err) -> failed (TransportError err)
+        Left (SyncError (GetCausalHashByPathErrorNoReadPermission _)) ->
+          failed (SyncError (FastForwardPushErrorNoReadPermission path))
+        Right Nothing -> failed (SyncError (FastForwardPushErrorNoHistory path))
+        Right (Just remoteHeadHash) -> pure (Share.hashJWTHash remoteHeadHash)
+
+    let doLoadCausalSpineBetween = do
+          -- (Temporary?) optimization - perform the "is ancestor?" check within sqlite before reconstructing the
+          -- actual path.
+          let isBefore :: Sqlite.Transaction Bool
+              isBefore = do
+                maybeHashIds <-
+                  runMaybeT $
+                    (,)
+                      <$> MaybeT (Q.loadCausalHashIdByCausalHash (hash32ToCausalHash remoteHeadHash))
+                      <*> MaybeT (Q.loadCausalHashIdByCausalHash localHeadHash)
+                case maybeHashIds of
+                  Nothing -> pure False
+                  Just (remoteHeadHashId, localHeadHashId) -> Q.before remoteHeadHashId localHeadHashId
+          isBefore >>= \case
+            False -> pure Nothing
+            True -> loadCausalSpineBetween remoteHeadHash (causalHashToHash32 localHeadHash)
+
+    let doUpload :: List.NonEmpty CausalHash -> Cli ()
+        -- Maybe we could save round trips here by including the tail (or the head *and* the tail) as "extra hashes",
+        -- but we don't have that API yet. So, we only upload the head causal entity (which we don't even know for sure
+        -- the server doesn't have yet), and will (eventually) end up uploading the casuals in the tail that the server
+        -- needs.
+        doUpload (headHash :| _tailHashes) = do
+          request & onLeftM \err ->
+            failed $
+              err <&> \case
+                UploadEntitiesNoWritePermission -> (FastForwardPushErrorNoWritePermission path)
+          where
+            request =
+              uploadEntities
+                unisonShareUrl
+                (Share.pathRepoName path)
+                (NESet.singleton (causalHashToHash32 headHash))
+                uploadedCallback
+
+    localInnerHashes <-
+      Cli.runTransaction doLoadCausalSpineBetween >>= \case
        -- After getting the remote causal hash, we can tell from a local computation that this wouldn't be a
        -- fast-forward push, so we don't bother trying - just report the error now.
-        Nothing -> pure (Left (FastForwardPushErrorNotFastForward path))
+        Nothing -> failed (SyncError (FastForwardPushErrorNotFastForward path))
        -- The path from remote-to-local, excluding local, was empty. So, remote == local; there's nothing to push.
-        Just [] -> pure (Right ())
-        Just (_ : localInnerHashes0) -> do
-          -- drop remote hash
-          let localInnerHashes = map hash32ToCausalHash localInnerHashes0
-          doUpload (localHeadHash :| localInnerHashes) >>= \case
-            False -> pure (Left (FastForwardPushErrorNoWritePermission path))
-            True -> do
-              let doFastForwardPath =
-                    httpFastForwardPath
-                      httpClient
-                      unisonShareUrl
-                      Share.FastForwardPathRequest
-                        { expectedHash = remoteHeadHash,
-                          hashes =
-                            causalHashToHash32 <$> List.NonEmpty.fromList (localInnerHashes ++ [localHeadHash]),
-                          path
-                        }
-              doFastForwardPath <&> \case
-                Share.FastForwardPathSuccess -> Right ()
-                Share.FastForwardPathMissingDependencies (Share.NeedDependencies dependencies) ->
-                  Left (FastForwardPushErrorServerMissingDependencies dependencies)
-                -- Weird: someone must have force-pushed no history here, or something. We observed a history at
-                -- this path but moments ago!
-                Share.FastForwardPathNoHistory -> Left (FastForwardPushErrorNoHistory path)
-                Share.FastForwardPathNoWritePermission _ -> Left (FastForwardPushErrorNoWritePermission path)
-                Share.FastForwardPathNotFastForward _ -> Left (FastForwardPushErrorNotFastForward path)
-                Share.FastForwardPathInvalidParentage (Share.InvalidParentage parent child) ->
-                  Left (FastForwardPushInvalidParentage parent child)
-  where
-    doUpload :: List.NonEmpty CausalHash -> IO Bool
-    -- Maybe we could save round trips here by including the tail (or the head *and* the tail) as "extra hashes", but we
-    -- don't have that API yet. So, we only upload the head causal entity (which we don't even know for sure the server
-    -- doesn't have yet), and will (eventually) end up uploading the casuals in the tail that the server needs.
-    doUpload (headHash :| _tailHashes) =
-      uploadEntities
-        httpClient
-        unisonShareUrl
-        connect
-        (Share.pathRepoName path)
-        (NESet.singleton (causalHashToHash32 headHash))
-        uploadedCallback
+        Just [] -> succeeded
+        -- drop remote hash
+        Just (_ : localInnerHashes) -> pure (map hash32ToCausalHash localInnerHashes)
+
+    doUpload (localHeadHash :| localInnerHashes)
+
+    let doFastForwardPath :: Cli Share.FastForwardPathResponse
+        doFastForwardPath = do
+          Cli.Env {authHTTPClient} <- ask
+          let request =
+                httpFastForwardPath
+                  authHTTPClient
+                  unisonShareUrl
+                  Share.FastForwardPathRequest
+                    { expectedHash = remoteHeadHash,
+                      hashes =
+                        causalHashToHash32 <$> List.NonEmpty.fromList (localInnerHashes ++ [localHeadHash]),
+                      path
+                    }
+          liftIO request & onLeftM \err -> failed (TransportError err)
+
+    doFastForwardPath >>= \case
+      Share.FastForwardPathSuccess -> succeeded
+      Share.FastForwardPathMissingDependencies (Share.NeedDependencies dependencies) ->
+        failed (SyncError (FastForwardPushErrorServerMissingDependencies dependencies))
+      -- Weird: someone must have force-pushed no history here, or something. We observed a history at
+      -- this path but moments ago!
+      Share.FastForwardPathNoHistory -> failed (SyncError (FastForwardPushErrorNoHistory path))
+      Share.FastForwardPathNoWritePermission _ -> failed (SyncError (FastForwardPushErrorNoWritePermission path))
+      Share.FastForwardPathNotFastForward _ -> failed (SyncError (FastForwardPushErrorNotFastForward path))
+      Share.FastForwardPathInvalidParentage (Share.InvalidParentage parent child) ->
+        failed (SyncError (FastForwardPushInvalidParentage parent child))

 -- Return a list (in oldest-to-newest order) of hashes along the causal spine that connects the given arguments,
 -- excluding the newest hash (second argument).
@ -356,55 +383,82 @@ dagbfs goal children =
 ------------------------------------------------------------------------------------------------------------------------
 -- Pull

+data DownloadEntitiesError
+  = DownloadEntitiesNoReadPermission
+
 pull ::
-  -- | The HTTP client to use for Unison Share requests.
-  AuthenticatedHttpClient ->
  -- | The Unison Share URL.
  BaseUrl ->
-  -- | SQLite-connection-making function, for writing entities we pull.
-  (forall a. (Sqlite.Connection -> IO a) -> IO a) ->
  -- | The repo+path to pull from.
  Share.Path ->
  -- | Callback that's given a number of entities we just downloaded.
  (Int -> IO ()) ->
-  IO (Either (SyncError PullError) CausalHash)
-pull httpClient unisonShareUrl connect repoPath downloadedCallback = catchSyncErrors do
-  getCausalHashByPath httpClient unisonShareUrl repoPath >>= \case
-    Left err -> pure (Left (PullErrorGetCausalHashByPath err))
-    -- There's nothing at the remote path, so there's no causal to pull.
-    Right Nothing -> pure (Left (PullErrorNoHistoryAtPath repoPath))
-    Right (Just hashJwt) -> do
-      let hash = Share.hashJWTHash hashJwt
-      maybeTempEntities <-
-        connect \conn ->
-          Sqlite.runTransaction conn (Q.entityLocation hash) >>= \case
-            Just Q.EntityInMainStorage -> pure Nothing
-            Just Q.EntityInTempStorage -> pure (Just (NESet.singleton hash))
-            Nothing -> do
-              Share.DownloadEntitiesSuccess entities <-
+  Cli (Either (SyncError PullError) CausalHash)
+pull unisonShareUrl repoPath downloadedCallback = do
+  Cli.Env {authHTTPClient, codebase} <- ask
+
+  Cli.label \done -> do
+    let failed :: SyncError PullError -> Cli void
+        failed = done . Left
+
+    hashJwt <-
+      getCausalHashByPath unisonShareUrl repoPath >>= \case
+        Left err -> failed (getCausalHashByPathErrorToPullError <$> err)
+        -- There's nothing at the remote path, so there's no causal to pull.
+        Right Nothing -> failed (SyncError (PullErrorNoHistoryAtPath repoPath))
+        Right (Just hashJwt) -> pure hashJwt
+
+    let hash = Share.hashJWTHash hashJwt
+
+    maybeTempEntities <-
+      Cli.runTransaction (Q.entityLocation hash) >>= \case
+        Just Q.EntityInMainStorage -> pure Nothing
+        Just Q.EntityInTempStorage -> pure (Just (NESet.singleton hash))
+        Nothing -> do
+          let request =
                httpDownloadEntities
-                  httpClient
+                  authHTTPClient
                  unisonShareUrl
                  Share.DownloadEntitiesRequest {repoName, hashes = NESet.singleton hashJwt}
-              tempEntities <- insertEntities conn entities
-              downloadedCallback 1
-              pure (NESet.nonEmptySet tempEntities)
-      whenJust maybeTempEntities \tempEntities ->
-        completeTempEntities
-          httpClient
-          unisonShareUrl
-          connect
-          repoName
-          downloadedCallback
-          tempEntities
-      -- Since we may have just inserted and then deleted many temp entities, we attempt to recover some disk space by
-      -- vacuuming after each pull. If the vacuum fails due to another open transaction on this connection, that's ok,
-      -- we'll try vacuuming again next pull.
-      _success <- connect Sqlite.vacuum
-      pure (Right (hash32ToCausalHash hash))
+          entities <-
+            liftIO request >>= \case
+              Left err -> failed (TransportError err)
+              Right (Share.DownloadEntitiesNoReadPermission _) ->
+                failed (SyncError (PullErrorNoReadPermission repoPath))
+              Right (Share.DownloadEntitiesSuccess entities) -> pure entities
+          tempEntities <- Cli.runTransaction (insertEntities entities)
+          liftIO (downloadedCallback 1)
+          pure (NESet.nonEmptySet tempEntities)
+
+    whenJust maybeTempEntities \tempEntities -> do
+      let doCompleteTempEntities =
+            completeTempEntities
+              authHTTPClient
+              unisonShareUrl
+              ( \action ->
+                  Codebase.withConnection codebase \conn ->
+                    action (Sqlite.runTransaction conn)
+              )
+              repoName
+              downloadedCallback
+              tempEntities
+      liftIO doCompleteTempEntities & onLeftM \err ->
+        failed $
+          err <&> \case
+            DownloadEntitiesNoReadPermission -> PullErrorNoReadPermission repoPath
+
+    -- Since we may have just inserted and then deleted many temp entities, we attempt to recover some disk space by
+    -- vacuuming after each pull. If the vacuum fails due to another open transaction on this connection, that's ok,
+    -- we'll try vacuuming again next pull.
+    _success <- liftIO (Codebase.withConnection codebase Sqlite.vacuum)
+    pure (Right (hash32ToCausalHash hash))
  where
    repoName = Share.pathRepoName repoPath

+getCausalHashByPathErrorToPullError :: GetCausalHashByPathError -> PullError
+getCausalHashByPathErrorToPullError = \case
+  GetCausalHashByPathErrorNoReadPermission path -> PullErrorNoReadPermission path
+
 type WorkerCount =
  TVar Int

@ -423,20 +477,21 @@ recordNotWorking sem =
 -- What the dispatcher is to do
 data DispatcherJob
  = DispatcherForkWorker (NESet Share.HashJWT)
+  | DispatcherReturnEarlyBecauseDownloaderFailed (SyncError DownloadEntitiesError)
  | DispatcherDone

-- | Finish downloading entities from Unison Share. Returns the total number of entities downloaded.
+-- | Finish downloading entities from Unison Share (or return the first failure to download something).
 --
 -- Precondition: the entities were *already* downloaded at some point in the past, and are now sitting in the
 -- `temp_entity` table, waiting for their dependencies to arrive so they can be flushed to main storage.
 completeTempEntities ::
  AuthenticatedHttpClient ->
  BaseUrl ->
-  (forall a. (Sqlite.Connection -> IO a) -> IO a) ->
+  (forall a. ((forall x. Sqlite.Transaction x -> IO x) -> IO a) -> IO a) ->
  Share.RepoName ->
  (Int -> IO ()) ->
  NESet Hash32 ->
-  IO ()
+  IO (Either (SyncError DownloadEntitiesError) ())
 completeTempEntities httpClient unisonShareUrl connect repoName downloadedCallback initialNewTempEntities = do
  -- The set of hashes we still need to download
  hashesVar <- newTVarIO Set.empty
@ -453,34 +508,43 @@ completeTempEntities httpClient unisonShareUrl connect repoName downloadedCallba
  -- How many workers (downloader / inserter / elaborator) are currently doing stuff.
  workerCount <- newWorkerCount

+  -- The first download error seen by a downloader, if any.
+  downloaderFailedVar <- newEmptyTMVarIO
+
  -- Kick off the cycle of inserter->elaborator->dispatcher->downloader by giving the elaborator something to do
  atomically (writeTQueue newTempEntitiesQueue (Set.empty, Just initialNewTempEntities))

  Ki.scoped \scope -> do
    Ki.fork_ scope (inserter entitiesQueue newTempEntitiesQueue workerCount)
    Ki.fork_ scope (elaborator hashesVar uninsertedHashesVar newTempEntitiesQueue workerCount)
-    dispatcher hashesVar uninsertedHashesVar entitiesQueue newTempEntitiesQueue workerCount
+    dispatcher hashesVar uninsertedHashesVar entitiesQueue newTempEntitiesQueue workerCount downloaderFailedVar
  where
    -- Dispatcher thread: "dequeue" from `hashesVar`, fork one-shot downloaders.
    --
-    -- We stop when all of the following are true:
+    -- We stop when either all of the following are true:
    --
    --   - There are no outstanding workers (downloaders, inserter, elaboraror)
    --   - The inserter thread doesn't have any outstanding work enqueued (in `entitiesQueue`)
    --   - The elaborator thread doesn't have any outstanding work enqueued (in `newTempEntitiesQueue`)
+    --
+    -- Or:
+    --
+    --   - Some downloader failed to download something
    dispatcher ::
      TVar (Set Share.HashJWT) ->
      TVar (Set Share.HashJWT) ->
      TQueue (NESet Share.HashJWT, NEMap Hash32 (Share.Entity Text Hash32 Share.HashJWT)) ->
      TQueue (Set Share.HashJWT, Maybe (NESet Hash32)) ->
      WorkerCount ->
-      IO ()
-    dispatcher hashesVar uninsertedHashesVar entitiesQueue newTempEntitiesQueue workerCount =
+      TMVar (SyncError DownloadEntitiesError) ->
+      IO (Either (SyncError DownloadEntitiesError) ())
+    dispatcher hashesVar uninsertedHashesVar entitiesQueue newTempEntitiesQueue workerCount downloaderFailedVar =
      Ki.scoped \scope ->
-        let loop :: IO ()
+        let loop :: IO (Either (SyncError DownloadEntitiesError) ())
            loop =
-              atomically (dispatchWorkMode <|> checkIfDoneMode) >>= \case
-                DispatcherDone -> pure ()
+              atomically (checkIfDownloaderFailedMode <|> dispatchWorkMode <|> checkIfDoneMode) >>= \case
+                DispatcherDone -> pure (Right ())
+                DispatcherReturnEarlyBecauseDownloaderFailed err -> pure (Left err)
                DispatcherForkWorker hashes -> do
                  atomically do
                    -- Limit number of simultaneous downloaders (plus 2, for inserter and elaborator)
@ -491,10 +555,17 @@ completeTempEntities httpClient unisonShareUrl connect repoName downloadedCallba
                    -- nothing more for the dispatcher to do, when in fact a downloader thread just hasn't made it as
                    -- far as recording its own existence
                    recordWorking workerCount
-                  _ <- Ki.fork @() scope (downloader entitiesQueue workerCount hashes)
+                  _ <-
+                    Ki.fork @() scope do
+                      downloader entitiesQueue workerCount hashes & onLeftM \err ->
+                        void (atomically (tryPutTMVar downloaderFailedVar err))
                  loop
         in loop
      where
+        checkIfDownloaderFailedMode :: STM DispatcherJob
+        checkIfDownloaderFailedMode =
+          DispatcherReturnEarlyBecauseDownloaderFailed <$> readTMVar downloaderFailedVar
+
        dispatchWorkMode :: STM DispatcherJob
        dispatchWorkMode = do
          hashes <- readTVar hashesVar
@ -513,22 +584,26 @@ completeTempEntities httpClient unisonShareUrl connect repoName downloadedCallba
          isEmptyTQueue newTempEntitiesQueue >>= check
          pure DispatcherDone

-    -- Downloader thread: download entities, enqueue to `entitiesQueue`
+    -- Downloader thread: download entities, (if successful) enqueue to `entitiesQueue`
    downloader ::
      TQueue (NESet Share.HashJWT, NEMap Hash32 (Share.Entity Text Hash32 Share.HashJWT)) ->
      WorkerCount ->
      NESet Share.HashJWT ->
-      IO ()
+      IO (Either (SyncError DownloadEntitiesError) ())
    downloader entitiesQueue workerCount hashes = do
-      Share.DownloadEntitiesSuccess entities <-
-        httpDownloadEntities
-          httpClient
-          unisonShareUrl
-          Share.DownloadEntitiesRequest {repoName, hashes}
-      downloadedCallback (NESet.size hashes)
-      atomically do
-        writeTQueue entitiesQueue (hashes, entities)
-        recordNotWorking workerCount
+      httpDownloadEntities httpClient unisonShareUrl Share.DownloadEntitiesRequest {repoName, hashes} >>= \case
+        Left err -> do
+          atomically (recordNotWorking workerCount)
+          pure (Left (TransportError err))
+        Right (Share.DownloadEntitiesNoReadPermission _) -> do
+          atomically (recordNotWorking workerCount)
+          pure (Left (SyncError DownloadEntitiesNoReadPermission))
+        Right (Share.DownloadEntitiesSuccess entities) -> do
+          downloadedCallback (NESet.size hashes)
+          atomically do
+            writeTQueue entitiesQueue (hashes, entities)
+            recordNotWorking workerCount
+          pure (Right ())

    -- Inserter thread: dequeue from `entitiesQueue`, insert entities, enqueue to `newTempEntitiesQueue`
    inserter ::
@ -537,7 +612,7 @@ completeTempEntities httpClient unisonShareUrl connect repoName downloadedCallba
      WorkerCount ->
      IO Void
    inserter entitiesQueue newTempEntitiesQueue workerCount =
-      connect \conn ->
+      connect \runTransaction ->
        forever do
          (hashJwts, entities) <-
            atomically do
@ -545,7 +620,7 @@ completeTempEntities httpClient unisonShareUrl connect repoName downloadedCallba
              recordWorking workerCount
              pure entities
          newTempEntities0 <-
-            Sqlite.runTransaction conn do
+            runTransaction do
              NEMap.toList entities & foldMapM \(hash, entity) ->
                upsertEntitySomewhere hash entity <&> \case
                  Q.EntityInMainStorage -> Set.empty
@ -562,7 +637,7 @@ completeTempEntities httpClient unisonShareUrl connect repoName downloadedCallba
      WorkerCount ->
      IO Void
    elaborator hashesVar uninsertedHashesVar newTempEntitiesQueue workerCount =
-      connect \conn ->
+      connect \runTransaction ->
        forever do
          maybeNewTempEntities <-
            atomically do
@ -580,7 +655,7 @@ completeTempEntities httpClient unisonShareUrl connect repoName downloadedCallba
                  recordWorking workerCount
                  pure (Just newTempEntities)
          whenJust maybeNewTempEntities \newTempEntities -> do
-            newElaboratedHashes <- Sqlite.runTransaction conn (elaborateHashes newTempEntities)
+            newElaboratedHashes <- runTransaction (elaborateHashes newTempEntities)
            atomically do
              uninsertedHashes <- readTVar uninsertedHashesVar
              hashes0 <- readTVar hashesVar
@ -589,85 +664,99 @@ completeTempEntities httpClient unisonShareUrl connect repoName downloadedCallba

 -- | Insert entities into the database, and return the subset that went into temp storage (`temp_entitiy`) rather than
 -- of main storage (`object` / `causal`) due to missing dependencies.
-insertEntities :: Sqlite.Connection -> NEMap Hash32 (Share.Entity Text Hash32 Share.HashJWT) -> IO (Set Hash32)
-insertEntities conn entities =
-  Sqlite.runTransaction conn do
-    NEMap.toList entities & foldMapM \(hash, entity) ->
-      upsertEntitySomewhere hash entity <&> \case
-        Q.EntityInMainStorage -> Set.empty
-        Q.EntityInTempStorage -> Set.singleton hash
+insertEntities :: NEMap Hash32 (Share.Entity Text Hash32 Share.HashJWT) -> Sqlite.Transaction (Set Hash32)
+insertEntities entities =
+  NEMap.toList entities & foldMapM \(hash, entity) ->
+    upsertEntitySomewhere hash entity <&> \case
+      Q.EntityInMainStorage -> Set.empty
+      Q.EntityInTempStorage -> Set.singleton hash

 ------------------------------------------------------------------------------------------------------------------------
 -- Get causal hash by path

 -- | Get the causal hash of a path hosted on Unison Share.
 getCausalHashByPath ::
-  -- | The HTTP client to use for Unison Share requests.
-  AuthenticatedHttpClient ->
  -- | The Unison Share URL.
  BaseUrl ->
  Share.Path ->
-  IO (Either GetCausalHashByPathError (Maybe Share.HashJWT))
-getCausalHashByPath httpClient unisonShareUrl repoPath =
-  httpGetCausalHashByPath httpClient unisonShareUrl (Share.GetCausalHashByPathRequest repoPath) <&> \case
-    Share.GetCausalHashByPathSuccess maybeHashJwt -> Right maybeHashJwt
-    Share.GetCausalHashByPathNoReadPermission _ -> Left (GetCausalHashByPathErrorNoReadPermission repoPath)
+  Cli (Either (SyncError GetCausalHashByPathError) (Maybe Share.HashJWT))
+getCausalHashByPath unisonShareUrl repoPath = do
+  Cli.Env {authHTTPClient} <- ask
+  liftIO (httpGetCausalHashByPath authHTTPClient unisonShareUrl (Share.GetCausalHashByPathRequest repoPath)) <&> \case
+    Left err -> Left (TransportError err)
+    Right (Share.GetCausalHashByPathSuccess maybeHashJwt) -> Right maybeHashJwt
+    Right (Share.GetCausalHashByPathNoReadPermission _) ->
+      Left (SyncError (GetCausalHashByPathErrorNoReadPermission repoPath))

 ------------------------------------------------------------------------------------------------------------------------
 -- Upload entities

 data UploadDispatcherJob
-  = UploadDispatcherReturnFailure
+  = UploadDispatcherReturnFailure (SyncError UploadEntitiesError)
  | UploadDispatcherForkWorkerWhenAvailable (NESet Hash32)
  | UploadDispatcherForkWorker (NESet Hash32)
  | UploadDispatcherDone

+data UploadEntitiesError
+  = UploadEntitiesNoWritePermission
+
 -- | Upload a set of entities to Unison Share. If the server responds that it cannot yet store any hash(es) due to
 -- missing dependencies, send those dependencies too, and on and on, until the server stops responding that it's missing
 -- anything.
 --
 -- Returns true on success, false on failure (because the user does not have write permission).
 uploadEntities ::
-  AuthenticatedHttpClient ->
  BaseUrl ->
-  (forall a. (Sqlite.Connection -> IO a) -> IO a) ->
  Share.RepoName ->
  NESet Hash32 ->
  (Int -> IO ()) ->
-  IO Bool
-uploadEntities httpClient unisonShareUrl connect repoName hashes0 uploadedCallback = do
-  hashesVar <- newTVarIO (NESet.toSet hashes0)
-  -- Semantically, this is the set of hashes we've uploaded so far, but we do delete from it when it's safe to, so it
-  -- doesn't grow unbounded. It's used to filter out hashes that would be duplicate uploads: the server, when responding
-  -- to any particular upload request, may declare that it still needs some hashes that we're in the process of
-  -- uploading from another thread.
-  dedupeVar <- newTVarIO Set.empty
-  nextWorkerIdVar <- newTVarIO 0
-  workersVar <- newTVarIO Set.empty
-  workerFailedVar <- newEmptyTMVarIO
+  Cli (Either (SyncError UploadEntitiesError) ())
+uploadEntities unisonShareUrl repoName hashes0 uploadedCallback = do
+  Cli.Env {authHTTPClient, codebase} <- ask

-  Ki.scoped \scope ->
-    dispatcher scope hashesVar dedupeVar nextWorkerIdVar workersVar workerFailedVar
+  liftIO do
+    hashesVar <- newTVarIO (NESet.toSet hashes0)
+    -- Semantically, this is the set of hashes we've uploaded so far, but we do delete from it when it's safe to, so it
+    -- doesn't grow unbounded. It's used to filter out hashes that would be duplicate uploads: the server, when
+    -- responding to any particular upload request, may declare that it still needs some hashes that we're in the
+    -- process of uploading from another thread.
+    dedupeVar <- newTVarIO Set.empty
+    nextWorkerIdVar <- newTVarIO 0
+    workersVar <- newTVarIO Set.empty
+    workerFailedVar <- newEmptyTMVarIO
+
+    Ki.scoped \scope ->
+      dispatcher
+        scope
+        authHTTPClient
+        (Codebase.runTransaction codebase)
+        hashesVar
+        dedupeVar
+        nextWorkerIdVar
+        workersVar
+        workerFailedVar
  where
    dispatcher ::
      Ki.Scope ->
+      AuthenticatedHttpClient ->
+      (forall a. Sqlite.Transaction a -> IO a) ->
      TVar (Set Hash32) ->
      TVar (Set Hash32) ->
      TVar Int ->
      TVar (Set Int) ->
-      TMVar () ->
-      IO Bool
-    dispatcher scope hashesVar dedupeVar nextWorkerIdVar workersVar workerFailedVar = do
+      TMVar (SyncError UploadEntitiesError) ->
+      IO (Either (SyncError UploadEntitiesError) ())
+    dispatcher scope httpClient runTransaction hashesVar dedupeVar nextWorkerIdVar workersVar workerFailedVar = do
      loop
      where
-        loop :: IO Bool
+        loop :: IO (Either (SyncError UploadEntitiesError) ())
        loop =
          doJob [checkForFailureMode, dispatchWorkMode, checkIfDoneMode]

-        doJob :: [STM UploadDispatcherJob] -> IO Bool
+        doJob :: [STM UploadDispatcherJob] -> IO (Either (SyncError UploadEntitiesError) ())
        doJob jobs =
          atomically (asum jobs) >>= \case
-            UploadDispatcherReturnFailure -> pure False
+            UploadDispatcherReturnFailure err -> pure (Left err)
            UploadDispatcherForkWorkerWhenAvailable hashes -> doJob [forkWorkerMode hashes, checkForFailureMode]
            UploadDispatcherForkWorker hashes -> do
              workerId <-
@ -678,14 +767,14 @@ uploadEntities httpClient unisonShareUrl connect repoName hashes0 uploadedCallba
                  pure workerId
              _ <-
                Ki.fork @() scope do
-                  worker hashesVar dedupeVar workersVar workerFailedVar workerId hashes
+                  worker httpClient runTransaction hashesVar dedupeVar workersVar workerFailedVar workerId hashes
              loop
-            UploadDispatcherDone -> pure True
+            UploadDispatcherDone -> pure (Right ())

        checkForFailureMode :: STM UploadDispatcherJob
        checkForFailureMode = do
-          () <- readTMVar workerFailedVar
-          pure UploadDispatcherReturnFailure
+          err <- readTMVar workerFailedVar
+          pure (UploadDispatcherReturnFailure err)

        dispatchWorkMode :: STM UploadDispatcherJob
        dispatchWorkMode = do
@ -708,25 +797,35 @@ uploadEntities httpClient unisonShareUrl connect repoName hashes0 uploadedCallba
          when (not (Set.null workers)) retry
          pure UploadDispatcherDone

-    worker :: TVar (Set Hash32) -> TVar (Set Hash32) -> TVar (Set Int) -> TMVar () -> Int -> NESet Hash32 -> IO ()
-    worker hashesVar dedupeVar workersVar workerFailedVar workerId hashes = do
+    worker ::
+      AuthenticatedHttpClient ->
+      (forall a. Sqlite.Transaction a -> IO a) ->
+      TVar (Set Hash32) ->
+      TVar (Set Hash32) ->
+      TVar (Set Int) ->
+      TMVar (SyncError UploadEntitiesError) ->
+      Int ->
+      NESet Hash32 ->
+      IO ()
+    worker httpClient runTransaction hashesVar dedupeVar workersVar workerFailedVar workerId hashes = do
      entities <-
        fmap NEMap.fromAscList do
-          connect \conn ->
-            Sqlite.runTransaction conn do
-              for (NESet.toAscList hashes) \hash -> do
-                entity <- expectEntity hash
-                pure (hash, entity)
+          runTransaction do
+            for (NESet.toAscList hashes) \hash -> do
+              entity <- expectEntity hash
+              pure (hash, entity)

      result <-
        httpUploadEntities httpClient unisonShareUrl Share.UploadEntitiesRequest {entities, repoName} <&> \case
-          Share.UploadEntitiesNeedDependencies (Share.NeedDependencies moreHashes) -> Right (NESet.toSet moreHashes)
-          Share.UploadEntitiesNoWritePermission _ -> Left ()
-          Share.UploadEntitiesHashMismatchForEntity _ -> error "hash mismatch; fixme"
-          Share.UploadEntitiesSuccess -> Right Set.empty
+          Left err -> Left (TransportError err)
+          Right (Share.UploadEntitiesNeedDependencies (Share.NeedDependencies moreHashes)) ->
+            Right (NESet.toSet moreHashes)
+          Right (Share.UploadEntitiesNoWritePermission _) -> Left (SyncError UploadEntitiesNoWritePermission)
+          Right (Share.UploadEntitiesHashMismatchForEntity _) -> error "hash mismatch; fixme"
+          Right Share.UploadEntitiesSuccess -> Right Set.empty

      case result of
-        Left () -> void (atomically (tryPutTMVar workerFailedVar ()))
+        Left err -> void (atomically (tryPutTMVar workerFailedVar err))
        Right moreHashes -> do
          uploadedCallback (NESet.size hashes)
          maybeYoungestWorkerThatWasAlive <-
@ -815,11 +914,31 @@ upsertEntitySomewhere hash entity =
 ------------------------------------------------------------------------------------------------------------------------
 -- HTTP calls

-httpGetCausalHashByPath :: Auth.AuthenticatedHttpClient -> BaseUrl -> Share.GetCausalHashByPathRequest -> IO Share.GetCausalHashByPathResponse
-httpFastForwardPath :: Auth.AuthenticatedHttpClient -> BaseUrl -> Share.FastForwardPathRequest -> IO Share.FastForwardPathResponse
-httpUpdatePath :: Auth.AuthenticatedHttpClient -> BaseUrl -> Share.UpdatePathRequest -> IO Share.UpdatePathResponse
-httpDownloadEntities :: Auth.AuthenticatedHttpClient -> BaseUrl -> Share.DownloadEntitiesRequest -> IO Share.DownloadEntitiesResponse
-httpUploadEntities :: Auth.AuthenticatedHttpClient -> BaseUrl -> Share.UploadEntitiesRequest -> IO Share.UploadEntitiesResponse
+httpGetCausalHashByPath ::
+  Auth.AuthenticatedHttpClient ->
+  BaseUrl ->
+  Share.GetCausalHashByPathRequest ->
+  IO (Either CodeserverTransportError Share.GetCausalHashByPathResponse)
+httpFastForwardPath ::
+  Auth.AuthenticatedHttpClient ->
+  BaseUrl ->
+  Share.FastForwardPathRequest ->
+  IO (Either CodeserverTransportError Share.FastForwardPathResponse)
+httpUpdatePath ::
+  Auth.AuthenticatedHttpClient ->
+  BaseUrl ->
+  Share.UpdatePathRequest ->
+  IO (Either CodeserverTransportError Share.UpdatePathResponse)
+httpDownloadEntities ::
+  Auth.AuthenticatedHttpClient ->
+  BaseUrl ->
+  Share.DownloadEntitiesRequest ->
+  IO (Either CodeserverTransportError Share.DownloadEntitiesResponse)
+httpUploadEntities ::
+  Auth.AuthenticatedHttpClient ->
+  BaseUrl ->
+  Share.UploadEntitiesRequest ->
+  IO (Either CodeserverTransportError Share.UploadEntitiesResponse)
 ( httpGetCausalHashByPath,
  httpFastForwardPath,
  httpUpdatePath,
@ -843,14 +962,14 @@ httpUploadEntities :: Auth.AuthenticatedHttpClient -> BaseUrl -> Share.UploadEnt
          go httpUploadEntities
        )
    where
-      hoist :: Servant.ClientM a -> ReaderT Servant.ClientEnv IO a
+      hoist :: Servant.ClientM a -> ReaderT Servant.ClientEnv (ExceptT CodeserverTransportError IO) a
      hoist m = do
        clientEnv <- Reader.ask
        liftIO (Servant.runClientM m clientEnv) >>= \case
          Right a -> pure a
          Left err -> do
            Debug.debugLogM Debug.Sync (show err)
-            throwIO case err of
+            throwError case err of
              Servant.FailureResponse _req resp ->
                case HTTP.statusCode $ Servant.responseStatusCode resp of
                  401 -> Unauthenticated (Servant.baseUrl clientEnv)
@ -867,25 +986,18 @@ httpUploadEntities :: Auth.AuthenticatedHttpClient -> BaseUrl -> Share.UploadEnt
              Servant.ConnectionError _ -> UnreachableCodeserver (Servant.baseUrl clientEnv)

      go ::
-        (req -> ReaderT Servant.ClientEnv IO resp) ->
+        (req -> ReaderT Servant.ClientEnv (ExceptT CodeserverTransportError IO) resp) ->
        Auth.AuthenticatedHttpClient ->
        BaseUrl ->
        req ->
-        IO resp
+        IO (Either CodeserverTransportError resp)
      go f (Auth.AuthenticatedHttpClient httpClient) unisonShareUrl req =
-        runReaderT
-          (f req)
-          (Servant.mkClientEnv httpClient unisonShareUrl)
-            { Servant.makeClientRequest = \url request ->
-                -- Disable client-side timeouts
-                (Servant.defaultMakeClientRequest url request)
-                  { Http.Client.responseTimeout = Http.Client.responseTimeoutNone
-                  }
-            }
-
-catchSyncErrors :: IO (Either e a) -> IO (Either (SyncError e) a)
-catchSyncErrors action =
-  UnliftIO.try @_ @CodeserverTransportError action >>= \case
-    Left te -> pure (Left . TransportError $ te)
-    Right (Left e) -> pure . Left . SyncError $ e
-    Right (Right a) -> pure $ Right a
+        (Servant.mkClientEnv httpClient unisonShareUrl)
+          { Servant.makeClientRequest = \url request ->
+              -- Disable client-side timeouts
+              (Servant.defaultMakeClientRequest url request)
+                { Http.Client.responseTimeout = Http.Client.responseTimeoutNone
+                }
+          }
+          & runReaderT (f req)
+          & runExceptT
--- a/unison-cli/src/Unison/Share/Sync/Types.hs
+++ b/unison-cli/src/Unison/Share/Sync/Types.hs
@ -1,7 +1,13 @@
-{-# LANGUAGE DeriveAnyClass #-}
-
 -- | Types used by the UCM client during sync.
-module Unison.Share.Sync.Types where
+module Unison.Share.Sync.Types
+  ( CheckAndSetPushError (..),
+    CodeserverTransportError (..),
+    FastForwardPushError (..),
+    GetCausalHashByPathError (..),
+    PullError (..),
+    SyncError (..),
+  )
+where

 import Data.Set.NonEmpty (NESet)
 import qualified Servant.Client as Servant
@ -29,9 +35,8 @@ data FastForwardPushError

 -- | An error occurred while pulling code from Unison Share.
 data PullError
-  = -- | An error occurred while resolving a repo+path to a causal hash.
-    PullErrorGetCausalHashByPath GetCausalHashByPathError
-  | PullErrorNoHistoryAtPath Share.Path
+  = PullErrorNoHistoryAtPath Share.Path
+  | PullErrorNoReadPermission Share.Path
  deriving (Show)

 -- | An error occurred when getting causal hash by path.
@ -57,3 +62,4 @@ data CodeserverTransportError
 data SyncError e
  = TransportError CodeserverTransportError
  | SyncError e
+  deriving stock (Functor)
--- a/unison-core/src/Unison/ABT/Normalized.hs
+++ b/unison-core/src/Unison/ABT/Normalized.hs
@ -12,6 +12,8 @@
 module Unison.ABT.Normalized
  ( ABT (..),
    Term (.., TAbs, TTm, TAbss),
+    Align (..),
+    alpha,
    renames,
    rename,
    transform,
@ -20,6 +22,7 @@ where

 import Data.Bifoldable
 import Data.Bifunctor
+import Data.Foldable (toList)
 -- import Data.Bitraversable

 import Data.Map.Strict (Map)
@ -58,6 +61,22 @@ instance
  showsPrec p (Term _ e) =
    showParen (p >= 9) $ showString "Term " . showsPrec 10 e

+instance
+  (forall a b. Eq a => Eq b => Eq (f a b), Bifunctor f, Bifoldable f, Var v) =>
+  Eq (ABT f v)
+  where
+  Abs v1 e1 == Abs v2 e2
+    | v1 == v2 = e1 == e2
+    | otherwise = e1 == rename v2 v1 e2
+  Tm e1 == Tm e2 = e1 == e2
+  _ == _ = False
+
+instance
+  (forall a b. Eq a => Eq b => Eq (f a b), Bifunctor f, Bifoldable f, Var v) =>
+  Eq (Term f v)
+  where
+  Term _ abt1 == Term _ abt2 = abt1 == abt2
+
 pattern TAbs :: Var v => v -> Term f v -> Term f v
 pattern TAbs u bd <-
  Term _ (Abs u bd)
@ -72,6 +91,35 @@ pattern TTm bd <-

 {-# COMPLETE TAbs, TTm #-}

+class (Bifoldable f, Bifunctor f) => Align f where
+  align ::
+    Applicative g =>
+    (vl -> vr -> g vs) ->
+    (el -> er -> g es) ->
+    f vl el ->
+    f vr er ->
+    Maybe (g (f vs es))
+
+alphaErr ::
+  Align f => Var v => Map v v -> Term f v -> Term f v -> Either (Term f v, Term f v) a
+alphaErr un tml tmr = Left (tml, renames count un tmr)
+  where
+    count = Map.fromListWith (+) . flip zip [1, 1 ..] $ toList un
+
+-- Checks if two terms are equal up to a given variable renaming. The
+-- renaming should map variables in the right hand term to the
+-- equivalent variable in the left hand term.
+alpha :: Align f => Var v => Map v v -> Term f v -> Term f v -> Either (Term f v, Term f v) ()
+alpha un (TAbs u tml) (TAbs v tmr) =
+  alpha (Map.insert v u (Map.filter (/= u) un)) tml tmr
+alpha un tml@(TTm bdl) tmr@(TTm bdr)
+  | Just sub <- align av (alpha un) bdl bdr = () <$ sub
+  where
+    av u v
+      | maybe False (== u) (Map.lookup v un) = pure ()
+      | otherwise = alphaErr un tml tmr
+alpha un tml tmr = alphaErr un tml tmr
+
 unabss :: Var v => Term f v -> ([v], Term f v)
 unabss (TAbs v (unabss -> (vs, bd))) = (v : vs, bd)
 unabss bd = ([], bd)
--- a/unison-core/src/Unison/Names.hs
+++ b/unison-core/src/Unison/Names.hs
@ -29,6 +29,7 @@ module Unison.Names
    prefix0,
    restrictReferences,
    refTermsNamed,
+    refTermsHQNamed,
    termReferences,
    termReferents,
    typeReferences,
@ -71,6 +72,7 @@ import qualified Unison.ShortHash as SH
 import Unison.Util.Relation (Relation)
 import qualified Unison.Util.Relation as R
 import qualified Unison.Util.Relation as Relation
+import qualified Unison.Util.Set as Set (mapMaybe)
 import Prelude hiding (filter, map)
 import qualified Prelude

@ -249,9 +251,23 @@ numHashChars = 3
 termsNamed :: Names -> Name -> Set Referent
 termsNamed = flip R.lookupDom . terms

+-- | Get all terms with a specific name.
 refTermsNamed :: Names -> Name -> Set TermReference
 refTermsNamed names n =
-  Set.fromList [r | Referent.Ref r <- toList $ termsNamed names n]
+  Set.mapMaybe Referent.toTermReference (termsNamed names n)
+
+-- | Get all terms with a specific hash-qualified name.
+refTermsHQNamed :: Names -> HQ.HashQualified Name -> Set TermReference
+refTermsHQNamed names = \case
+  HQ.NameOnly name -> refTermsNamed names name
+  HQ.HashOnly _hash -> Set.empty
+  HQ.HashQualified name hash ->
+    let f :: Referent -> Maybe TermReference
+        f ref0 = do
+          ref <- Referent.toTermReference ref0
+          guard (Reference.isPrefixOf hash ref)
+          Just ref
+     in Set.mapMaybe f (termsNamed names name)

 typesNamed :: Names -> Name -> Set TypeReference
 typesNamed = flip R.lookupDom . types
--- a/unison-core/src/Unison/Term.hs
+++ b/unison-core/src/Unison/Term.hs
@ -116,6 +116,11 @@ _TermLink = _Ctor @"TermLink"
 _TypeLink :: Prism' (F tv ta pa a) Reference
 _TypeLink = _Ctor @"TypeLink"

+-- | Returns the top-level type annotation for a term if it has one.
+getTypeAnnotation :: Term v a -> Maybe (Type v a)
+getTypeAnnotation (ABT.Tm' (Ann _ t)) = Just t
+getTypeAnnotation _ = Nothing
+
 type IsTop = Bool

 -- | Like `Term v`, but with an annotation of type `a` at every level in the tree
--- a/unison-core/src/Unison/WatchKind.hs
+++ b/unison-core/src/Unison/WatchKind.hs
@ -1,7 +1,4 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE ViewPatterns #-}

 module Unison.WatchKind where

--- a/unison-share-api/src/Unison/Server/Backend.hs
+++ b/unison-share-api/src/Unison/Server/Backend.hs
@ -701,7 +701,7 @@ makeNameSearch hashLength names =
    }

 -- | Interpret a 'Search' as a function from name to search results.
-applySearch :: (Show r) => Search r -> HQ'.HashQualified Name -> [SR.SearchResult]
+applySearch :: Show r => Search r -> HQ'.HashQualified Name -> [SR.SearchResult]
 applySearch Search {lookupNames, lookupRelativeHQRefs', makeResult, matchesNamedRef} query = do
  -- a bunch of references will match a HQ ref.
  toList (lookupRelativeHQRefs' query) <&> \ref ->
@ -778,9 +778,9 @@ hqNameQuery codebase NameSearch {typeSearch, termSearch} hqs = do
      }

 -- TODO: Move this to its own module
-data DefinitionResults v = DefinitionResults
-  { termResults :: Map Reference (DisplayObject (Type v Ann) (Term v Ann)),
-    typeResults :: Map Reference (DisplayObject () (DD.Decl v Ann)),
+data DefinitionResults = DefinitionResults
+  { termResults :: Map Reference (DisplayObject (Type Symbol Ann) (Term Symbol Ann)),
+    typeResults :: Map Reference (DisplayObject () (DD.Decl Symbol Ann)),
    noResults :: [HQ.HashQualified Name]
  }

@ -1204,7 +1204,7 @@ definitionsBySuffixes ::
  NameSearch ->
  IncludeCycles ->
  [HQ.HashQualified Name] ->
-  Sqlite.Transaction (DefinitionResults Symbol)
+  Sqlite.Transaction DefinitionResults
 definitionsBySuffixes codebase nameSearch includeCycles query = do
  QueryResult misses results <- hqNameQuery codebase nameSearch query
  -- todo: remember to replace this with getting components directly,
--- a/unison-share-api/src/Unison/Server/Types.hs
+++ b/unison-share-api/src/Unison/Server/Types.hs
@ -1,10 +1,5 @@
 {-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DerivingVia #-}
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE StandaloneDeriving #-}

 module Unison.Server.Types where

--- a/unison-src/transcripts-using-base/all-base-hashes.md
+++ b/unison-src/transcripts-using-base/all-base-hashes.md
@ -0,0 +1,5 @@
+This transcript is intended to make visible accidental changes to the hashing algorithm.
+
+```ucm
+.> find.verbose
+```
--- a/unison-src/transcripts-using-base/all-base-hashes.output.md
+++ b/unison-src/transcripts-using-base/all-base-hashes.output.md
--- a/unison-src/transcripts/diff-namespace-to-patch.md
+++ b/unison-src/transcripts/diff-namespace-to-patch.md
@ -39,6 +39,5 @@ A summary of the diff:
 * `one.a` -> `two.a` is a normal update.
 * Even though `one.b` is conflicted, both `one.b#hash1` and `one.b#hash2` get mapped to `two.b`.
 * Because `two.c` is conflicted, `one.c` doesn't end up on the left-hand side of the patch.
-* Oops, a similar case slipped by - `one.d` and `one.e` map to `two.d` and `two.e` respectively, but because `one.d` and
-  `one.e` were aliases, we end up with a busted patch that isn't a function. This is a bug.
+* Because `one.d` and `one.e` are aliases, they don't end up on the left-hand side of the patch.
 * Neither `one.f` nor `two.g` end up in the patch because the names `f` and `g` are not common to both namespaces.
--- a/unison-src/transcripts/diff-namespace-to-patch.output.md
+++ b/unison-src/transcripts/diff-namespace-to-patch.output.md
@ -39,11 +39,9 @@ two.e = 6
 .> diff.namespace.to-patch one two thepatch

  Edited Terms:
-    1. one.b#cp6ri8mtg0 -> 6. two.b
-    2. one.b#dcgdua2lj6 -> 7. two.b
-    3. one.a            -> 8. two.a
-    4. one.d            -> 9. two.d
-    5. one.d            -> 10. two.e
+    1. one.b#cp6ri8mtg0 -> 4. two.b
+    2. one.b#dcgdua2lj6 -> 5. two.b
+    3. one.a            -> 6. two.a
  
  Tip: To remove entries from a patch, use
       delete.term-replacement or delete.type-replacement, as
@ -55,6 +53,5 @@ A summary of the diff:
 * `one.a` -> `two.a` is a normal update.
 * Even though `one.b` is conflicted, both `one.b#hash1` and `one.b#hash2` get mapped to `two.b`.
 * Because `two.c` is conflicted, `one.c` doesn't end up on the left-hand side of the patch.
-* Oops, a similar case slipped by - `one.d` and `one.e` map to `two.d` and `two.e` respectively, but because `one.d` and
-  `one.e` were aliases, we end up with a busted patch that isn't a function. This is a bug.
+* Because `one.d` and `one.e` are aliases, they don't end up on the left-hand side of the patch.
 * Neither `one.f` nor `two.g` end up in the patch because the names `f` and `g are not common to both namespaces.