mirror of
https://github.com/unisonweb/unison.git
synced 2024-09-11 10:35:57 +03:00
fill out most of project.create
implementation
This commit is contained in:
parent
f353e087f9
commit
06811c9829
@ -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
|
||||
|
@ -84,6 +84,7 @@ dependencies:
|
||||
- unison-util-relation
|
||||
- unliftio
|
||||
- unordered-containers
|
||||
- uuid
|
||||
- vector
|
||||
- witherable
|
||||
- wai
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
30
unison-cli/src/Unison/Cli/ProjectUtils.hs
Normal file
30
unison-cli/src/Unison/Cli/ProjectUtils.hs
Normal file
@ -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)))
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user