Merge pull request #4250 from unisonweb/cp/project-branch-list

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

@@ -3268,21 +3268,16 @@ loadAllProjects =
     |]
 
 -- | Load all projects whose name matches a prefix.
-loadAllProjectsBeginningWith :: Text -> Transaction [Project]
-loadAllProjectsBeginningWith prefix =
-  -- since we are not likely to many projects, we just get them all and filter in Haskell. This seems much simpler than
-  -- running a LIKE query, and dealing with escaping, case sensitivity, etc
-  fmap (filter matches) $
-    queryListRow
-      [sql|
+loadAllProjectsBeginningWith :: Maybe Text -> Transaction [Project]
+loadAllProjectsBeginningWith mayPrefix = do
+  let prefixGlob = maybe "*" (\prefix -> (globEscape prefix <> "*")) mayPrefix
+  queryListRow
+    [sql|
         SELECT id, name
         FROM project
+        WHERE name GLOB :prefixGlob
         ORDER BY name ASC
       |]
-  where
-    matches :: Project -> Bool
-    matches Project {name = UnsafeProjectName name} =
-      prefix `Text.isPrefixOf` name
 
 -- | Insert a `project` row.
 insertProject :: ProjectId -> ProjectName -> Transaction ()
@@ -3383,23 +3378,18 @@ loadProjectBranchByNames projectName branchName =
         AND project_branch.name = :branchName
     |]
 
--- | Load all branch id/name pairs in a project whose name matches a prefix.
-loadAllProjectBranchesBeginningWith :: ProjectId -> Text -> Transaction [(ProjectBranchId, ProjectBranchName)]
-loadAllProjectBranchesBeginningWith projectId prefix =
-  -- since a project is not likely to have many branches, we just get them all and filter in Haskell. This seems much
-  -- simpler than running a LIKE query, and dealing with escaping, case sensitivity, etc
-  fmap (filter matches) $
-    queryListRow
-      [sql|
+-- | Load all branch id/name pairs in a project whose name matches an optional prefix.
+loadAllProjectBranchesBeginningWith :: ProjectId -> Maybe Text -> Transaction [(ProjectBranchId, ProjectBranchName)]
+loadAllProjectBranchesBeginningWith projectId mayPrefix =
+  let prefixGlob = maybe "*" (\prefix -> (globEscape prefix <> "*")) mayPrefix
+   in queryListRow
+        [sql|
         SELECT project_branch.branch_id, project_branch.name
         FROM project_branch
         WHERE project_branch.project_id = :projectId
+          AND project_branch.name GLOB :prefixGlob
         ORDER BY project_branch.name ASC
       |]
-  where
-    matches :: (ProjectBranchId, ProjectBranchName) -> Bool
-    matches (_, UnsafeProjectBranchName name) =
-      prefix `Text.isPrefixOf` name
 
 -- | Load info about all branches in a project, for display by the @branches@ command.
 --

codebase2/core/Unison/Core/Project.hs

@@ -17,12 +17,12 @@ import Unison.Prelude
 -- | The name of a project.
 newtype ProjectName
   = UnsafeProjectName Text
-  deriving stock (Eq, Ord, Show)
+  deriving stock (Eq, Ord, Show, Generic)
 
 -- | The name of a branch of a project.
 newtype ProjectBranchName
   = UnsafeProjectBranchName Text
-  deriving stock (Eq, Ord, Show)
+  deriving stock (Eq, Ord, Show, Generic)
 
 -- | A generic data structure that contains information about a project and a branch in that project.
 data ProjectAndBranch a b = ProjectAndBranch

unison-cli/src/Unison/CommandLine/InputPatterns.hs

@@ -3064,7 +3064,7 @@ projectAndBranchNamesArg includeCurrentBranch =
                       Just project -> do
                         let projectId = project ^. #projectId
                         fmap (filterOutCurrentBranch path projectId) do
-                          Queries.loadAllProjectBranchesBeginningWith projectId Text.empty
+                          Queries.loadAllProjectBranchesBeginningWith projectId Nothing
                 pure (map (projectBranchToCompletion projectName) branches)
               -- This branch is probably dead due to intercepting inputs that begin with "/" above
               Right (ProjectAndBranchNames'Unambiguous (That branchName)) ->
@@ -3077,7 +3077,7 @@ projectAndBranchNamesArg includeCurrentBranch =
                       Just project -> do
                         let projectId = project ^. #projectId
                         fmap (filterOutCurrentBranch path projectId) do
-                          Queries.loadAllProjectBranchesBeginningWith projectId (into @Text branchName)
+                          Queries.loadAllProjectBranchesBeginningWith projectId (Just $ into @Text branchName)
                 pure (map (projectBranchToCompletion projectName) branches),
       globTargets = Set.empty
     }
@@ -3096,8 +3096,8 @@ projectAndBranchNamesArg includeCurrentBranch =
               Nothing -> pure []
               Just (ProjectAndBranch currentProjectId _, _) ->
                 fmap (filterOutCurrentBranch path currentProjectId) do
-                  Queries.loadAllProjectBranchesBeginningWith currentProjectId input
-          projects <- Queries.loadAllProjectsBeginningWith input
+                  Queries.loadAllProjectBranchesBeginningWith currentProjectId (Just input)
+          projects <- Queries.loadAllProjectsBeginningWith (Just input)
           pure (branches, projects)
       let branchCompletions = map currentProjectBranchToCompletion branches
       let projectCompletions = map projectToCompletion projects
@@ -3178,7 +3178,7 @@ projectAndBranchNamesArg includeCurrentBranch =
           Just (ProjectAndBranch currentProjectId _, _) ->
             Codebase.runTransaction codebase do
               fmap (filterOutCurrentBranch path currentProjectId) do
-                Queries.loadAllProjectBranchesBeginningWith currentProjectId branchName
+                Queries.loadAllProjectBranchesBeginningWith currentProjectId (Just branchName)
       pure (map currentProjectBranchToCompletion branches)
 
     filterOutCurrentBranch :: Path.Absolute -> ProjectId -> [(ProjectBranchId, a)] -> [(ProjectBranchId, a)]
@@ -3240,7 +3240,7 @@ projectNameArg =
       suggestions = \(Text.strip . Text.pack -> input) codebase _httpClient _path -> do
         projects <-
           Codebase.runTransaction codebase do
-            Queries.loadAllProjectsBeginningWith input
+            Queries.loadAllProjectsBeginningWith (Just input)
         pure $ map projectToCompletion projects,
       globTargets = Set.empty
     }

unison-share-api/src/Unison/Server/CodebaseServer.hs

@@ -106,7 +106,7 @@ import Unison.Server.Local.Endpoints.GetDefinitions
   )
 import Unison.Server.Local.Endpoints.NamespaceDetails qualified as NamespaceDetails
 import Unison.Server.Local.Endpoints.NamespaceListing qualified as NamespaceListing
-import Unison.Server.Local.Endpoints.Projects qualified as Projects
+import Unison.Server.Local.Endpoints.Projects (ListProjectBranchesEndpoint, ListProjectsEndpoint, projectBranchListingEndpoint, projectListingEndpoint)
 import Unison.Server.Types (mungeString, setCacheControl)
 import Unison.ShortHash qualified as ShortHash
 import Unison.Symbol (Symbol)
@@ -133,14 +133,15 @@ type UnisonLocalAPI = ProjectsAPI :<|> LooseCodeAPI
 type CodebaseServerAPI =
   NamespaceListing.NamespaceListingAPI
     :<|> NamespaceDetails.NamespaceDetailsAPI
-    :<|> Projects.ProjectsAPI
     :<|> DefinitionsAPI
     :<|> FuzzyFindAPI
     :<|> TermSummaryAPI
     :<|> TypeSummaryAPI
 
 type ProjectsAPI =
-  "projects" :> Capture "project-name" ProjectName :> "branches" :> Capture "branch-name" ProjectBranchName :> CodebaseServerAPI
+  ("projects" :> ListProjectsEndpoint)
+    :<|> ("projects" :> Capture "project-name" ProjectName :> "branches" :> ListProjectBranchesEndpoint)
+    :<|> ("projects" :> Capture "project-name" ProjectName :> "branches" :> Capture "branch-name" ProjectBranchName :> CodebaseServerAPI)
 
 type WebUI = CaptureAll "route" Text :> Get '[HTML] RawHtml
 
@@ -498,36 +499,30 @@ hoistWithAuth :: forall api. (HasServer api '[]) => Proxy api -> ByteString -> S
 hoistWithAuth api expectedToken server token = hoistServer @api @Handler @Handler api (\h -> handleAuth expectedToken token *> h) server
 
 serveLooseCode ::
-  BackendEnv ->
   Codebase IO Symbol Ann ->
   Rt.Runtime Symbol ->
-  Server LooseCodeAPI
-serveLooseCode env codebase rt =
-  hoistServer (Proxy @LooseCodeAPI) (backendHandler env) $
-    (\root rel name -> setCacheControl <$> NamespaceListing.serve codebase (Left <$> root) rel name)
-      :<|> (\namespaceName mayRoot renderWidth -> setCacheControl <$> NamespaceDetails.namespaceDetails rt codebase namespaceName (Left <$> mayRoot) renderWidth)
-      :<|> (\mayRoot mayOwner -> setCacheControl <$> Projects.serve codebase (Left <$> mayRoot) mayOwner)
-      :<|> (\mayRoot relativePath rawHqns renderWidth suff -> setCacheControl <$> serveDefinitions rt codebase (Left <$> mayRoot) relativePath rawHqns renderWidth suff)
-      :<|> (\mayRoot relativePath limit renderWidth query -> setCacheControl <$> serveFuzzyFind codebase (Left <$> mayRoot) relativePath limit renderWidth query)
-      :<|> (\shortHash mayName mayRoot relativeTo renderWidth -> setCacheControl <$> serveTermSummary codebase shortHash mayName (Left <$> mayRoot) relativeTo renderWidth)
-      :<|> (\shortHash mayName mayRoot relativeTo renderWidth -> setCacheControl <$> serveTypeSummary codebase shortHash mayName (Left <$> mayRoot) relativeTo renderWidth)
-
-serveProjectsAPI ::
-  BackendEnv ->
+  ServerT LooseCodeAPI (Backend IO)
+serveLooseCode codebase rt =
+  (\root rel name -> setCacheControl <$> NamespaceListing.serve codebase (Left <$> root) rel name)
+    :<|> (\namespaceName mayRoot renderWidth -> setCacheControl <$> NamespaceDetails.namespaceDetails rt codebase namespaceName (Left <$> mayRoot) renderWidth)
+    :<|> (\mayRoot relativePath rawHqns renderWidth suff -> setCacheControl <$> serveDefinitions rt codebase (Left <$> mayRoot) relativePath rawHqns renderWidth suff)
+    :<|> (\mayRoot relativePath limit renderWidth query -> setCacheControl <$> serveFuzzyFind codebase (Left <$> mayRoot) relativePath limit renderWidth query)
+    :<|> (\shortHash mayName mayRoot relativeTo renderWidth -> setCacheControl <$> serveTermSummary codebase shortHash mayName (Left <$> mayRoot) relativeTo renderWidth)
+    :<|> (\shortHash mayName mayRoot relativeTo renderWidth -> setCacheControl <$> serveTypeSummary codebase shortHash mayName (Left <$> mayRoot) relativeTo renderWidth)
+
+serveProjectsCodebaseServerAPI ::
   Codebase IO Symbol Ann ->
   Rt.Runtime Symbol ->
   ProjectName ->
   ProjectBranchName ->
-  Server LooseCodeAPI
-serveProjectsAPI env codebase rt projectName branchName =
-  hoistServer (Proxy @LooseCodeAPI) (backendHandler env) $ do
-    namespaceListingEndpoint
-      :<|> namespaceDetailsEndpoint
-      :<|> projectListingEndpoint
-      :<|> serveDefinitionsEndpoint
-      :<|> serveFuzzyFindEndpoint
-      :<|> serveTermSummaryEndpoint
-      :<|> serveTypeSummaryEndpoint
+  ServerT CodebaseServerAPI (Backend IO)
+serveProjectsCodebaseServerAPI codebase rt projectName branchName = do
+  namespaceListingEndpoint
+    :<|> namespaceDetailsEndpoint
+    :<|> serveDefinitionsEndpoint
+    :<|> serveFuzzyFindEndpoint
+    :<|> serveTermSummaryEndpoint
+    :<|> serveTypeSummaryEndpoint
   where
     projectAndBranchName = ProjectAndBranch projectName branchName
     namespaceListingEndpoint _rootParam rel name = do
@@ -536,9 +531,6 @@ serveProjectsAPI env codebase rt projectName branchName =
     namespaceDetailsEndpoint namespaceName _rootParam renderWidth = do
       root <- resolveProjectRoot
       setCacheControl <$> NamespaceDetails.namespaceDetails rt codebase namespaceName (Just root) renderWidth
-    projectListingEndpoint _rootParam mayOwner = do
-      root <- resolveProjectRoot
-      setCacheControl <$> Projects.serve codebase (Just root) mayOwner
 
     serveDefinitionsEndpoint _rootParam relativePath rawHqns renderWidth suff = do
       root <- resolveProjectRoot
@@ -563,12 +555,20 @@ serveProjectsAPI env codebase rt projectName branchName =
         Nothing -> throwError (Backend.ProjectBranchNameNotFound projectName branchName)
         Just ch -> pure (Right ch)
 
+serveProjectsAPI :: Codebase IO Symbol Ann -> Rt.Runtime Symbol -> ServerT ProjectsAPI (Backend IO)
+serveProjectsAPI codebase rt =
+  projectListingEndpoint codebase
+    :<|> projectBranchListingEndpoint codebase
+    :<|> serveProjectsCodebaseServerAPI codebase rt
+
 serveUnisonLocal ::
   BackendEnv ->
   Codebase IO Symbol Ann ->
   Rt.Runtime Symbol ->
   Server UnisonLocalAPI
-serveUnisonLocal env codebase rt = serveProjectsAPI env codebase rt :<|> serveLooseCode env codebase rt
+serveUnisonLocal env codebase rt =
+  hoistServer (Proxy @UnisonLocalAPI) (backendHandler env) $
+    serveProjectsAPI codebase rt :<|> serveLooseCode codebase rt
 
 backendHandler :: BackendEnv -> Backend IO a -> Handler a
 backendHandler env m =