Add new branch listing infix query

unisonweb · Jan 23, 2025 · 6fd6220 · 6fd6220
1 parent 3f1d9d1
commit 6fd6220
Show file tree

Hide file tree

Showing 4 changed files with 46 additions and 28 deletions.
diff --git a/unison-share-api/src/Unison/Server/Local/Endpoints/Projects.hs b/unison-share-api/src/Unison/Server/Local/Endpoints/Projects.hs
@@ -24,6 +24,7 @@ import Unison.Parser.Ann (Ann)
 import Unison.Prelude
 import Unison.Project (ProjectName)
 import Unison.Server.Backend (Backend)
+import Unison.Server.Local.Endpoints.Projects.Queries qualified as PG
 import Unison.Server.Local.Endpoints.Projects.Queries qualified as PQ
 import Unison.Server.Local.Endpoints.Projects.Types
 import Unison.Symbol (Symbol)
@@ -33,7 +34,7 @@ type ListProjectsEndpoint =
     :> Get '[JSON] [ProjectListing]
 
 type ListProjectBranchesEndpoint =
-  QueryParam "prefix" PrefixFilter
+  QueryParam "query" Query
     :> Get '[JSON] [ProjectBranchListing]
 
 newtype PrefixFilter = PrefixFilter
@@ -87,9 +88,8 @@ projectListingEndpoint codebase mayQuery = liftIO . Codebase.runTransaction code
 projectBranchListingEndpoint ::
   Codebase IO Symbol Ann ->
   ProjectName ->
-  Maybe PrefixFilter ->
+  Maybe Query ->
   Backend IO [ProjectBranchListing]
-projectBranchListingEndpoint codebase projectName mayPrefix = liftIO . Codebase.runTransaction codebase . fmap fold . runMaybeT $ do
+projectBranchListingEndpoint codebase projectName mayQuery = liftIO . Codebase.runTransaction codebase . fmap fold . runMaybeT $ do
   SqliteProject.Project {projectId} <- MaybeT $ Q.loadProjectByName projectName
-  lift (Q.loadAllProjectBranchesBeginningWith projectId (prefix <$> mayPrefix))
-    <&> fmap (ProjectBranchListing . snd)
+  lift (PG.listProjectBranches projectId (getQuery <$> mayQuery))
diff --git a/unison-share-api/src/Unison/Server/Local/Endpoints/Projects/Queries.hs b/unison-share-api/src/Unison/Server/Local/Endpoints/Projects/Queries.hs
@@ -1,6 +1,11 @@
-module Unison.Server.Local.Endpoints.Projects.Queries (listProjects) where
+module Unison.Server.Local.Endpoints.Projects.Queries
+  ( listProjects,
+    listProjectBranches,
+  )
+where
 
 import Data.Text (Text)
+import U.Codebase.Sqlite.DbId (ProjectId)
 import Unison.Server.Local.Endpoints.Projects.Types
 import Unison.Sqlite
 
@@ -19,3 +24,16 @@ listProjects mayUnsafeQuery = do
         WHERE (:mayQuery IS NULL OR project.name LIKE '%' || :mayQuery || '%' ESCAPE '\')
       ORDER BY branch.last_accessed DESC NULLS LAST, project.name ASC
     |]
+
+-- | Load all project listings, optionally requiring an infix match with a query.
+listProjectBranches :: ProjectId -> Maybe Text -> Transaction [ProjectBranchListing]
+listProjectBranches projectId mayUnsafeQuery = do
+  let mayQuery = fmap (likeEscape '\\') mayUnsafeQuery
+  queryListRow
+    [sql|
+        SELECT project_branch.name
+        FROM project_branch
+        WHERE project_branch.project_id = :projectId
+          AND (:mayQuery IS NULL OR project_branch.name LIKE '%' || :mayQuery || '%' ESCAPE '\')
+        ORDER BY project_branch.last_accessed DESC NULLS LAST, project_branch.name ASC
+      |]
diff --git a/unison-share-api/src/Unison/Server/Local/Endpoints/Projects/Types.hs b/unison-share-api/src/Unison/Server/Local/Endpoints/Projects/Types.hs
@@ -41,6 +41,9 @@ data ProjectBranchListing = ProjectBranchListing
   }
   deriving stock (Show, Generic)
 
+instance FromRow ProjectBranchListing where
+  fromRow = ProjectBranchListing <$> field
+
 instance ToSchema ProjectBranchListing
 
 instance ToJSON ProjectBranchListing where

diff --git a/unison-src/transcripts/idempotent/api-list-projects-branches.md b/unison-src/transcripts/idempotent/api-list-projects-branches.md
@@ -1,72 +1,69 @@
 # List Projects And Branches Test
 
 ``` ucm :hide
-scratch/main> project.create-empty project-one
+scratch/main> project.create-empty project-apple
 
-scratch/main> project.create-empty project-two
+scratch/main> project.create-empty project-banana
 
-scratch/main> project.create-empty project-three
+scratch/main> project.create-empty project-cherry
 
-project-one/main> branch branch-one
+project-apple/main> branch branch-apple
 
-project-one/main> branch branch-two
+project-apple/main> branch branch-banana
 
-project-one/main> branch branch-three
+project-apple/main> branch branch-cherry
 ```
 
 ``` api
 -- Should list all projects
 GET /api/projects
   [
       {
-          "activeBranchRef": "branch-three",
-          "projectName": "project-one"
+          "activeBranchRef": "branch-cherry",
+          "projectName": "project-apple"
       },
       {
           "activeBranchRef": "main",
-          "projectName": "project-three"
+          "projectName": "project-banana"
       },
       {
           "activeBranchRef": "main",
-          "projectName": "project-two"
+          "projectName": "project-cherry"
       },
       {
           "activeBranchRef": "main",
           "projectName": "scratch"
       }
   ]
 -- Can query for some infix of the project name
-GET /api/projects?query=thre
+GET /api/projects?query=bana
   [
       {
           "activeBranchRef": "main",
-          "projectName": "project-three"
+          "projectName": "project-banana"
       }
   ]
 -- Should list all branches
-GET /api/projects/project-one/branches
+GET /api/projects/project-apple/branches
   [
       {
-          "branchName": "branch-one"
+          "branchName": "branch-apple"
       },
       {
-          "branchName": "branch-three"
+          "branchName": "branch-banana"
       },
       {
-          "branchName": "branch-two"
+          "branchName": "branch-cherry"
       },
       {
           "branchName": "main"
       }
   ]
--- Should list all branches beginning with branch-t
-GET /api/projects/project-one/branches?prefix=branch-t
+-- Can query for some  infix of the project name
+GET /api/projects/project-apple/branches?query=bana
   [
       {
-          "branchName": "branch-three"
-      },
-      {
-          "branchName": "branch-two"
+          "branchName": "branch-banana"
       }
   ]
 ```