fill out most of project.create implementation

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

@@ -97,6 +97,13 @@ module U.Codebase.Sqlite.Queries
     loadWatchKindsByReference,
     clearWatches,
 
+    -- * projects
+    ProjectId (..),
+    projectExistsByName,
+    insertProject,
+    BranchId (..),
+    insertBranch,
+
     -- * indexes
 
     -- ** dependents index
@@ -2424,7 +2431,7 @@ getReflog numEntries = queryListRow sql (Only numEntries)
       LIMIT ?
     |]
 
-newtype ProjectId = ProjectId UUID
+newtype ProjectId = ProjectId {unProjectId :: UUID}
   deriving newtype (ToField, FromField)
 
 data Project = Project
@@ -2445,7 +2452,7 @@ data RemoteProject = RemoteProject
   deriving stock (Generic)
   deriving anyclass (ToRow, FromRow)
 
-newtype BranchId = BranchId UUID
+newtype BranchId = BranchId {unBranchId :: UUID}
   deriving newtype (ToField, FromField)
 
 data Branch = Branch
@@ -2466,6 +2473,18 @@ getProject pid = queryMaybeRow bonk (Only pid)
            where id = ?
            |]
 
+projectExistsByName :: Text -> Transaction Bool
+projectExistsByName name =
+  queryOneCol
+    [sql|
+      SELECT EXISTS (
+        SELECT 1
+        FROM project
+        WHERE name = ?
+      )
+    |]
+    (Only name)
+
 insertProject :: ProjectId -> Text -> Transaction ()
 insertProject uuid name = execute bonk (uuid, name)
   where

unison-cli/package.yaml

@@ -84,6 +84,7 @@ dependencies:
   - unison-util-relation
   - unliftio
   - unordered-containers
+  - uuid
   - vector
   - witherable
   - wai

unison-cli/src/Unison/Cli/Monad.hs

@@ -28,6 +28,9 @@ module Unison.Cli.Monad
     returnEarlyWithoutOutput,
     haltRepl,
 
+    -- * Changing the current directory
+    cd,
+
     -- * Communicating output to the user
     respond,
     respondNumbered,
@@ -365,6 +368,11 @@ time label action =
         ms = ns / 1_000_000
         s = ns / 1_000_000_000
 
+cd :: Path.Absolute -> Cli ()
+cd path =
+  State.modify' \state ->
+    state {currentPathStack = List.NonEmpty.cons path (currentPathStack state)}
+
 respond :: Output -> Cli ()
 respond output = do
   Env {notify} <- ask

unison-cli/src/Unison/Cli/MonadUtils.hs

@@ -210,12 +210,15 @@ getRootBranch0 =
   Branch.head <$> getRootBranch
 
 -- | Set a new root branch.
+--
 -- Note: This does _not_ update the codebase, the caller is responsible for that.
 setRootBranch :: Branch IO -> Cli ()
 setRootBranch b = do
   void $ modifyRootBranch (const b)
 
--- | Get the root branch.
+-- | Modify the root branch.
+--
+-- Note: This does _not_ update the codebase, the caller is responsible for that.
 modifyRootBranch :: (Branch IO -> Branch IO) -> Cli (Branch IO)
 modifyRootBranch f = do
   rootVar <- use #root

unison-cli/src/Unison/Cli/ProjectUtils.hs

@@ -0,0 +1,30 @@
+-- | Project-related utilities.
+module Unison.Cli.ProjectUtils
+  ( projectPath,
+    projectBranchPath,
+  )
+where
+
+import qualified Data.Text as Text
+import qualified Data.UUID as Uuid
+import qualified U.Codebase.Sqlite.Queries as Queries
+import qualified Unison.Codebase.Path as Path
+import Unison.NameSegment (NameSegment (..))
+
+-- | Get the very hacky path from the root branch that we store a project. Users aren't supposed to go here.
+projectPath :: Queries.ProjectId -> Path.Absolute
+projectPath projectId =
+  Path.Absolute (Path.fromList ["__projects", projectNameSegment])
+  where
+    projectNameSegment :: NameSegment
+    projectNameSegment =
+      NameSegment (Text.cons '_' (Uuid.toText (Queries.unProjectId projectId)))
+
+-- | Get the very hacky path from the root branch that we store a project branch. Users aren't supposed to go here.
+projectBranchPath :: Queries.ProjectId -> Queries.BranchId -> Path.Absolute
+projectBranchPath projectId branchId =
+  Path.resolve (projectPath projectId) (Path.Relative (Path.fromList ["branches", branchNameSegment]))
+  where
+    branchNameSegment :: NameSegment
+    branchNameSegment =
+      NameSegment (Text.cons '_' (Uuid.toText (Queries.unBranchId branchId)))

unison-cli/src/Unison/Codebase/Editor/HandleInput.hs

@@ -546,11 +546,11 @@ loop e = do
               path <- Cli.resolvePath' path'
               branchExists <- Cli.branchExistsAtPath' path'
               when (not branchExists) (Cli.respond $ CreatedNewBranch path)
-              #currentPathStack %= Nel.cons path
+              Cli.cd path
             UpI -> do
               path0 <- Cli.getCurrentPath
               whenJust (unsnoc path0) \(path, _) ->
-                #currentPathStack %= Nel.cons path
+                Cli.cd path
             PopBranchI -> do
               loopState <- State.get
               case Nel.uncons (loopState ^. #currentPathStack) of
@@ -1574,6 +1574,8 @@ inputDescription input =
       branchId2 <- hp' (input ^. #branchId2)
       patch <- ps' (input ^. #patch)
       pure (Text.unwords ["diff.namespace.to-patch", branchId1, branchId2, patch])
+    ProjectCreateI {} -> wundefined
+    ProjectSwitchI {} -> wundefined
     --
     ApiI -> wat
     AuthLoginI {} -> wat
@@ -1610,8 +1612,6 @@ inputDescription input =
     PreviewAddI {} -> wat
     PreviewMergeLocalBranchI {} -> wat
     PreviewUpdateI {} -> wat
-    ProjectCreateI {} -> wat
-    ProjectSwitchI {} -> wat
     PushRemoteBranchI {} -> wat
     QuitI {} -> wat
     ShowDefinitionByPrefixI {} -> wat

unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectCreate.hs

@@ -4,9 +4,39 @@ module Unison.Codebase.Editor.HandleInput.ProjectCreate
   )
 where
 
-import Unison.Project (ProjectName)
+import qualified Data.UUID.V4 as Uuid
+import qualified U.Codebase.Sqlite.Queries as Queries
 import Unison.Cli.Monad (Cli)
+import qualified Unison.Cli.Monad as Cli
+import qualified Unison.Cli.MonadUtils as Cli (stepAt)
+import Unison.Cli.ProjectUtils (projectBranchPath)
+import Unison.Codebase.Branch (Branch0)
+import qualified Unison.Codebase.Branch as Branch
+import qualified Unison.Codebase.Path as Path
+import Unison.Prelude
+import Unison.Project (ProjectName)
+import Witch
 
 projectCreate :: ProjectName -> Cli ()
-projectCreate _projectName = do
-  pure ()
+projectCreate name = do
+  projectId <- liftIO (Queries.ProjectId <$> Uuid.nextRandom)
+  branchId <- liftIO (Queries.BranchId <$> Uuid.nextRandom)
+
+  Cli.runEitherTransaction do
+    Queries.projectExistsByName (into @Text name) >>= \case
+      False -> do
+        Queries.insertProject projectId (into @Text name)
+        Queries.insertBranch projectId branchId "main"
+        pure (Right ())
+      True -> pure (Left (error "project by that name already exists"))
+
+  let path :: Path.Absolute
+      path = projectBranchPath projectId branchId
+
+  let initialBranchContents :: Branch0 m
+      initialBranchContents =
+        Branch.empty0
+
+  Cli.stepAt "project.create" (Path.unabsolute path, const initialBranchContents)
+
+  Cli.cd path

unison-cli/unison-cli.cabal

@@ -34,6 +34,7 @@ library
       Unison.Cli.MonadUtils
       Unison.Cli.NamesUtils
       Unison.Cli.PrettyPrintUtils
+      Unison.Cli.ProjectUtils
       Unison.Cli.TypeCheck
       Unison.Cli.UnisonConfigUtils
       Unison.Codebase.Editor.AuthorInfo
@@ -201,6 +202,7 @@ library
     , unliftio
     , unordered-containers
     , uri-encode
+    , uuid
     , vector
     , wai
     , warp
@@ -330,6 +332,7 @@ executable cli-integration-tests
     , unliftio
     , unordered-containers
     , uri-encode
+    , uuid
     , vector
     , wai
     , warp
@@ -453,6 +456,7 @@ executable transcripts
     , unliftio
     , unordered-containers
     , uri-encode
+    , uuid
     , vector
     , wai
     , warp
@@ -583,6 +587,7 @@ executable unison
     , unliftio
     , unordered-containers
     , uri-encode
+    , uuid
     , vector
     , wai
     , warp
@@ -716,6 +721,7 @@ test-suite cli-tests
     , unliftio
     , unordered-containers
     , uri-encode
+    , uuid
     , vector
     , wai
     , warp