Merge remote-tracking branch 'upstream/trunk' into optional-numbered-…

…args

.github/workflows/ci-test-jit.yaml

@@ -77,7 +77,7 @@ jobs:
           key: jit-test-results.dist-exe_${{ hashFiles(env.jit_dist_rel_exe) }}.tests_${{ env.runtime_tests_causalhash }}.yaml_${{ hashFiles('**/ci-test-jit.yaml') }}
 
       - name: install libb2 (linux)
-        uses: awalsh128/cache-apt-pkgs-action@latest
+        uses: awalsh128/cache-apt-pkgs-action@5902b33ae29014e6ca012c5d8025d4346556bd40 #v1.4.3
         if: runner.os == 'Linux' && steps.cache-jit-test-results.outputs.cache-hit != 'true'
         with:
           packages: libb2-1

.gitignore

@@ -27,6 +27,7 @@ dist-newstyle
 *.prof.html
 *.hp
 *.ps
+*.profiterole.*
 /.direnv/
 /.envrc
 

codebase2/codebase-sqlite/U/Codebase/Sqlite/Branch/Format.hs

@@ -101,7 +101,7 @@ data BranchLocalIds' t d p c = LocalIds
     branchPatchLookup :: Vector p,
     branchChildLookup :: Vector c
   }
-  deriving (Show)
+  deriving (Show, Eq)
 
 -- | Bytes encoding a LocalBranch
 newtype LocalBranchBytes = LocalBranchBytes ByteString
@@ -110,6 +110,7 @@ newtype LocalBranchBytes = LocalBranchBytes ByteString
 data SyncBranchFormat' parent text defn patch child
   = SyncFull (BranchLocalIds' text defn patch child) LocalBranchBytes
   | SyncDiff parent (BranchLocalIds' text defn patch child) LocalBranchBytes
+  deriving (Eq, Show)
 
 type SyncBranchFormat = SyncBranchFormat' BranchObjectId TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)
 

codebase2/codebase-sqlite/U/Codebase/Sqlite/Causal.hs

@@ -22,5 +22,6 @@ data SyncCausalFormat' causalHash valueHash = SyncCausalFormat
   { valueHash :: valueHash,
     parents :: Vector causalHash
   }
+  deriving stock (Eq, Show)
 
 type SyncCausalFormat = SyncCausalFormat' CausalHashId BranchHashId

codebase2/codebase-sqlite/U/Codebase/Sqlite/Decl/Format.hs

@@ -36,9 +36,11 @@ type SyncDeclFormat =
 
 data SyncDeclFormat' t d
   = SyncDecl (SyncLocallyIndexedComponent' t d)
+  deriving stock (Eq, Show)
 
 newtype SyncLocallyIndexedComponent' t d
   = SyncLocallyIndexedComponent (Vector (LocalIds' t d, ByteString))
+  deriving stock (Eq, Show)
 
 -- [OldDecl] ==map==> [NewDecl] ==number==> [(NewDecl, Int)] ==sort==> [(NewDecl, Int)] ==> permutation is map snd of that
 

codebase2/codebase-sqlite/U/Codebase/Sqlite/Entity.hs

@@ -24,6 +24,7 @@ data SyncEntity' text hash defn patch branchh branch causal
   | N (Namespace.SyncBranchFormat' branch text defn patch (branch, causal))
   | P (Patch.SyncPatchFormat' patch text hash defn)
   | C (Causal.SyncCausalFormat' causal branchh)
+  deriving stock (Eq, Show)
 
 entityType :: SyncEntity' text hash defn patch branchh branch causal -> TempEntityType
 entityType = \case

codebase2/codebase-sqlite/U/Codebase/Sqlite/LocalIds.hs

@@ -15,7 +15,7 @@ data LocalIds' t h = LocalIds
   { textLookup :: Vector t,
     defnLookup :: Vector h
   }
-  deriving (Functor, Show)
+  deriving stock (Functor, Show, Eq)
 
 type LocalIds = LocalIds' TextId ObjectId
 

codebase2/codebase-sqlite/U/Codebase/Sqlite/Patch/Format.hs

@@ -40,13 +40,15 @@ data PatchLocalIds' t h d = LocalIds
     patchHashLookup :: Vector h,
     patchDefnLookup :: Vector d
   }
+  deriving stock (Eq, Show)
 
 type SyncPatchFormat = SyncPatchFormat' PatchObjectId TextId HashId ObjectId
 
 data SyncPatchFormat' parent text hash defn
   = SyncFull (PatchLocalIds' text hash defn) ByteString
   | -- | p is the identity of the thing that the diff is relative to
     SyncDiff parent (PatchLocalIds' text hash defn) ByteString
+  deriving stock (Eq, Show)
 
 -- | Apply a list of patch diffs to a patch, left to right.
 applyPatchDiffs :: Patch -> [PatchDiff] -> Patch

codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs

@@ -111,6 +111,7 @@ module U.Codebase.Sqlite.Queries
     loadProjectByName,
     expectProject,
     loadAllProjects,
+    loadAllProjectsByRecentlyAccessed,
     loadAllProjectsBeginningWith,
     insertProject,
     renameProject,
@@ -256,6 +257,7 @@ module U.Codebase.Sqlite.Queries
     addCurrentProjectPathTable,
     addProjectBranchReflogTable,
     addProjectBranchCausalHashIdColumn,
+    addProjectBranchLastAccessedColumn,
 
     -- ** schema version
     currentSchemaVersion,
@@ -420,7 +422,7 @@ type TextPathSegments = [Text]
 -- * main squeeze
 
 currentSchemaVersion :: SchemaVersion
-currentSchemaVersion = 17
+currentSchemaVersion = 18
 
 runCreateSql :: Transaction ()
 runCreateSql =
@@ -486,6 +488,10 @@ addProjectBranchCausalHashIdColumn :: Transaction ()
 addProjectBranchCausalHashIdColumn =
   executeStatements $(embedProjectStringFile "sql/014-add-project-branch-causal-hash-id.sql")
 
+addProjectBranchLastAccessedColumn :: Transaction ()
+addProjectBranchLastAccessedColumn =
+  executeStatements $(embedProjectStringFile "sql/015-add-project-branch-last-accessed.sql")
+
 schemaVersion :: Transaction SchemaVersion
 schemaVersion =
   queryOneCol
@@ -2274,32 +2280,6 @@ globEscape =
     ']' -> "[]]"
     c -> Text.singleton c
 
--- | Escape special characters for "LIKE" matches.
---
--- Prepared statements prevent sql injection, but it's still possible some user
--- may be able to craft a query using a fake "hash" that would let them see more than they
--- ought to.
---
--- You still need to provide the escape char in the sql query, E.g.
---
--- @@
---   SELECT * FROM table
---     WHERE txt LIKE ? ESCAPE '\'
--- @@
---
--- >>> likeEscape '\\' "Nat.%"
--- "Nat.\%"
-likeEscape :: Char -> Text -> Text
-likeEscape '%' _ = error "Can't use % or _ as escape characters"
-likeEscape '_' _ = error "Can't use % or _ as escape characters"
-likeEscape escapeChar pat =
-  flip Text.concatMap pat \case
-    '%' -> Text.pack [escapeChar, '%']
-    '_' -> Text.pack [escapeChar, '_']
-    c
-      | c == escapeChar -> Text.pack [escapeChar, escapeChar]
-      | otherwise -> Text.singleton c
-
 -- | NOTE: requires that the codebase has an up-to-date name lookup index. As of writing, this
 -- is only true on Share.
 --
@@ -3623,6 +3603,17 @@ loadAllProjects =
       ORDER BY name ASC
     |]
 
+-- | Load all projects.
+loadAllProjectsByRecentlyAccessed :: Transaction [Project]
+loadAllProjectsByRecentlyAccessed =
+  queryListRow
+    [sql|
+      SELECT project.id, project.name
+      FROM project
+        JOIN project_branch ON project.id = project_branch.project_id
+      ORDER BY project_branch.last_accessed DESC NULLS LAST, project.name ASC
+    |]
+
 -- | Load all projects whose name matches a prefix.
 loadAllProjectsBeginningWith :: Maybe Text -> Transaction [Project]
 loadAllProjectsBeginningWith mayPrefix = do
@@ -3761,7 +3752,7 @@ loadAllProjectBranchNamePairs =
       FROM
         project
         JOIN project_branch ON project.id = project_branch.project_id
-      ORDER BY project.name ASC, project_branch.name ASC
+      ORDER BY project_branch.last_accessed DESC NULLS LAST, project.name ASC, project_branch.name ASC
     |]
     <&> fmap \(projectName, branchName, projectId, branchId) ->
       ( ProjectAndBranch projectName branchName,
@@ -4484,6 +4475,13 @@ setCurrentProjectPath projId branchId path = do
       INSERT INTO current_project_path(project_id, branch_id, path)
       VALUES (:projId, :branchId, :jsonPath)
     |]
+  execute
+    [sql|
+      UPDATE project_branch
+      SET last_accessed = strftime('%s', 'now')
+      WHERE project_id = :projId
+        AND branch_id = :branchId
+    |]
   where
     jsonPath :: Text
     jsonPath =

codebase2/codebase-sqlite/U/Codebase/Sqlite/Term/Format.hs

@@ -49,6 +49,7 @@ newtype LocallyIndexedComponent' t d = LocallyIndexedComponent
 
 newtype SyncLocallyIndexedComponent' t d
   = SyncLocallyIndexedComponent (Vector (LocalIds' t d, ByteString))
+  deriving stock (Eq, Show)
 
 {-
 message = "hello, world"     -> ABT { ... { Term.F.Text "hello, world" } }    -> hashes to (#abc, 0)
@@ -127,6 +128,7 @@ data TermFormat' t d = Term (LocallyIndexedComponent' t d)
 type SyncTermFormat = SyncTermFormat' TextId ObjectId
 
 data SyncTermFormat' t d = SyncTerm (SyncLocallyIndexedComponent' t d)
+  deriving stock (Eq, Show)
 
 data WatchResultFormat
   = WatchResult WatchLocalIds Term

codebase2/codebase-sqlite/sql/015-add-project-branch-last-accessed.sql

@@ -0,0 +1,3 @@
+-- Add a new column to the project_branch table to store the last time that project branch was accessed.
+-- This column is stored as a unix epoch time.
+ALTER TABLE project_branch ADD COLUMN last_accessed INTEGER NULL;

codebase2/codebase-sqlite/unison-codebase-sqlite.cabal

@@ -1,6 +1,6 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.36.0.
+-- This file has been generated from package.yaml by hpack version 0.37.0.
 --
 -- see: https://github.com/sol/hpack
 
@@ -24,6 +24,7 @@ extra-source-files:
     sql/012-add-current-project-path-table.sql
     sql/013-add-project-branch-reflog-table.sql
     sql/014-add-project-branch-causal-hash-id.sql
+    sql/015-add-project-branch-last-accessed.sql
     sql/create.sql
 
 source-repository head

docs/release-steps.md

@@ -19,7 +19,11 @@ Edit `releases._<ReleaseName>.README` to include `Release: <ReleaseName>`.
 .basedev.release> push git([email protected]:unisonweb/base)
 ```
 
-## 2. Run Release script
+## 2. Check or run cloud client tests
+
+https://github.com/unisoncomputing/cloud-client-tests/actions/workflows/cloud-client-tests.yml
+
+## 3. Run Release script
 
 * **Milestone Release**: Look up the most recent release; bump the number and remove any trailing letters, e.g. `./scripts/make-release release/M5 trunk`
 * **Minor Release**: Increment the trailing letter of the previous release, or add an `a` to the previous milestone release, e.g. `./scripts/make-release release/M5a trunk`
@@ -40,11 +44,11 @@ Including:
 
 After successfully executing the script you just have to sit tight and wait for all the jobs to complete.
 
-## 3
+## 4
 
 Smoke test of the new release. Try `brew upgrade unison-language`, launch it, launch `ui`.
 
-## 4
+## 5
 
 Write up release notes, template below.
 

hie.yaml

@@ -140,6 +140,9 @@ cradle:
     - path: "unison-share-api/src"
       component: "unison-share-api:lib"
 
+    - path: "unison-share-api/tests"
+      component: "unison-share-api:test:unison-share-api-tests"
+
     - path: "unison-share-projects-api/src"
       component: "unison-share-projects-api:lib"
 

lib/unison-prelude/src/Unison/Prelude.hs

@@ -25,6 +25,7 @@ module Unison.Prelude
     whenJustM,
     eitherToMaybe,
     maybeToEither,
+    eitherToThese,
     altSum,
     altMap,
     hoistMaybe,
@@ -82,6 +83,7 @@ import Data.Text as X (Text)
 import Data.Text qualified as Text
 import Data.Text.Encoding as X (decodeUtf8, encodeUtf8)
 import Data.Text.IO qualified as Text
+import Data.These (These (..))
 import Data.Traversable as X (for)
 import Data.Typeable as X (Typeable)
 import Data.Void as X (Void)
@@ -205,6 +207,9 @@ throwEitherM = throwEitherMWith id
 throwEitherMWith :: forall e e' m a. (MonadIO m, Exception e') => (e -> e') -> m (Either e a) -> m a
 throwEitherMWith f action = throwExceptT . withExceptT f $ (ExceptT action)
 
+eitherToThese :: Either a b -> These a b
+eitherToThese = either This That
+
 tShow :: (Show a) => a -> Text
 tShow = Text.pack . show
 

lib/unison-prelude/src/Unison/Util/Set.hs

@@ -5,6 +5,7 @@ module Unison.Util.Set
     mapMaybe,
     symmetricDifference,
     Unison.Util.Set.traverse,
+    Unison.Util.Set.for,
     flatMap,
     filterM,
     forMaybe,
@@ -51,6 +52,9 @@ forMaybe xs f =
 traverse :: (Applicative f, Ord b) => (a -> f b) -> Set a -> f (Set b)
 traverse f = fmap Set.fromList . Prelude.traverse f . Set.toList
 
+for :: (Ord b, Applicative f) => Set a -> (a -> f b) -> f (Set b)
+for = flip Unison.Util.Set.traverse
+
 flatMap :: (Ord b) => (a -> Set b) -> Set a -> Set b
 flatMap f = Set.unions . fmap f . Set.toList
 

lib/unison-pretty-printer/src/Unison/Util/Pretty.hs

@@ -695,8 +695,8 @@ column2UnzippedM bottomPadding left right =
 column3sep ::
   (LL.ListLike s Char, IsString s) => Pretty s -> [(Pretty s, Pretty s, Pretty s)] -> Pretty s
 column3sep sep rows =
-  let bc = align [(b, sep <> c) | (_, b, c) <- rows]
-      abc = group <$> align [(a, sep <> bc) | ((a, _, _), bc) <- rows `zip` bc]
+  let bc = align $ [(b, indent sep c) | (_, b, c) <- rows]
+      abc = group <$> align [(a, indent sep bc) | ((a, _, _), bc) <- rows `zip` bc]
    in lines abc
 
 -- | Creates an aligned table with an arbitrary number of columns separated by `sep`

lib/unison-sqlite/src/Unison/Sqlite.hs

@@ -19,6 +19,7 @@ module Unison.Sqlite
     Transaction,
     runTransaction,
     runTransactionWithRollback,
+    runTransactionExceptT,
     runReadOnlyTransaction,
     runWriteTransaction,
     cacheTransaction,
@@ -55,6 +56,9 @@ module Unison.Sqlite
     queryOneRowCheck,
     queryOneColCheck,
 
+    -- * Utilities
+    likeEscape,
+
     -- * Rows modified
     rowsModified,
 
@@ -118,6 +122,7 @@ import Unison.Sqlite.Exception
 import Unison.Sqlite.JournalMode (JournalMode (..), SetJournalModeException (..), trySetJournalMode)
 import Unison.Sqlite.Sql (Sql, sql)
 import Unison.Sqlite.Transaction
+import Unison.Sqlite.Utils (likeEscape)
 
 -- $query-naming-convention
 --

lib/unison-sqlite/src/Unison/Sqlite/Transaction.hs

@@ -3,6 +3,7 @@ module Unison.Sqlite.Transaction
     Transaction,
     runTransaction,
     runTransactionWithRollback,
+    runTransactionExceptT,
     runReadOnlyTransaction,
     runWriteTransaction,
     cacheTransaction,
@@ -44,6 +45,7 @@ where
 
 import Control.Concurrent (threadDelay)
 import Control.Exception (Exception (fromException), onException, throwIO)
+import Control.Monad.Trans.Except (ExceptT, runExceptT)
 import Control.Monad.Trans.Reader (ReaderT (..))
 import Data.Text qualified as Text
 import Data.Unique (Unique, newUnique)
@@ -130,6 +132,13 @@ runTransactionWithRollback conn transaction = liftIO do
     Right x -> pure x
 {-# SPECIALIZE runTransactionWithRollback :: Connection -> ((forall void. a -> Transaction void) -> Transaction a) -> IO a #-}
 
+-- | Run a transaction wrapped in an 'ExceptT'. If the ExceptT fails, the transaction is rolled back.
+runTransactionExceptT :: (MonadIO m, HasCallStack) => Connection -> ExceptT e Transaction a -> m (Either e a)
+runTransactionExceptT conn transaction = runTransactionWithRollback conn \rollback -> do
+  runExceptT transaction >>= \case
+    Left e -> rollback (Left e)
+    Right a -> pure (Right a)
+
 -- | Run a transaction that is known to only perform reads.
 --
 -- The action is provided a function that peels off the 'Transaction' newtype without sending the corresponding