From e27fcfb00f860cec4cd08be6375f682f64a6f7bd Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 8 Aug 2023 14:56:06 -0700 Subject: [PATCH 1/3] Add project and branch listing endpoints --- .../U/Codebase/Sqlite/Queries.hs | 36 ++- codebase2/core/Unison/Core/Project.hs | 4 +- .../src/Unison/CommandLine/InputPatterns.hs | 12 +- .../src/Unison/Server/CodebaseServer.hs | 62 ++--- .../Unison/Server/Local/Endpoints/Projects.hs | 232 +++++++----------- unison-share-api/src/Unison/Server/Orphans.hs | 11 +- 6 files changed, 150 insertions(+), 207 deletions(-) diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs index 5479801edf..bcd713ba23 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs @@ -3265,21 +3265,18 @@ loadAllProjects = |] -- | Load all projects whose name matches a prefix. -loadAllProjectsBeginningWith :: Text -> Transaction [Project] -loadAllProjectsBeginningWith prefix = +loadAllProjectsBeginningWith :: Maybe Text -> Transaction [Project] +loadAllProjectsBeginningWith mayPrefix = do + let prefixGlob = maybe "*" (\prefix -> (globEscape prefix <> "*")) mayPrefix -- 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| + 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 () @@ -3380,23 +3377,20 @@ 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 -- 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 + 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. -- diff --git a/codebase2/core/Unison/Core/Project.hs b/codebase2/core/Unison/Core/Project.hs index d6182c34a4..632f9702ec 100644 --- a/codebase2/core/Unison/Core/Project.hs +++ b/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 diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index b6605d78b5..af7d9a1895 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -3052,7 +3052,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)) -> @@ -3065,7 +3065,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 } @@ -3084,8 +3084,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 @@ -3166,7 +3166,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)] @@ -3228,7 +3228,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 } diff --git a/unison-share-api/src/Unison/Server/CodebaseServer.hs b/unison-share-api/src/Unison/Server/CodebaseServer.hs index c66976c3cc..63c43b9a4c 100644 --- a/unison-share-api/src/Unison/Server/CodebaseServer.hs +++ b/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 :> LooseCodeAPI + ("projects" :> ListProjectsEndpoint) + :<|> ("projects" :> Capture "project-name" ProjectName :> "branches" :> ListProjectBranchesEndpoint) + :<|> ("projects" :> Capture "project-name" ProjectName :> "branches" :> Capture "branch-name" ProjectBranchName :> LooseCodeAPI) type WebUI = CaptureAll "route" Text :> Get '[HTML] RawHtml @@ -484,36 +485,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 @@ -522,9 +517,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 @@ -549,12 +541,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 = diff --git a/unison-share-api/src/Unison/Server/Local/Endpoints/Projects.hs b/unison-share-api/src/Unison/Server/Local/Endpoints/Projects.hs index 46c9b07a33..b908b7499b 100644 --- a/unison-share-api/src/Unison/Server/Local/Endpoints/Projects.hs +++ b/unison-share-api/src/Unison/Server/Local/Endpoints/Projects.hs @@ -1,165 +1,105 @@ {-# LANGUAGE DataKinds #-} -{-# LANGUAGE RecordWildCards #-} - -module Unison.Server.Local.Endpoints.Projects where - -import Control.Monad.Except -import Data.Aeson -import Data.Char -import Data.OpenApi - ( ToParamSchema (..), - ToSchema (..), +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} + +module Unison.Server.Local.Endpoints.Projects + ( projectListingEndpoint, + projectBranchListingEndpoint, + ListProjectsEndpoint, + ListProjectBranchesEndpoint, ) -import Data.Text qualified as Text -import Servant (QueryParam, (:>)) -import Servant.API (FromHttpApiData (..)) +where + +import Data.Aeson (ToJSON (..)) +import Data.Aeson qualified as Aeson +import Data.OpenApi (ToParamSchema, ToSchema) +import GHC.Generics () +import Servant import Servant.Docs - ( DocQueryParam (..), - ParamKind (Normal), - ToParam (..), - ToSample (..), - ) -import U.Codebase.Branch qualified as V2Branch -import U.Codebase.Causal qualified as V2Causal -import U.Codebase.HashTags (CausalHash (..)) +import Servant.Docs qualified as Docs +import U.Codebase.Sqlite.Project qualified as SqliteProject +import U.Codebase.Sqlite.Queries qualified as Q import Unison.Codebase (Codebase) import Unison.Codebase qualified as Codebase -import Unison.Codebase.Path qualified as Path -import Unison.Codebase.Path.Parse qualified as Path -import Unison.Codebase.ShortCausalHash (ShortCausalHash) -import Unison.Hash qualified as Hash -import Unison.NameSegment qualified as NameSegment +import Unison.Core.Project (ProjectBranchName (UnsafeProjectBranchName), ProjectName (UnsafeProjectName)) import Unison.Parser.Ann (Ann) import Unison.Prelude -import Unison.Server.Backend -import Unison.Server.Backend qualified as Backend -import Unison.Server.Types (APIGet, UnisonHash) -import Unison.Sqlite qualified as Sqlite +import Unison.Server.Backend (Backend) import Unison.Symbol (Symbol) -import Unison.Util.Monoid (foldMapM) -type ProjectsAPI = - "projects" - :> QueryParam "rootBranch" ShortCausalHash - :> QueryParam "owner" ProjectOwner - :> APIGet [ProjectListing] +data ProjectListing = ProjectListing + { projectName :: ProjectName + } + deriving stock (Show, Generic) + +instance ToSchema ProjectListing + +instance ToJSON ProjectListing where + toJSON ProjectListing {projectName} = + Aeson.object ["projectName" Aeson..= projectName] instance ToSample ProjectListing where toSamples _ = - [ ( "Projects in the root branch", - ProjectListing - (ProjectOwner "unison") - "base" - "#gjlk0dna8dongct6lsd19d1o9hi5n642t8jttga5e81e91fviqjdffem0tlddj7ahodjo5" - ) - ] - -newtype ProjectOwner = ProjectOwner Text - deriving stock (Generic, Show) - deriving anyclass (ToSchema) - -instance ToParam (QueryParam "owner" ProjectOwner) where - toParam _ = - DocQueryParam - "owner" - ["unison", "alice", "bob"] - "The name of a project owner" - Normal + singleSample $ ProjectListing (UnsafeProjectName "my-project") -instance ToJSON ProjectOwner where - toJSON (ProjectOwner owner) = toJSON owner +data ProjectBranchListing = ProjectBranchListing + { branchName :: ProjectBranchName + } + deriving stock (Show, Generic) -deriving anyclass instance ToParamSchema ProjectOwner +instance ToSchema ProjectBranchListing -instance FromHttpApiData ProjectOwner where - parseUrlPiece = Right . ProjectOwner +instance ToJSON ProjectBranchListing where + toJSON ProjectBranchListing {branchName} = + Aeson.object ["branchName" Aeson..= branchName] --- ProjectOwner is slightly more restrictive than a regular FQN in that we only --- want alphanumeric characters -projectOwnerFromText :: Text -> Either Text ProjectOwner -projectOwnerFromText raw = - if isAllAlphaNum raw - then Right (ProjectOwner raw) - else Left "Invalid owner name" - where - isAllAlphaNum t = - t & Text.unpack & all isAlphaNum +instance ToSample ProjectBranchListing where + toSamples _ = + singleSample $ ProjectBranchListing (UnsafeProjectBranchName "my-branch") -data ProjectListing = ProjectListing - { owner :: ProjectOwner, - name :: Text, - hash :: UnisonHash +type ListProjectsEndpoint = + QueryParam "prefix" PrefixFilter + :> Get '[JSON] [ProjectListing] + +type ListProjectBranchesEndpoint = + QueryParam "prefix" PrefixFilter + :> Get '[JSON] [ProjectBranchListing] + +newtype PrefixFilter = PrefixFilter + { prefix :: Text } - deriving stock (Generic, Show) - deriving anyclass (ToSchema) + deriving stock (Show, Generic) + deriving newtype (FromHttpApiData) -instance ToJSON ProjectListing where - toJSON (ProjectListing {..}) = - object - [ "owner" .= owner, - "name" .= name, - "hash" .= hash - ] - -backendListEntryToProjectListing :: - ProjectOwner -> - Backend.ShallowListEntry Symbol a -> - Maybe ProjectListing -backendListEntryToProjectListing owner = \case - Backend.ShallowBranchEntry name hash _size -> - Just $ - ProjectListing - { owner = owner, - name = NameSegment.toText name, - hash = "#" <> Hash.toBase32HexText (unCausalHash hash) - } - _ -> Nothing - -entryToOwner :: - Backend.ShallowListEntry Symbol a -> - Maybe ProjectOwner -entryToOwner = \case - Backend.ShallowBranchEntry name _ _size -> - Just $ ProjectOwner $ NameSegment.toText name - _ -> Nothing - -serve :: - forall m. - (MonadIO m) => - Codebase m Symbol Ann -> - Maybe (Either ShortCausalHash CausalHash) -> - Maybe ProjectOwner -> - Backend m [ProjectListing] -serve codebase mayRoot mayOwner = projects - where - projects :: Backend m [ProjectListing] - projects = do - shallowRootBranch <- - Backend.hoistBackend (Codebase.runTransaction codebase) $ do - shallowRootCausal <- Backend.normaliseRootCausalHash mayRoot - lift $ V2Causal.value shallowRootCausal - ownerEntries <- lift $ Backend.lsBranch codebase shallowRootBranch - -- If an owner is provided, we only want projects belonging to them - let owners = - case mayOwner of - Just o -> [o] - Nothing -> mapMaybe entryToOwner ownerEntries - foldMapM (ownerToProjectListings shallowRootBranch) owners - - ownerToProjectListings :: V2Branch.Branch Sqlite.Transaction -> ProjectOwner -> Backend m [ProjectListing] - ownerToProjectListings root owner = do - let (ProjectOwner ownerName) = owner - ownerPath' <- (parsePath . Text.unpack) ownerName - let path = Path.fromPath' ownerPath' - entries <- lift $ Backend.lsAtPath codebase (Just root) (Path.Absolute path) - pure $ mapMaybe (backendListEntryToProjectListing owner) entries - - -- Minor helpers - - parsePath :: String -> Backend m Path.Path' - parsePath p = - errFromEither (`Backend.BadNamespace` p) $ Path.parsePath' p - - errFromEither :: (e -> BackendError) -> Either e a -> Backend m a - errFromEither f = - either (throwError . f) pure +instance ToParamSchema PrefixFilter + +instance ToParam (QueryParam "prefix" PrefixFilter) where + toParam _ = + DocQueryParam + "prefix" + ["my-proj"] + "Filter by project or branch prefix" + Normal + +instance Docs.ToSample PrefixFilter where + toSamples _ = + singleSample $ PrefixFilter "my-proj" + +projectListingEndpoint :: + Codebase IO Symbol Ann -> + Maybe PrefixFilter -> + Backend IO [ProjectListing] +projectListingEndpoint codebase mayPrefix = liftIO . Codebase.runTransaction codebase $ do + projects <- Q.loadAllProjectsBeginningWith (prefix <$> mayPrefix) + pure $ ProjectListing . SqliteProject.name <$> projects + +projectBranchListingEndpoint :: + Codebase IO Symbol Ann -> + ProjectName -> + Maybe PrefixFilter -> + Backend IO [ProjectBranchListing] +projectBranchListingEndpoint codebase projectName mayPrefix = liftIO . Codebase.runTransaction codebase . fmap fold . runMaybeT $ do + SqliteProject.Project {projectId} <- MaybeT $ Q.loadProjectByName projectName + lift (Q.loadAllProjectBranchesBeginningWith projectId (prefix <$> mayPrefix)) + <&> fmap (ProjectBranchListing . snd) diff --git a/unison-share-api/src/Unison/Server/Orphans.hs b/unison-share-api/src/Unison/Server/Orphans.hs index 316ccbb41c..29dad61d80 100644 --- a/unison-share-api/src/Unison/Server/Orphans.hs +++ b/unison-share-api/src/Unison/Server/Orphans.hs @@ -24,6 +24,7 @@ import Unison.Codebase.ShortCausalHash import Unison.Codebase.ShortCausalHash qualified as SCH import Unison.ConstructorType (ConstructorType) import Unison.ConstructorType qualified as CT +import Unison.Core.Project (ProjectBranchName (..), ProjectName (..)) import Unison.Hash (Hash (..)) import Unison.Hash qualified as Hash import Unison.HashQualified qualified as HQ @@ -33,7 +34,7 @@ import Unison.Name qualified as Name import Unison.NameSegment (NameSegment (..)) import Unison.NameSegment qualified as NameSegment import Unison.Prelude -import Unison.Project (ProjectBranchName, ProjectName) +import Unison.Project import Unison.Reference qualified as Reference import Unison.Referent qualified as Referent import Unison.ShortHash (ShortHash) @@ -379,9 +380,15 @@ instance ToCapture (Capture "project-name" ProjectName) where "project-name" "The name of a project. E.g. @handle/slug" +instance ToSchema ProjectName + +deriving via Text instance ToJSON ProjectName + instance FromHttpApiData ProjectBranchName where parseQueryParam = mapLeft tShow . tryInto @ProjectBranchName +instance ToSchema ProjectBranchName + instance ToParamSchema ProjectBranchName where toParamSchema _ = mempty @@ -393,3 +400,5 @@ instance ToCapture (Capture "branch-name" ProjectBranchName) where DocCapture "branch-name" "The name of a branch in a project. E.g. @handle/name" + +deriving via Text instance ToJSON ProjectBranchName From d645d3f6cfb70fe9af2ef0c6d34761e0c287bbad Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 8 Aug 2023 15:10:33 -0700 Subject: [PATCH 2/3] Add api transcripts for listing project and branches --- .../U/Codebase/Sqlite/Queries.hs | 6 +-- .../transcripts/api-list-projects-branches.md | 24 +++++++++ .../api-list-projects-branches.output.md | 53 +++++++++++++++++++ 3 files changed, 78 insertions(+), 5 deletions(-) create mode 100644 unison-src/transcripts/api-list-projects-branches.md create mode 100644 unison-src/transcripts/api-list-projects-branches.output.md diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs index bcd713ba23..695f71257b 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs @@ -3268,8 +3268,6 @@ loadAllProjects = loadAllProjectsBeginningWith :: Maybe Text -> Transaction [Project] loadAllProjectsBeginningWith mayPrefix = do let prefixGlob = maybe "*" (\prefix -> (globEscape prefix <> "*")) mayPrefix - -- 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 queryListRow [sql| SELECT id, name @@ -3381,9 +3379,7 @@ loadProjectBranchByNames projectName branchName = loadAllProjectBranchesBeginningWith :: ProjectId -> Maybe Text -> Transaction [(ProjectBranchId, ProjectBranchName)] loadAllProjectBranchesBeginningWith projectId mayPrefix = let prefixGlob = maybe "*" (\prefix -> (globEscape prefix <> "*")) mayPrefix - in -- 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 - queryListRow + in queryListRow [sql| SELECT project_branch.branch_id, project_branch.name FROM project_branch diff --git a/unison-src/transcripts/api-list-projects-branches.md b/unison-src/transcripts/api-list-projects-branches.md new file mode 100644 index 0000000000..111489cf97 --- /dev/null +++ b/unison-src/transcripts/api-list-projects-branches.md @@ -0,0 +1,24 @@ +# List Projects And Branches Test + +```ucm:hide +.> project.create-empty project-one +.> project.create-empty project-two +.> project.create-empty project-three +project-one/main> branch branch-one +project-one/main> branch branch-two +project-one/main> branch branch-three +``` + +```api +-- Should list all projects +GET /api/projects + +-- Should list projects starting with project-t +GET /api/projects?prefix=project-t + +-- Should list all branches +GET /api/projects/project-one/branches + +-- Should list all branches beginning with branch-t +GET /api/projects/project-one/branches?prefix=branch-t +``` diff --git a/unison-src/transcripts/api-list-projects-branches.output.md b/unison-src/transcripts/api-list-projects-branches.output.md new file mode 100644 index 0000000000..1c12eea541 --- /dev/null +++ b/unison-src/transcripts/api-list-projects-branches.output.md @@ -0,0 +1,53 @@ +# List Projects And Branches Test + +```api +-- Should list all projects +GET /api/projects +[ + { + "projectName": "project-one" + }, + { + "projectName": "project-three" + }, + { + "projectName": "project-two" + } +] +-- Should list projects starting with project-t +GET /api/projects?prefix=project-t +[ + { + "projectName": "project-three" + }, + { + "projectName": "project-two" + } +] +-- Should list all branches +GET /api/projects/project-one/branches +[ + { + "branchName": "branch-one" + }, + { + "branchName": "branch-three" + }, + { + "branchName": "branch-two" + }, + { + "branchName": "main" + } +] +-- Should list all branches beginning with branch-t +GET /api/projects/project-one/branches?prefix=branch-t +[ + { + "branchName": "branch-three" + }, + { + "branchName": "branch-two" + } +] +``` \ No newline at end of file From 767356af71ca5426d8f1d11953bf2282e75943dd Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 9 Aug 2023 09:23:27 -0700 Subject: [PATCH 3/3] Remove old out of date project API transcripts --- unison-src/transcripts/api-projects.md | 18 ----- unison-src/transcripts/api-projects.output.md | 72 ------------------- 2 files changed, 90 deletions(-) delete mode 100644 unison-src/transcripts/api-projects.md delete mode 100644 unison-src/transcripts/api-projects.output.md diff --git a/unison-src/transcripts/api-projects.md b/unison-src/transcripts/api-projects.md deleted file mode 100644 index 8d0851538a..0000000000 --- a/unison-src/transcripts/api-projects.md +++ /dev/null @@ -1,18 +0,0 @@ -# projects api - -```unison -rachel.filesystem.x = 42 -ross.http.y = 43 -joey.json.z = 44 -joey.yaml.zz = 45 -``` - -```ucm -.> add -``` - -```api -GET /api/projects - -GET /api/projects?owner=joey -``` diff --git a/unison-src/transcripts/api-projects.output.md b/unison-src/transcripts/api-projects.output.md deleted file mode 100644 index c3b15b4c21..0000000000 --- a/unison-src/transcripts/api-projects.output.md +++ /dev/null @@ -1,72 +0,0 @@ -# projects api - -```unison -rachel.filesystem.x = 42 -ross.http.y = 43 -joey.json.z = 44 -joey.yaml.zz = 45 -``` - -```ucm - - I found and typechecked these definitions in scratch.u. If you - do an `add` or `update`, here's how your codebase would - change: - - ⍟ These new definitions are ok to `add`: - - joey.json.z : ##Nat - joey.yaml.zz : ##Nat - rachel.filesystem.x : ##Nat - ross.http.y : ##Nat - -``` -```ucm -.> add - - ⍟ I've added these definitions: - - joey.json.z : ##Nat - joey.yaml.zz : ##Nat - rachel.filesystem.x : ##Nat - ross.http.y : ##Nat - -``` -```api -GET /api/projects -[ - { - "hash": "#vjmnhfbas8pejgpgsh26255ebaolepuc56juiifft4b9bg8u43nmmhe2skfncrfvin3std4grbfa7io846nskq3j5b3819rvaddnbn0", - "name": "json", - "owner": "joey" - }, - { - "hash": "#plgokdvco3iu26r56u20faojs7pv0r0114pkd5aumt7ucd567t307bcuv92ejtkcvvmp0tg4e2g5d3btqbggn54pifbvql2kd9hlg48", - "name": "yaml", - "owner": "joey" - }, - { - "hash": "#sbh98idno2b9ide5ue7bcj01ftu7u9msm57g3jn7q9efsbo0bdtnaei5i8sq4p3gb6p8alkqrp8gttp4ptvq9f45c8stkf39l9pvb2g", - "name": "filesystem", - "owner": "rachel" - }, - { - "hash": "#1l4rfnjpsut79lc0kcv7aa4m6elk1lj7nse69ptaipb4gvlfa7kcnqrte56opeeb5ahrr6tvms2052e9fjjjuh97glkll6hp3lam788", - "name": "http", - "owner": "ross" - } -] -GET /api/projects?owner=joey -[ - { - "hash": "#vjmnhfbas8pejgpgsh26255ebaolepuc56juiifft4b9bg8u43nmmhe2skfncrfvin3std4grbfa7io846nskq3j5b3819rvaddnbn0", - "name": "json", - "owner": "joey" - }, - { - "hash": "#plgokdvco3iu26r56u20faojs7pv0r0114pkd5aumt7ucd567t307bcuv92ejtkcvvmp0tg4e2g5d3btqbggn54pifbvql2kd9hlg48", - "name": "yaml", - "owner": "joey" - } -] -``` \ No newline at end of file