mirror of
https://github.com/unisonweb/unison.git
synced 2024-09-11 02:25:39 +03:00
Merge pull request #4966 from unisonweb/topic/merge5
This commit is contained in:
commit
2ec8e01dd7
@ -21,8 +21,33 @@ library:
|
||||
other-modules: Paths_unison_codebase
|
||||
|
||||
default-extensions:
|
||||
- BangPatterns
|
||||
- BlockArguments
|
||||
- DeriveAnyClass
|
||||
- DeriveFunctor
|
||||
- DeriveGeneric
|
||||
- DeriveTraversable
|
||||
- DerivingStrategies
|
||||
- DerivingVia
|
||||
- DoAndIfThenElse
|
||||
- DuplicateRecordFields
|
||||
- FlexibleContexts
|
||||
- FlexibleInstances
|
||||
- GeneralizedNewtypeDeriving
|
||||
- ImportQualifiedPost
|
||||
- LambdaCase
|
||||
- MultiParamTypeClasses
|
||||
- NamedFieldPuns
|
||||
- OverloadedLabels
|
||||
- OverloadedRecordDot
|
||||
- OverloadedStrings
|
||||
- PatternSynonyms
|
||||
- RankNTypes
|
||||
- ScopedTypeVariables
|
||||
- StandaloneDeriving
|
||||
- TupleSections
|
||||
- TypeApplications
|
||||
- TypeFamilies
|
||||
- ViewPatterns
|
||||
|
||||
language: GHC2021
|
||||
|
@ -1,6 +1,6 @@
|
||||
cabal-version: 1.12
|
||||
|
||||
-- This file has been generated from package.yaml by hpack version 0.35.2.
|
||||
-- This file has been generated from package.yaml by hpack version 0.36.0.
|
||||
--
|
||||
-- see: https://github.com/sol/hpack
|
||||
|
||||
@ -31,9 +31,34 @@ library
|
||||
hs-source-dirs:
|
||||
./
|
||||
default-extensions:
|
||||
BangPatterns
|
||||
BlockArguments
|
||||
DeriveAnyClass
|
||||
DeriveFunctor
|
||||
DeriveGeneric
|
||||
DeriveTraversable
|
||||
DerivingStrategies
|
||||
DerivingVia
|
||||
DoAndIfThenElse
|
||||
DuplicateRecordFields
|
||||
FlexibleContexts
|
||||
FlexibleInstances
|
||||
GeneralizedNewtypeDeriving
|
||||
ImportQualifiedPost
|
||||
LambdaCase
|
||||
MultiParamTypeClasses
|
||||
NamedFieldPuns
|
||||
OverloadedLabels
|
||||
OverloadedRecordDot
|
||||
OverloadedStrings
|
||||
PatternSynonyms
|
||||
RankNTypes
|
||||
ScopedTypeVariables
|
||||
StandaloneDeriving
|
||||
TupleSections
|
||||
TypeApplications
|
||||
TypeFamilies
|
||||
ViewPatterns
|
||||
build-depends:
|
||||
base
|
||||
, containers
|
||||
|
@ -476,13 +476,18 @@ cons :: (Applicative m) => Branch0 m -> Branch m -> Branch m
|
||||
cons = step . const
|
||||
|
||||
-- | Construct a two-parent merge node.
|
||||
mergeNode :: forall m. Applicative m => Branch0 m -> Branch m -> Branch m -> Branch m
|
||||
mergeNode ::
|
||||
forall m.
|
||||
Applicative m =>
|
||||
Branch0 m ->
|
||||
(CausalHash, m (Branch m)) ->
|
||||
(CausalHash, m (Branch m)) ->
|
||||
Branch m
|
||||
mergeNode child parent1 parent2 =
|
||||
Branch (Causal.mergeNode child (Map.fromList [f parent1, f parent2]))
|
||||
where
|
||||
f :: Branch m -> (CausalHash, m (Causal m (Branch0 m)))
|
||||
f parent =
|
||||
(headHash parent, pure (_history parent))
|
||||
f (hash, getBranch) =
|
||||
(hash, _history <$> getBranch)
|
||||
|
||||
isOne :: Branch m -> Bool
|
||||
isOne (Branch Causal.One {}) = True
|
||||
@ -606,20 +611,17 @@ modifyAt path f = runIdentity . modifyAtM path (pure . f)
|
||||
-- Because it's a `Branch`, it overwrites the history at `path`.
|
||||
modifyAtM ::
|
||||
forall n m.
|
||||
(Functor n) =>
|
||||
(Applicative m) => -- because `Causal.cons` uses `pure`
|
||||
(Functor n, Applicative m) =>
|
||||
Path ->
|
||||
(Branch m -> n (Branch m)) ->
|
||||
Branch m ->
|
||||
n (Branch m)
|
||||
modifyAtM path f b = case Path.uncons path of
|
||||
Nothing -> f b
|
||||
Just (seg, path) -> do
|
||||
-- Functor
|
||||
Just (seg, path) ->
|
||||
let child = getChildBranch seg (head b)
|
||||
child' <- modifyAtM path f child
|
||||
-- step the branch by updating its children according to fixup
|
||||
pure $ step (setChildBranch seg child') b
|
||||
in -- step the branch by updating its children according to fixup
|
||||
(\child' -> step (setChildBranch seg child') b) <$> modifyAtM path f child
|
||||
|
||||
-- | Perform updates over many locations within a branch by batching up operations on
|
||||
-- sub-branches as much as possible without affecting semantics.
|
||||
|
@ -144,7 +144,7 @@ withRepo repo@(ReadGitRepo {url = uri, ref = mayGitRef}) branchBehavior action =
|
||||
throwExceptT $ checkForGit
|
||||
gitCachePath <- gitCacheDir uri
|
||||
-- Ensure we have the main branch in the cache dir no matter what
|
||||
throwExceptT $ cloneIfMissing repo {ref = Nothing} gitCachePath
|
||||
_ :: GitRepo <- throwExceptT $ cloneIfMissing repo {ref = Nothing} gitCachePath
|
||||
let gitCacheRepo = Bare gitCachePath
|
||||
gitRef <- case mayGitRef of
|
||||
Nothing -> fromMaybe "main" <$> getDefaultBranch gitCacheRepo
|
||||
|
@ -662,7 +662,7 @@ pushGitBranch srcConn repo behavior action = UnliftIO.try do
|
||||
C.withConnection destCodebase \destConn ->
|
||||
doSync codebaseStatus destConn newBranch
|
||||
pure (Right newBranch)
|
||||
for newBranchOrErr $ push pushStaging repo
|
||||
for_ newBranchOrErr $ push pushStaging repo
|
||||
pure newBranchOrErr
|
||||
where
|
||||
readRepo :: ReadGitRepo
|
||||
|
@ -6,6 +6,7 @@ module Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema6To7 (migrateSchem
|
||||
|
||||
import Control.Monad.Except
|
||||
import Control.Monad.State
|
||||
import U.Codebase.Branch.Type (NamespaceStats)
|
||||
import U.Codebase.Sqlite.DbId qualified as DB
|
||||
import U.Codebase.Sqlite.DbId qualified as Db
|
||||
import U.Codebase.Sqlite.Operations qualified as Ops
|
||||
@ -50,7 +51,7 @@ addStatsForBranch :: DB.BranchObjectId -> Sqlite.Transaction (Sync.TrySyncResult
|
||||
addStatsForBranch boId = do
|
||||
bhId <- Db.BranchHashId <$> Q.expectPrimaryHashIdForObject (Db.unBranchObjectId boId)
|
||||
-- "expectNamespaceStatsByHashId" computes stats if they are missing.
|
||||
Ops.expectNamespaceStatsByHashId bhId
|
||||
_ :: NamespaceStats <- Ops.expectNamespaceStatsByHashId bhId
|
||||
pure Sync.Done
|
||||
|
||||
debugLog :: String -> Sqlite.Transaction ()
|
||||
|
@ -929,7 +929,7 @@ nativeCompileCodes executable codes base path = do
|
||||
BS.hPut pin . runPutS . putWord32be . fromIntegral $ BS.length bytes
|
||||
BS.hPut pin bytes
|
||||
UnliftIO.hClose pin
|
||||
waitForProcess ph
|
||||
_ <- waitForProcess ph
|
||||
pure ()
|
||||
callout _ _ _ _ = fail "withCreateProcess didn't provide handles"
|
||||
ucrError (e :: IOException) =
|
||||
|
@ -141,11 +141,11 @@ link :: (Monad m, Var v) => TermP v m
|
||||
link = termLink <|> typeLink
|
||||
where
|
||||
typeLink = do
|
||||
P.try (reserved "typeLink") -- type opens a block, gotta use something else
|
||||
_ <- P.try (reserved "typeLink") -- type opens a block, gotta use something else
|
||||
tok <- typeLink'
|
||||
pure $ Term.typeLink (ann tok) (L.payload tok)
|
||||
termLink = do
|
||||
P.try (reserved "termLink")
|
||||
_ <- P.try (reserved "termLink")
|
||||
tok <- termLink'
|
||||
pure $ Term.termLink (ann tok) (L.payload tok)
|
||||
|
||||
@ -200,7 +200,7 @@ matchCase = do
|
||||
unit ann = Pattern.Constructor ann (ConstructorReference DD.unitRef 0) []
|
||||
pair p1 p2 = Pattern.Constructor (ann p1 <> ann p2) (ConstructorReference DD.pairRef 0) [p1, p2]
|
||||
let guardedBlocks = label "pattern guard" . some $ do
|
||||
reserved "|"
|
||||
_ <- reserved "|"
|
||||
guard <-
|
||||
asum
|
||||
[ Nothing <$ P.try (quasikeyword "otherwise"),
|
||||
@ -289,7 +289,7 @@ parsePattern = label "pattern" root
|
||||
| Set.null s -> die tok s
|
||||
| Set.size s > 1 -> die tok s
|
||||
| otherwise -> -- matched ctor name, consume the token
|
||||
do anyToken; pure (Set.findMin s <$ tok)
|
||||
do _ <- anyToken; pure (Set.findMin s <$ tok)
|
||||
where
|
||||
isLower = Text.all Char.isLower . Text.take 1 . Name.toText
|
||||
die hq s = case L.payload hq of
|
||||
@ -1054,7 +1054,7 @@ destructuringBind = do
|
||||
(p, boundVars) <- P.try do
|
||||
(p, boundVars) <- parsePattern
|
||||
let boundVars' = snd <$> boundVars
|
||||
P.lookAhead (openBlockWith "=")
|
||||
_ <- P.lookAhead (openBlockWith "=")
|
||||
pure (p, boundVars')
|
||||
(_spanAnn, scrute) <- block "=" -- Dwight K. Scrute ("The People's Scrutinee")
|
||||
let guard = Nothing
|
||||
|
@ -2197,7 +2197,7 @@ coalesceWanted' keep ((loc, n) : new) old
|
||||
if keep u
|
||||
then pure (new, (loc, n) : old)
|
||||
else do
|
||||
defaultAbility n
|
||||
_ <- defaultAbility n
|
||||
pure (new, old)
|
||||
coalesceWanted new old
|
||||
| otherwise = coalesceWanted' keep new ((loc, n) : old)
|
||||
|
@ -1,143 +0,0 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
-- | A utility type for saving memory in the presence of many duplicate ByteStrings, etc. If you have data that may be
|
||||
-- a redundant duplicate, try pinning it to a pin board, and use the result of that operation instead.
|
||||
--
|
||||
-- Without a pin board:
|
||||
--
|
||||
-- x ───── "38dce848c8c829c62"
|
||||
-- y ───── "38dce848c8c829c62"
|
||||
-- z ───── "d2518f260535b927b"
|
||||
--
|
||||
-- With a pin board:
|
||||
--
|
||||
-- x ───── "38dce848c8c829c62" ┄┄┄┄┄┐
|
||||
-- y ────────┘ board
|
||||
-- z ───── "d2518f260535b927b" ┄┄┄┄┄┘
|
||||
--
|
||||
-- ... and after x is garbage collected:
|
||||
--
|
||||
-- "38dce848c8c829c62" ┄┄┄┄┄┐
|
||||
-- y ────────┘ board
|
||||
-- z ───── "d2518f260535b927b" ┄┄┄┄┄┘
|
||||
--
|
||||
-- ... and after y is garbage collected:
|
||||
--
|
||||
-- board
|
||||
-- z ───── "d2518f260535b927b" ┄┄┄┄┄┘
|
||||
module Unison.Util.PinBoard
|
||||
( PinBoard,
|
||||
new,
|
||||
pin,
|
||||
|
||||
-- * For debugging
|
||||
debugDump,
|
||||
debugSize,
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Concurrent.MVar
|
||||
import Data.Foldable (find, foldlM)
|
||||
import Data.Functor.Compose
|
||||
import Data.Hashable (Hashable, hash)
|
||||
import Data.IntMap qualified as IntMap
|
||||
import Data.IntMap.Strict (IntMap)
|
||||
import Data.Text qualified as Text
|
||||
import Data.Text.IO qualified as Text
|
||||
import Data.Tuple (swap)
|
||||
import System.Mem.Weak (Weak, deRefWeak, mkWeakPtr)
|
||||
import Unison.Prelude
|
||||
|
||||
-- | A "pin board" is a place to pin values; semantically, it's a set, but differs in a few ways:
|
||||
--
|
||||
-- * Pinned values aren't kept alive by the pin board, they might be garbage collected at any time.
|
||||
-- * If you try to pin a value that's already pinned (per its Eq instance), the pinned one will be returned
|
||||
-- instead.
|
||||
-- * It has a small API: just 'new' and 'pin'.
|
||||
newtype PinBoard a
|
||||
= PinBoard (MVar (IntMap (Bucket a)))
|
||||
|
||||
new :: (MonadIO m) => m (PinBoard a)
|
||||
new =
|
||||
liftIO (PinBoard <$> newMVar IntMap.empty)
|
||||
|
||||
pin :: forall a m. (Eq a, Hashable a, MonadIO m) => PinBoard a -> a -> m a
|
||||
pin (PinBoard boardVar) x = liftIO do
|
||||
modifyMVar boardVar \board ->
|
||||
swap <$> getCompose (IntMap.alterF alter n board)
|
||||
where
|
||||
-- Pin to pin board at a hash key: either there's nothing there (ifMiss), or there's a nonempty bucket (ifHit).
|
||||
alter :: Maybe (Bucket a) -> Compose IO ((,) a) (Maybe (Bucket a))
|
||||
alter =
|
||||
Compose . maybe ifMiss ifHit
|
||||
-- Pin a new value: create a new singleton bucket.
|
||||
ifMiss :: IO (a, Maybe (Bucket a))
|
||||
ifMiss =
|
||||
(x,) . Just <$> newBucket x finalizer
|
||||
-- Possibly pin a new value: if it already exists in the bucket, return that one instead. Otherwise, insert it.
|
||||
ifHit :: Bucket a -> IO (a, Maybe (Bucket a))
|
||||
ifHit bucket =
|
||||
bucketFind bucket x >>= \case
|
||||
-- Hash collision: the bucket has things in it, but none are the given value. Insert.
|
||||
Nothing -> (x,) . Just <$> bucketAdd bucket x finalizer
|
||||
-- The thing being inserted already exists; return it.
|
||||
Just y -> pure (y, Just bucket)
|
||||
-- When each thing pinned here is garbage collected, compact its bucket.
|
||||
finalizer :: IO ()
|
||||
finalizer =
|
||||
modifyMVar_ boardVar (IntMap.alterF (maybe (pure Nothing) bucketCompact) n)
|
||||
n :: Int
|
||||
n =
|
||||
hash x
|
||||
|
||||
debugDump :: (MonadIO m) => (a -> Text) -> PinBoard a -> m ()
|
||||
debugDump f (PinBoard boardVar) = liftIO do
|
||||
board <- readMVar boardVar
|
||||
contents <- (traverse . traverse) bucketToList (IntMap.toList board)
|
||||
Text.putStrLn (Text.unlines ("PinBoard" : map row contents))
|
||||
where
|
||||
row (n, xs) =
|
||||
Text.pack (show n) <> " => " <> Text.pack (show (map f xs))
|
||||
|
||||
debugSize :: PinBoard a -> IO Int
|
||||
debugSize (PinBoard boardVar) = do
|
||||
board <- readMVar boardVar
|
||||
foldlM step 0 board
|
||||
where
|
||||
step :: Int -> Bucket a -> IO Int
|
||||
step acc =
|
||||
bucketToList >=> \xs -> pure (acc + length xs)
|
||||
|
||||
-- | A bucket of weak pointers to different values that all share a hash.
|
||||
newtype Bucket a
|
||||
= Bucket [Weak a] -- Invariant: non-empty list
|
||||
|
||||
-- | A singleton bucket.
|
||||
newBucket :: a -> IO () -> IO (Bucket a)
|
||||
newBucket =
|
||||
bucketAdd (Bucket [])
|
||||
|
||||
-- | Add a value to a bucket.
|
||||
bucketAdd :: Bucket a -> a -> IO () -> IO (Bucket a)
|
||||
bucketAdd (Bucket weaks) x finalizer = do
|
||||
weak <- mkWeakPtr x (Just finalizer)
|
||||
pure (Bucket (weak : weaks))
|
||||
|
||||
-- | Drop all garbage-collected values from a bucket. If none remain, returns Nothing.
|
||||
bucketCompact :: Bucket a -> IO (Maybe (Bucket a))
|
||||
bucketCompact (Bucket weaks) =
|
||||
bucketFromList <$> mapMaybeM (\w -> (w <$) <$> deRefWeak w) weaks
|
||||
|
||||
-- | Look up a value in a bucket per its Eq instance.
|
||||
bucketFind :: (Eq a) => Bucket a -> a -> IO (Maybe a)
|
||||
bucketFind bucket x =
|
||||
find (== x) <$> bucketToList bucket
|
||||
|
||||
bucketFromList :: [Weak a] -> Maybe (Bucket a)
|
||||
bucketFromList = \case
|
||||
[] -> Nothing
|
||||
weaks -> Just (Bucket weaks)
|
||||
|
||||
bucketToList :: Bucket a -> IO [a]
|
||||
bucketToList (Bucket weaks) =
|
||||
mapMaybeM deRefWeak weaks
|
@ -26,7 +26,6 @@ import Unison.Test.Typechecker qualified as Typechecker
|
||||
import Unison.Test.Typechecker.Context qualified as Context
|
||||
import Unison.Test.Typechecker.TypeError qualified as TypeError
|
||||
import Unison.Test.UnisonSources qualified as UnisonSources
|
||||
import Unison.Test.Util.PinBoard qualified as PinBoard
|
||||
import Unison.Test.Util.Relation qualified as Relation
|
||||
import Unison.Test.Util.Text qualified as Text
|
||||
import Unison.Test.Var qualified as Var
|
||||
@ -54,7 +53,6 @@ test =
|
||||
Typechecker.test,
|
||||
Context.test,
|
||||
Name.test,
|
||||
PinBoard.test,
|
||||
CodebaseInit.test,
|
||||
Branch.test
|
||||
]
|
||||
|
@ -44,7 +44,7 @@ testEval0 :: [(Reference, SuperGroup Symbol)] -> SuperGroup Symbol -> Test ()
|
||||
testEval0 env main =
|
||||
ok << io do
|
||||
cc <- baseCCache False
|
||||
cacheAdd ((mainRef, main) : env) cc
|
||||
_ <- cacheAdd ((mainRef, main) : env) cc
|
||||
rtm <- readTVarIO (refTm cc)
|
||||
apply0 Nothing cc Nothing (rtm Map.! mainRef)
|
||||
where
|
||||
|
@ -1,52 +0,0 @@
|
||||
{-# LANGUAGE MagicHash #-}
|
||||
{-# LANGUAGE UnboxedTuples #-}
|
||||
|
||||
module Unison.Test.Util.PinBoard
|
||||
( test,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.ByteString qualified as ByteString
|
||||
import EasyTest
|
||||
import GHC.Exts (isTrue#, reallyUnsafePtrEquality#, touch#)
|
||||
import GHC.IO (IO (IO))
|
||||
import System.Mem (performGC)
|
||||
import Unison.Util.PinBoard qualified as PinBoard
|
||||
|
||||
test :: Test ()
|
||||
test =
|
||||
scope "util.pinboard" . tests $
|
||||
[ scope "pinning equal values stores only one" $ do
|
||||
let b0 = ByteString.singleton 0
|
||||
let b1 = ByteString.copy b0
|
||||
|
||||
board <- PinBoard.new
|
||||
|
||||
-- pinning a thing for the first time returns it
|
||||
b0' <- PinBoard.pin board b0
|
||||
expectSamePointer b0 b0'
|
||||
|
||||
-- pinning an equal thing returns the first
|
||||
b1' <- PinBoard.pin board b1
|
||||
expectSamePointer b0 b1'
|
||||
|
||||
-- the board should only have one value in it
|
||||
expect' . (== 1) <$> io (PinBoard.debugSize board)
|
||||
|
||||
-- keep b0 alive until here
|
||||
touch b0
|
||||
|
||||
-- observe that the board doesn't keep its value alive
|
||||
io performGC
|
||||
expect' . (== 0) <$> io (PinBoard.debugSize board)
|
||||
|
||||
ok
|
||||
]
|
||||
|
||||
expectSamePointer :: a -> a -> Test ()
|
||||
expectSamePointer x y =
|
||||
expect' (isTrue# (reallyUnsafePtrEquality# x y))
|
||||
|
||||
touch :: a -> Test ()
|
||||
touch x =
|
||||
io (IO \s -> (# touch# x s, () #))
|
@ -185,7 +185,6 @@ library
|
||||
Unison.Util.EnumContainers
|
||||
Unison.Util.Exception
|
||||
Unison.Util.Logger
|
||||
Unison.Util.PinBoard
|
||||
Unison.Util.Pretty.MegaParsec
|
||||
Unison.Util.RefPromise
|
||||
Unison.Util.Star2
|
||||
@ -385,7 +384,6 @@ test-suite parser-typechecker-tests
|
||||
Unison.Test.Typechecker.Context
|
||||
Unison.Test.Typechecker.TypeError
|
||||
Unison.Test.UnisonSources
|
||||
Unison.Test.Util.PinBoard
|
||||
Unison.Test.Util.Pretty
|
||||
Unison.Test.Util.Relation
|
||||
Unison.Test.Util.Text
|
||||
|
32
unison-cli/src/Unison/Cli/MergeTypes.hs
Normal file
32
unison-cli/src/Unison/Cli/MergeTypes.hs
Normal file
@ -0,0 +1,32 @@
|
||||
-- | Common types related to merge, pulled down far enough to be imported by all interested parties.
|
||||
module Unison.Cli.MergeTypes
|
||||
( MergeSource (..),
|
||||
MergeTarget,
|
||||
MergeSourceAndTarget (..),
|
||||
MergeSourceOrTarget (..),
|
||||
)
|
||||
where
|
||||
|
||||
import Unison.Codebase.Editor.RemoteRepo (ReadGitRemoteNamespace, ReadShareLooseCode)
|
||||
import Unison.Project (ProjectAndBranch, ProjectBranchName, ProjectName)
|
||||
|
||||
-- | What are we merging in?
|
||||
data MergeSource
|
||||
= MergeSource'LocalProjectBranch !(ProjectAndBranch ProjectName ProjectBranchName)
|
||||
| MergeSource'RemoteProjectBranch !(ProjectAndBranch ProjectName ProjectBranchName)
|
||||
| MergeSource'RemoteLooseCode !ReadShareLooseCode
|
||||
| MergeSource'RemoteGitRepo !ReadGitRemoteNamespace
|
||||
|
||||
type MergeTarget =
|
||||
ProjectAndBranch ProjectName ProjectBranchName
|
||||
|
||||
-- | "Alice and Bob"
|
||||
data MergeSourceAndTarget = MergeSourceAndTarget
|
||||
{ alice :: !MergeTarget,
|
||||
bob :: !MergeSource
|
||||
}
|
||||
|
||||
-- | "Either Alice Bob"
|
||||
data MergeSourceOrTarget
|
||||
= MergeSourceOrTarget'Source !MergeSource
|
||||
| MergeSourceOrTarget'Target !MergeTarget
|
@ -19,6 +19,8 @@ module Unison.Cli.Pretty
|
||||
prettyLabeledDependencies,
|
||||
prettyPath,
|
||||
prettyPath',
|
||||
prettyMergeSource,
|
||||
prettyMergeSourceOrTarget,
|
||||
prettyProjectAndBranchName,
|
||||
prettyBranchName,
|
||||
prettyProjectBranchName,
|
||||
@ -69,6 +71,7 @@ import U.Codebase.Sqlite.Project qualified as Sqlite
|
||||
import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite
|
||||
import U.Util.Base32Hex (Base32Hex)
|
||||
import U.Util.Base32Hex qualified as Base32Hex
|
||||
import Unison.Cli.MergeTypes (MergeSource (..), MergeSourceOrTarget (..))
|
||||
import Unison.Cli.ProjectUtils (projectBranchPathPrism)
|
||||
import Unison.Cli.Share.Projects.Types qualified as Share
|
||||
import Unison.Codebase.Editor.DisplayObject (DisplayObject (BuiltinObject, MissingObject, UserObject))
|
||||
@ -76,7 +79,7 @@ import Unison.Codebase.Editor.Input qualified as Input
|
||||
import Unison.Codebase.Editor.Output
|
||||
import Unison.Codebase.Editor.RemoteRepo
|
||||
( ReadGitRepo,
|
||||
ReadRemoteNamespace,
|
||||
ReadRemoteNamespace (..),
|
||||
ShareUserHandle (..),
|
||||
WriteGitRepo,
|
||||
WriteRemoteNamespace (..),
|
||||
@ -225,6 +228,18 @@ prettyHash = prettyBase32Hex# . Hash.toBase32Hex
|
||||
prettyHash32 :: (IsString s) => Hash32 -> P.Pretty s
|
||||
prettyHash32 = prettyBase32Hex# . Hash32.toBase32Hex
|
||||
|
||||
prettyMergeSource :: MergeSource -> Pretty
|
||||
prettyMergeSource = \case
|
||||
MergeSource'LocalProjectBranch branch -> prettyProjectAndBranchName branch
|
||||
MergeSource'RemoteProjectBranch branch -> "remote " <> prettyProjectAndBranchName branch
|
||||
MergeSource'RemoteLooseCode info -> prettyReadRemoteNamespace (ReadShare'LooseCode info)
|
||||
MergeSource'RemoteGitRepo info -> prettyReadRemoteNamespace (ReadRemoteNamespaceGit info)
|
||||
|
||||
prettyMergeSourceOrTarget :: MergeSourceOrTarget -> Pretty
|
||||
prettyMergeSourceOrTarget = \case
|
||||
MergeSourceOrTarget'Target alice -> prettyProjectAndBranchName alice
|
||||
MergeSourceOrTarget'Source bob -> prettyMergeSource bob
|
||||
|
||||
prettyProjectName :: ProjectName -> Pretty
|
||||
prettyProjectName =
|
||||
P.green . P.text . into @Text
|
||||
|
@ -435,8 +435,11 @@ loop e = do
|
||||
let destp = looseCodeOrProjectToPath dest0
|
||||
srcb <- Cli.expectBranchAtPath' srcp
|
||||
dest <- Cli.resolvePath' destp
|
||||
-- todo: fixme: use project and branch names
|
||||
let err = Just $ MergeAlreadyUpToDate src0 dest0
|
||||
let err =
|
||||
Just $
|
||||
MergeAlreadyUpToDate
|
||||
((\x -> ProjectAndBranch x.project.name x.branch.name) <$> src0)
|
||||
((\x -> ProjectAndBranch x.project.name x.branch.name) <$> dest0)
|
||||
mergeBranchAndPropagateDefaultPatch mergeMode description err srcb (Just dest0) dest
|
||||
PreviewMergeLocalBranchI src0 dest0 -> do
|
||||
Cli.Env {codebase} <- ask
|
||||
@ -1025,7 +1028,7 @@ loop e = do
|
||||
pped <- Cli.currentPrettyPrintEnvDecl
|
||||
let suffixifiedPPE = PPED.suffixifiedPPE pped
|
||||
Cli.respondNumbered $ ListEdits patch suffixifiedPPE
|
||||
PullRemoteBranchI sourceTarget pMode verbosity -> handlePull sourceTarget pMode verbosity
|
||||
PullI sourceTarget pullMode -> handlePull sourceTarget pullMode
|
||||
PushRemoteBranchI pushRemoteBranchInput -> handlePushRemoteBranch pushRemoteBranchInput
|
||||
ListDependentsI hq -> handleDependents hq
|
||||
ListDependenciesI hq -> handleDependencies hq
|
||||
@ -1169,7 +1172,6 @@ loop e = do
|
||||
DeprecateTypeI {} -> Cli.respond NotImplemented
|
||||
RemoveTermReplacementI from patchPath -> doRemoveReplacement from patchPath True
|
||||
RemoveTypeReplacementI from patchPath -> doRemoveReplacement from patchPath False
|
||||
ShowDefinitionByPrefixI {} -> Cli.respond NotImplemented
|
||||
UpdateBuiltinsI -> Cli.respond NotImplemented
|
||||
QuitI -> Cli.haltRepl
|
||||
GistI input -> handleGist input
|
||||
@ -1391,11 +1393,10 @@ inputDescription input =
|
||||
ProjectRenameI {} -> wat
|
||||
ProjectSwitchI {} -> wat
|
||||
ProjectsI -> wat
|
||||
PullRemoteBranchI {} -> wat
|
||||
PullI {} -> wat
|
||||
PushRemoteBranchI {} -> wat
|
||||
QuitI {} -> wat
|
||||
ReleaseDraftI {} -> wat
|
||||
ShowDefinitionByPrefixI {} -> wat
|
||||
ShowDefinitionI {} -> wat
|
||||
EditNamespaceI paths ->
|
||||
pure $ Text.unwords ("edit.namespace" : (Path.toText <$> paths))
|
||||
|
@ -1,5 +1,12 @@
|
||||
module Unison.Codebase.Editor.HandleInput.Merge2
|
||||
( handleMerge,
|
||||
|
||||
-- * API exported for @pull@
|
||||
MergeInfo (..),
|
||||
AliceMergeInfo (..),
|
||||
BobMergeInfo (..),
|
||||
LcaMergeInfo (..),
|
||||
doMerge,
|
||||
)
|
||||
where
|
||||
|
||||
@ -12,9 +19,12 @@ import Data.Bitraversable (bitraverse)
|
||||
import Data.Foldable qualified as Foldable
|
||||
import Data.List qualified as List
|
||||
import Data.List.NonEmpty (pattern (:|))
|
||||
import Data.List.NonEmpty qualified as List.NonEmpty
|
||||
import Data.Map.Strict qualified as Map
|
||||
import Data.Semialign (align, unzip)
|
||||
import Data.Set qualified as Set
|
||||
import Data.Set.NonEmpty (NESet)
|
||||
import Data.Set.NonEmpty qualified as Set.NonEmpty
|
||||
import Data.Text qualified as Text
|
||||
import Data.Text.IO qualified as Text
|
||||
import Data.These (These (..))
|
||||
@ -24,13 +34,16 @@ import Text.Builder qualified as Text (Builder)
|
||||
import U.Codebase.Branch qualified as V2 (Branch (..), CausalBranch)
|
||||
import U.Codebase.Branch qualified as V2.Branch
|
||||
import U.Codebase.Causal qualified as V2.Causal
|
||||
import U.Codebase.HashTags (unCausalHash)
|
||||
import U.Codebase.HashTags (CausalHash, unCausalHash)
|
||||
import U.Codebase.Reference (Reference, TermReferenceId, TypeReference, TypeReferenceId)
|
||||
import U.Codebase.Referent qualified as V2 (Referent)
|
||||
import U.Codebase.Sqlite.DbId (ProjectId)
|
||||
import U.Codebase.Sqlite.Operations qualified as Operations
|
||||
import U.Codebase.Sqlite.Project (Project (..))
|
||||
import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..))
|
||||
import U.Codebase.Sqlite.Queries qualified as Queries
|
||||
import Unison.Builtin.Decls qualified as Builtin.Decls
|
||||
import Unison.Cli.MergeTypes (MergeSource (..), MergeSourceOrTarget (..), MergeSourceAndTarget (..))
|
||||
import Unison.Cli.Monad (Cli)
|
||||
import Unison.Cli.Monad qualified as Cli
|
||||
import Unison.Cli.MonadUtils qualified as Cli
|
||||
@ -47,8 +60,9 @@ import Unison.Codebase.Editor.HandleInput.Update2
|
||||
prettyParseTypecheck2,
|
||||
typecheckedUnisonFileToBranchAdds,
|
||||
)
|
||||
import Unison.Codebase.Editor.Output (Output)
|
||||
import Unison.Codebase.Editor.Output qualified as Output
|
||||
import Unison.Codebase.Editor.RemoteRepo (ReadGitRemoteNamespace (..), ReadShareLooseCode (..))
|
||||
import Unison.Codebase.Path (Path)
|
||||
import Unison.Codebase.Path qualified as Path
|
||||
import Unison.Codebase.SqliteCodebase.Branch.Cache (newBranchCache)
|
||||
import Unison.Codebase.SqliteCodebase.Conversions qualified as Conversions
|
||||
@ -71,7 +85,6 @@ import Unison.Merge.EitherWayI (EitherWayI (..))
|
||||
import Unison.Merge.EitherWayI qualified as EitherWayI
|
||||
import Unison.Merge.Libdeps qualified as Merge
|
||||
import Unison.Merge.PartitionCombinedDiffs (partitionCombinedDiffs)
|
||||
import Unison.Merge.PreconditionViolation qualified as Merge
|
||||
import Unison.Merge.Synhashed (Synhashed (..))
|
||||
import Unison.Merge.Synhashed qualified as Synhashed
|
||||
import Unison.Merge.ThreeWay (ThreeWay (..))
|
||||
@ -111,12 +124,12 @@ import Unison.Typechecker qualified as Typechecker
|
||||
import Unison.Util.BiMultimap (BiMultimap)
|
||||
import Unison.Util.BiMultimap qualified as BiMultimap
|
||||
import Unison.Util.Defns (Defns (..), DefnsF, DefnsF2, DefnsF3, alignDefnsWith, defnsAreEmpty, zipDefnsWith, zipDefnsWith3)
|
||||
import Unison.Util.Monoid qualified as Monoid
|
||||
import Unison.Util.Nametree (Nametree (..), flattenNametree, traverseNametreeWithName, unflattenNametree)
|
||||
import Unison.Util.Pretty (ColorText, Pretty)
|
||||
import Unison.Util.Pretty qualified as Pretty
|
||||
import Unison.Util.Relation (Relation)
|
||||
import Unison.Util.Relation qualified as Relation
|
||||
import Unison.Util.Set qualified as Set
|
||||
import Unison.Util.Star2 (Star2)
|
||||
import Unison.Util.Star2 qualified as Star2
|
||||
import Unison.Util.SyntaxText (SyntaxText')
|
||||
@ -125,45 +138,114 @@ import Witch (unsafeFrom)
|
||||
import Prelude hiding (unzip, zip, zipWith)
|
||||
|
||||
handleMerge :: ProjectAndBranch (Maybe ProjectName) ProjectBranchName -> Cli ()
|
||||
handleMerge bobSpecifier = do
|
||||
handleMerge (ProjectAndBranch maybeBobProjectName bobBranchName) = do
|
||||
-- Assert that Alice (us) is on a project branch, and grab the causal hash.
|
||||
(ProjectAndBranch aliceProject aliceProjectBranch, _path) <- Cli.expectCurrentProjectBranch
|
||||
aliceCausalHash <- Cli.runTransaction (projectBranchToCausalHash aliceProjectBranch)
|
||||
|
||||
-- Resolve Bob's maybe-project-name + branch-name to the info the merge algorithm needs: the project name, branch
|
||||
-- name, and causal hash.
|
||||
bobProject <-
|
||||
case maybeBobProjectName of
|
||||
Nothing -> pure aliceProject
|
||||
Just bobProjectName
|
||||
| bobProjectName == aliceProject.name -> pure aliceProject
|
||||
| otherwise -> do
|
||||
Cli.runTransaction (Queries.loadProjectByName bobProjectName)
|
||||
& onNothingM (Cli.returnEarly (Output.LocalProjectDoesntExist bobProjectName))
|
||||
bobProjectBranch <- Cli.expectProjectBranchByName bobProject bobBranchName
|
||||
bobCausalHash <- Cli.runTransaction (projectBranchToCausalHash bobProjectBranch)
|
||||
|
||||
-- Using Alice and Bob's causal hashes, find the LCA (if it exists)
|
||||
lcaCausalHash <- Cli.runTransaction (Operations.lca aliceCausalHash bobCausalHash)
|
||||
|
||||
-- Do the merge!
|
||||
doMerge
|
||||
MergeInfo
|
||||
{ alice =
|
||||
AliceMergeInfo
|
||||
{ causalHash = aliceCausalHash,
|
||||
project = aliceProject,
|
||||
projectBranch = aliceProjectBranch
|
||||
},
|
||||
bob =
|
||||
BobMergeInfo
|
||||
{ causalHash = bobCausalHash,
|
||||
source = MergeSource'LocalProjectBranch (ProjectAndBranch bobProject.name bobBranchName)
|
||||
},
|
||||
lca =
|
||||
LcaMergeInfo
|
||||
{ causalHash = lcaCausalHash
|
||||
},
|
||||
description = "merge " <> into @Text (ProjectAndBranch bobProject.name bobBranchName)
|
||||
}
|
||||
where
|
||||
projectBranchToCausalHash :: ProjectBranch -> Transaction CausalHash
|
||||
projectBranchToCausalHash branch = do
|
||||
let path = Cli.projectBranchPath (ProjectAndBranch branch.projectId branch.branchId)
|
||||
causal <- Codebase.getShallowCausalFromRoot Nothing (Path.unabsolute path)
|
||||
pure causal.causalHash
|
||||
|
||||
data MergeInfo = MergeInfo
|
||||
{ alice :: !AliceMergeInfo,
|
||||
bob :: BobMergeInfo,
|
||||
lca :: !LcaMergeInfo,
|
||||
-- | How should we describe this merge in the reflog?
|
||||
description :: !Text
|
||||
}
|
||||
|
||||
data AliceMergeInfo = AliceMergeInfo
|
||||
{ causalHash :: !CausalHash,
|
||||
project :: !Project,
|
||||
projectBranch :: !ProjectBranch
|
||||
}
|
||||
|
||||
data BobMergeInfo = BobMergeInfo
|
||||
{ causalHash :: !CausalHash,
|
||||
source :: !MergeSource
|
||||
}
|
||||
|
||||
newtype LcaMergeInfo = LcaMergeInfo
|
||||
{ causalHash :: Maybe CausalHash
|
||||
}
|
||||
|
||||
doMerge :: MergeInfo -> Cli ()
|
||||
doMerge info = do
|
||||
let debugFunctions =
|
||||
if Debug.shouldDebug Debug.Merge
|
||||
then realDebugFunctions
|
||||
else fakeDebugFunctions
|
||||
|
||||
let alicePath = Cli.projectBranchPath (ProjectAndBranch info.alice.project.projectId info.alice.projectBranch.branchId)
|
||||
let aliceBranchNames = ProjectAndBranch info.alice.project.name info.alice.projectBranch.name
|
||||
let mergeSource = MergeSourceOrTarget'Source info.bob.source
|
||||
let mergeTarget = MergeSourceOrTarget'Target aliceBranchNames
|
||||
let mergeSourceAndTarget = MergeSourceAndTarget { alice = aliceBranchNames, bob = info.bob.source }
|
||||
|
||||
Cli.Env {codebase} <- ask
|
||||
|
||||
-- If alice == bob, or LCA == bob (so alice is ahead of bob), then we are done.
|
||||
when (info.alice.causalHash == info.bob.causalHash || info.lca.causalHash == Just info.bob.causalHash) do
|
||||
Cli.returnEarly (Output.MergeAlreadyUpToDate2 mergeSourceAndTarget)
|
||||
|
||||
-- Otherwise, if LCA == alice (so alice is behind bob), then we could fast forward to bob, so we're done.
|
||||
when (info.lca.causalHash == Just info.alice.causalHash) do
|
||||
bobBranch <- liftIO (Codebase.expectBranchForHash codebase info.bob.causalHash)
|
||||
_ <- Cli.updateAt info.description alicePath (\_aliceBranch -> bobBranch)
|
||||
Cli.returnEarly (Output.MergeSuccessFastForward mergeSourceAndTarget)
|
||||
|
||||
-- Create a bunch of cached database lookup functions
|
||||
db <- makeMergeDatabase codebase
|
||||
|
||||
-- Load the current project branch ("Alice"), and the branch from the same project to merge in ("Bob")
|
||||
info <- loadMergeInfo bobSpecifier
|
||||
let projectAndBranchNames = (\x -> ProjectAndBranch x.project.name x.branch.name) <$> info.branches
|
||||
|
||||
-- Load Alice/Bob/LCA causals
|
||||
causals <-
|
||||
Cli.runTransaction do
|
||||
alice <- Codebase.getShallowCausalFromRoot Nothing (Path.unabsolute info.paths.alice)
|
||||
bob <- Codebase.getShallowCausalFromRoot Nothing (Path.unabsolute info.paths.bob)
|
||||
lca <-
|
||||
Operations.lca alice.causalHash bob.causalHash >>= \case
|
||||
Nothing -> pure Nothing
|
||||
Just lcaCausalHash -> Just <$> db.loadCausal lcaCausalHash
|
||||
pure TwoOrThreeWay {lca, alice, bob}
|
||||
|
||||
-- If alice == bob, then we are done.
|
||||
when (causals.alice == causals.bob) do
|
||||
Cli.returnEarly (Output.MergeAlreadyUpToDate (Right info.branches.bob) (Right info.branches.alice))
|
||||
|
||||
-- Otherwise, if LCA == bob, then we are ahead of bob, so we are done.
|
||||
when (causals.lca == Just causals.bob) do
|
||||
Cli.returnEarly (Output.MergeAlreadyUpToDate (Right info.branches.bob) (Right info.branches.alice))
|
||||
|
||||
-- Otherwise, if LCA == alice, then we can fast forward to bob, and we're done.
|
||||
when (causals.lca == Just causals.alice) do
|
||||
bobBranch <- Cli.getBranchAt info.paths.bob
|
||||
_ <- Cli.updateAt (textualDescriptionOfMerge info) info.paths.alice (\_aliceBranch -> bobBranch)
|
||||
Cli.returnEarly (Output.MergeSuccessFastForward projectAndBranchNames.alice projectAndBranchNames.bob)
|
||||
causals <- Cli.runTransaction do
|
||||
traverse
|
||||
Operations.expectCausalBranchByCausalHash
|
||||
TwoOrThreeWay
|
||||
{ alice = info.alice.causalHash,
|
||||
bob = info.bob.causalHash,
|
||||
lca = info.lca.causalHash
|
||||
}
|
||||
|
||||
liftIO (debugFunctions.debugCausals causals)
|
||||
|
||||
@ -175,25 +257,64 @@ handleMerge bobSpecifier = do
|
||||
lca <- for causals.lca \causal -> causal.value
|
||||
pure TwoOrThreeWay {lca, alice, bob}
|
||||
|
||||
-- Assert that neither Alice nor Bob have defns in lib
|
||||
for_ [(mergeTarget, branches.alice), (mergeSource, branches.bob)] \(who, branch) -> do
|
||||
libdeps <-
|
||||
case Map.lookup NameSegment.libSegment branch.children of
|
||||
Nothing -> pure V2.Branch.empty
|
||||
Just libdeps -> Cli.runTransaction libdeps.value
|
||||
when (not (Map.null libdeps.terms) || not (Map.null libdeps.types)) do
|
||||
Cli.returnEarly (Output.MergeDefnsInLib who)
|
||||
|
||||
-- Load Alice/Bob/LCA definitions and decl name lookups
|
||||
(defns3, declNameLookups3) <-
|
||||
Cli.runTransactionWithRollback \abort -> do
|
||||
loadDefns abort db (view #branch <$> info.branches) branches
|
||||
(defns3, declNameLookups3) <- do
|
||||
let load = \case
|
||||
Nothing ->
|
||||
pure
|
||||
( Nametree {value = Defns Map.empty Map.empty, children = Map.empty},
|
||||
DeclNameLookup Map.empty Map.empty
|
||||
)
|
||||
Just (who, branch) -> do
|
||||
defns <-
|
||||
Cli.runTransaction (loadNamespaceDefinitions (referent2to1 db) branch) & onLeftM \conflictedName ->
|
||||
Cli.returnEarly case conflictedName of
|
||||
ConflictedName'Term name refs -> Output.MergeConflictedTermName name refs
|
||||
ConflictedName'Type name refs -> Output.MergeConflictedTypeName name refs
|
||||
declNameLookup <-
|
||||
Cli.runTransaction (checkDeclCoherency db.loadDeclNumConstructors defns) & onLeftM \err ->
|
||||
Cli.returnEarly case err of
|
||||
IncoherentDeclReason'ConstructorAlias name1 name2 ->
|
||||
Output.MergeConstructorAlias who name1 name2
|
||||
IncoherentDeclReason'MissingConstructorName name -> Output.MergeMissingConstructorName who name
|
||||
IncoherentDeclReason'NestedDeclAlias shorterName longerName ->
|
||||
Output.MergeNestedDeclAlias who shorterName longerName
|
||||
IncoherentDeclReason'StrayConstructor name -> Output.MergeStrayConstructor who name
|
||||
pure (defns, declNameLookup)
|
||||
|
||||
(aliceDefns0, aliceDeclNameLookup) <- load (Just (Just mergeTarget, branches.alice))
|
||||
(bobDefns0, bobDeclNameLookup) <- load (Just (Just mergeSource, branches.bob))
|
||||
(lcaDefns0, lcaDeclNameLookup) <- load ((Nothing,) <$> branches.lca)
|
||||
|
||||
let flatten defns = Defns (flattenNametree (view #terms) defns) (flattenNametree (view #types) defns)
|
||||
let defns3 = flatten <$> ThreeWay {alice = aliceDefns0, bob = bobDefns0, lca = lcaDefns0}
|
||||
let declNameLookups3 = ThreeWay {alice = aliceDeclNameLookup, bob = bobDeclNameLookup, lca = lcaDeclNameLookup}
|
||||
|
||||
pure (defns3, declNameLookups3)
|
||||
|
||||
let defns = ThreeWay.forgetLca defns3
|
||||
let declNameLookups = ThreeWay.forgetLca declNameLookups3
|
||||
|
||||
liftIO (debugFunctions.debugDefns defns3 declNameLookups3)
|
||||
|
||||
-- Diff LCA->Alice and LCA->Bob
|
||||
diffs <-
|
||||
Cli.runTransaction do
|
||||
Merge.nameBasedNamespaceDiff db declNameLookups3 defns3
|
||||
diffs <- Cli.runTransaction (Merge.nameBasedNamespaceDiff db declNameLookups3 defns3)
|
||||
|
||||
liftIO (debugFunctions.debugDiffs diffs)
|
||||
|
||||
-- Bail early if it looks like we can't proceed with the merge, because Alice or Bob has one or more conflicted alias
|
||||
whenJust (findOneConflictedAlias (view #branch <$> info.branches) defns3.lca diffs) \violation ->
|
||||
Cli.returnEarly (mergePreconditionViolationToOutput violation)
|
||||
for_ ((,) <$> TwoWay mergeTarget mergeSource <*> diffs) \(who, diff) ->
|
||||
whenJust (findConflictedAlias defns3.lca diff) \(name1, name2) ->
|
||||
Cli.returnEarly (Output.MergeConflictedAliases who name1 name2)
|
||||
|
||||
-- Combine the LCA->Alice and LCA->Bob diffs together
|
||||
let diff = combineDiffs diffs
|
||||
@ -203,7 +324,7 @@ handleMerge bobSpecifier = do
|
||||
-- Partition the combined diff into the conflicted things and the unconflicted things
|
||||
(conflicts, unconflicts) <-
|
||||
partitionCombinedDiffs defns declNameLookups diff & onLeft \name ->
|
||||
Cli.returnEarly (mergePreconditionViolationToOutput (Merge.ConflictInvolvingBuiltin name))
|
||||
Cli.returnEarly (Output.MergeConflictInvolvingBuiltin name)
|
||||
|
||||
liftIO (debugFunctions.debugPartitionedDiff conflicts unconflicts)
|
||||
|
||||
@ -272,7 +393,27 @@ handleMerge bobSpecifier = do
|
||||
<*> hydratedThings
|
||||
<*> ppes
|
||||
|
||||
let prettyUnisonFile = makePrettyUnisonFile (into @Text <$> projectAndBranchNames) renderedConflicts renderedDependents
|
||||
let prettyUnisonFile =
|
||||
makePrettyUnisonFile
|
||||
TwoWay
|
||||
{ alice = into @Text aliceBranchNames,
|
||||
bob =
|
||||
case info.bob.source of
|
||||
MergeSource'LocalProjectBranch bobBranchNames -> into @Text bobBranchNames
|
||||
MergeSource'RemoteProjectBranch bobBranchNames
|
||||
| aliceBranchNames == bobBranchNames -> "remote " <> into @Text bobBranchNames
|
||||
| otherwise -> into @Text bobBranchNames
|
||||
MergeSource'RemoteLooseCode info ->
|
||||
case Path.toName info.path of
|
||||
Nothing -> "<root>"
|
||||
Just name -> Name.toText name
|
||||
MergeSource'RemoteGitRepo info ->
|
||||
case Path.toName info.path of
|
||||
Nothing -> "<root>"
|
||||
Just name -> Name.toText name
|
||||
}
|
||||
renderedConflicts
|
||||
renderedDependents
|
||||
|
||||
let stageOneBranch = defnsAndLibdepsToBranch0 codebase stageOne mergedLibdeps
|
||||
|
||||
@ -287,84 +428,38 @@ handleMerge bobSpecifier = do
|
||||
parsingEnv <- makeParsingEnv currentPath (Branch.toNames stageOneBranch)
|
||||
prettyParseTypecheck2 prettyUnisonFile parsingEnv <&> eitherToMaybe
|
||||
|
||||
let parents =
|
||||
(\causal -> (causal.causalHash, Codebase.expectBranchForHash codebase causal.causalHash)) <$> causals
|
||||
|
||||
case maybeTypecheckedUnisonFile of
|
||||
Nothing -> do
|
||||
Cli.Env {writeSource} <- ask
|
||||
aliceBranch <- Cli.getBranchAt info.paths.alice
|
||||
bobBranch <- Cli.getBranchAt info.paths.bob
|
||||
_temporaryBranchId <-
|
||||
HandleInput.Branch.doCreateBranch'
|
||||
(Branch.mergeNode stageOneBranch aliceBranch bobBranch)
|
||||
(Branch.mergeNode stageOneBranch parents.alice parents.bob)
|
||||
Nothing
|
||||
info.branches.alice.project
|
||||
(findTemporaryBranchName info)
|
||||
(textualDescriptionOfMerge info)
|
||||
info.alice.project
|
||||
(findTemporaryBranchName info.alice.project.projectId mergeSourceAndTarget)
|
||||
info.description
|
||||
scratchFilePath <-
|
||||
Cli.getLatestFile <&> \case
|
||||
Nothing -> "scratch.u"
|
||||
Just (file, _) -> file
|
||||
liftIO $ writeSource (Text.pack scratchFilePath) (Text.pack $ Pretty.toPlain 80 prettyUnisonFile)
|
||||
Cli.respond $
|
||||
Output.MergeFailure
|
||||
scratchFilePath
|
||||
projectAndBranchNames.alice
|
||||
projectAndBranchNames.bob
|
||||
Cli.respond (Output.MergeFailure scratchFilePath mergeSourceAndTarget)
|
||||
Just tuf -> do
|
||||
Cli.runTransaction (Codebase.addDefsToCodebase codebase tuf)
|
||||
bobBranch <- Cli.getBranchAt info.paths.bob
|
||||
let stageTwoBranch = Branch.batchUpdates (typecheckedUnisonFileToBranchAdds tuf) stageOneBranch
|
||||
_ <-
|
||||
Cli.updateAt
|
||||
(textualDescriptionOfMerge info)
|
||||
info.paths.alice
|
||||
(\aliceBranch -> Branch.mergeNode stageTwoBranch aliceBranch bobBranch)
|
||||
Cli.respond (Output.MergeSuccess projectAndBranchNames.alice projectAndBranchNames.bob)
|
||||
info.description
|
||||
alicePath
|
||||
(\_aliceBranch -> Branch.mergeNode stageTwoBranch parents.alice parents.bob)
|
||||
Cli.respond (Output.MergeSuccess mergeSourceAndTarget)
|
||||
|
||||
------------------------------------------------------------------------------------------------------------------------
|
||||
-- Loading basic info out of the database
|
||||
|
||||
loadMergeInfo :: ProjectAndBranch (Maybe ProjectName) ProjectBranchName -> Cli MergeInfo
|
||||
loadMergeInfo (ProjectAndBranch maybeBobProjectName bobBranchName) = do
|
||||
(aliceProjectBranch, _path) <- Cli.expectCurrentProjectBranch
|
||||
bobProjectBranch <-
|
||||
Cli.expectProjectAndBranchByTheseNames case maybeBobProjectName of
|
||||
Nothing -> That bobBranchName
|
||||
Just bobProjectName -> These bobProjectName bobBranchName
|
||||
let alicePath = Cli.projectBranchPath (ProjectAndBranch aliceProjectBranch.project.projectId aliceProjectBranch.branch.branchId)
|
||||
let bobPath = Cli.projectBranchPath (ProjectAndBranch bobProjectBranch.project.projectId bobProjectBranch.branch.branchId)
|
||||
pure
|
||||
MergeInfo
|
||||
{ paths = TwoWay alicePath bobPath,
|
||||
branches = TwoWay aliceProjectBranch bobProjectBranch
|
||||
}
|
||||
|
||||
loadDefns ::
|
||||
(forall a. Output -> Transaction a) ->
|
||||
MergeDatabase ->
|
||||
TwoWay ProjectBranch ->
|
||||
TwoOrThreeWay (V2.Branch Transaction) ->
|
||||
Transaction
|
||||
( ThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)),
|
||||
ThreeWay DeclNameLookup
|
||||
)
|
||||
loadDefns abort0 db projectBranches branches = do
|
||||
lcaDefns0 <-
|
||||
case branches.lca of
|
||||
Nothing -> pure Nametree {value = Defns Map.empty Map.empty, children = Map.empty}
|
||||
Just lcaBranch -> loadNamespaceInfo abort db lcaBranch
|
||||
aliceDefns0 <- loadNamespaceInfo abort db branches.alice
|
||||
bobDefns0 <- loadNamespaceInfo abort db branches.bob
|
||||
|
||||
lca <- assertNamespaceSatisfiesPreconditions db abort Nothing (fromMaybe V2.Branch.empty branches.lca) lcaDefns0
|
||||
alice <- assertNamespaceSatisfiesPreconditions db abort (Just projectBranches.alice.name) branches.alice aliceDefns0
|
||||
bob <- assertNamespaceSatisfiesPreconditions db abort (Just projectBranches.bob.name) branches.bob bobDefns0
|
||||
|
||||
pure (unzip ThreeWay {lca, alice, bob})
|
||||
where
|
||||
abort :: Merge.PreconditionViolation -> Transaction void
|
||||
abort =
|
||||
abort0 . mergePreconditionViolationToOutput
|
||||
|
||||
loadLibdeps ::
|
||||
TwoOrThreeWay (V2.Branch Transaction) ->
|
||||
Transaction (ThreeWay (Map NameSegment (V2.CausalBranch Transaction)))
|
||||
@ -501,13 +596,16 @@ makePrettyUnisonFile authors conflicts dependents =
|
||||
bob = prettyBinding (Just (Pretty.text authors.bob))
|
||||
in bifoldMap f f
|
||||
),
|
||||
if TwoWay.or (not . defnsAreEmpty <$> dependents)
|
||||
then
|
||||
fold
|
||||
[ "-- The definitions below are not conflicted, but they each depend on one or more\n",
|
||||
"-- conflicted definitions above.\n\n"
|
||||
]
|
||||
else mempty,
|
||||
-- Show message that delineates where conflicts end and dependents begin only when there are both conflicts and
|
||||
-- dependents
|
||||
let thereAre defns = TwoWay.or (not . defnsAreEmpty <$> defns)
|
||||
in if thereAre conflicts && thereAre dependents
|
||||
then
|
||||
fold
|
||||
[ "-- The definitions below are not conflicted, but they each depend on one or more\n",
|
||||
"-- conflicted definitions above.\n\n"
|
||||
]
|
||||
else mempty,
|
||||
dependents
|
||||
-- Merge dependents together into one map (they are disjoint)
|
||||
& TwoWay.twoWay (zipDefnsWith Map.union Map.union)
|
||||
@ -621,17 +719,6 @@ nametreeToBranch0 nametree =
|
||||
rel2star rel =
|
||||
Star2.Star2 {fact = Relation.dom rel, d1 = rel, d2 = Relation.empty}
|
||||
|
||||
data MergeInfo = MergeInfo
|
||||
{ paths :: !(TwoWay Path.Absolute),
|
||||
branches :: !(TwoWay (ProjectAndBranch Project ProjectBranch))
|
||||
}
|
||||
deriving stock (Generic)
|
||||
|
||||
textualDescriptionOfMerge :: MergeInfo -> Text
|
||||
textualDescriptionOfMerge info =
|
||||
let bobBranchText = into @Text (ProjectAndBranch info.branches.bob.project.name info.branches.bob.branch.name)
|
||||
in "merge " <> bobBranchText
|
||||
|
||||
-- FIXME: let's come up with a better term for "dependencies" in the implementation of this function
|
||||
identifyDependents ::
|
||||
TwoWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)) ->
|
||||
@ -749,30 +836,40 @@ defnsToNames defns =
|
||||
types = Relation.fromMap (BiMultimap.range defns.types)
|
||||
}
|
||||
|
||||
findTemporaryBranchName :: MergeInfo -> Transaction ProjectBranchName
|
||||
findTemporaryBranchName info = do
|
||||
Cli.findTemporaryBranchName info.branches.alice.project.projectId preferred
|
||||
findTemporaryBranchName :: ProjectId -> MergeSourceAndTarget -> Transaction ProjectBranchName
|
||||
findTemporaryBranchName projectId mergeSourceAndTarget = do
|
||||
Cli.findTemporaryBranchName projectId preferred
|
||||
where
|
||||
preferred :: ProjectBranchName
|
||||
preferred =
|
||||
unsafeFrom @Text $
|
||||
"merge-"
|
||||
<> mangle info.branches.bob.branch.name
|
||||
<> "-into-"
|
||||
<> mangle info.branches.alice.branch.name
|
||||
Text.Builder.run $
|
||||
"merge-"
|
||||
<> mangleMergeSource mergeSourceAndTarget.bob
|
||||
<> "-into-"
|
||||
<> mangleBranchName mergeSourceAndTarget.alice.branch
|
||||
|
||||
mangle :: ProjectBranchName -> Text
|
||||
mangle =
|
||||
Text.Builder.run . mangleB
|
||||
|
||||
mangleB :: ProjectBranchName -> Text.Builder
|
||||
mangleB name =
|
||||
mangleMergeSource :: MergeSource -> Text.Builder
|
||||
mangleMergeSource = \case
|
||||
MergeSource'LocalProjectBranch (ProjectAndBranch _project branch) -> mangleBranchName branch
|
||||
MergeSource'RemoteProjectBranch (ProjectAndBranch _project branch) -> "remote-" <> mangleBranchName branch
|
||||
MergeSource'RemoteLooseCode info -> manglePath info.path
|
||||
MergeSource'RemoteGitRepo info -> manglePath info.path
|
||||
mangleBranchName :: ProjectBranchName -> Text.Builder
|
||||
mangleBranchName name =
|
||||
case classifyProjectBranchName name of
|
||||
ProjectBranchNameKind'Contributor user name1 -> Text.Builder.text user <> Text.Builder.char '-' <> mangleB name1
|
||||
ProjectBranchNameKind'Contributor user name1 ->
|
||||
Text.Builder.text user
|
||||
<> Text.Builder.char '-'
|
||||
<> mangleBranchName name1
|
||||
ProjectBranchNameKind'DraftRelease semver -> "releases-drafts-" <> mangleSemver semver
|
||||
ProjectBranchNameKind'Release semver -> "releases-" <> mangleSemver semver
|
||||
ProjectBranchNameKind'NothingSpecial -> Text.Builder.text (into @Text name)
|
||||
|
||||
manglePath :: Path -> Text.Builder
|
||||
manglePath =
|
||||
Monoid.intercalateMap "-" (Text.Builder.text . NameSegment.toUnescapedText) . Path.toList
|
||||
|
||||
mangleSemver :: Semver -> Text.Builder
|
||||
mangleSemver (Semver x y z) =
|
||||
Text.Builder.decimal x
|
||||
@ -781,141 +878,54 @@ findTemporaryBranchName info = do
|
||||
<> Text.Builder.char '.'
|
||||
<> Text.Builder.decimal z
|
||||
|
||||
-- Load namespace info into memory.
|
||||
--
|
||||
-- Fails if:
|
||||
-- * One name is associated with more than one reference.
|
||||
loadNamespaceInfo ::
|
||||
(forall void. Merge.PreconditionViolation -> Transaction void) ->
|
||||
MergeDatabase ->
|
||||
V2.Branch Transaction ->
|
||||
Transaction (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
|
||||
loadNamespaceInfo abort db branch = do
|
||||
defns <- loadNamespaceInfo0 (referent2to1 db) branch
|
||||
assertNamespaceHasNoConflictedNames defns & onLeft abort
|
||||
|
||||
-- | Load all "namespace definitions" of a branch, which are all terms and type declarations *except* those defined
|
||||
-- Load all "namespace definitions" of a branch, which are all terms and type declarations *except* those defined
|
||||
-- in the "lib" namespace.
|
||||
loadNamespaceInfo0 ::
|
||||
--
|
||||
-- Fails if there is a conflicted name.
|
||||
loadNamespaceDefinitions ::
|
||||
forall m.
|
||||
Monad m =>
|
||||
(V2.Referent -> m Referent) ->
|
||||
V2.Branch m ->
|
||||
m (Nametree (DefnsF2 (Map NameSegment) Set Referent TypeReference))
|
||||
loadNamespaceInfo0 referent2to1 branch = do
|
||||
terms <-
|
||||
branch.terms
|
||||
& Map.map Map.keysSet
|
||||
& traverse (Set.traverse referent2to1)
|
||||
let types = Map.map Map.keysSet branch.types
|
||||
children <-
|
||||
for (Map.delete NameSegment.libSegment branch.children) \childCausal -> do
|
||||
childBranch <- childCausal.value
|
||||
loadNamespaceInfo0_ referent2to1 childBranch
|
||||
pure Nametree {value = Defns {terms, types}, children}
|
||||
m (Either ConflictedName (Nametree (DefnsF (Map NameSegment) Referent TypeReference)))
|
||||
loadNamespaceDefinitions referent2to1 =
|
||||
fmap assertNamespaceHasNoConflictedNames . go (Map.delete NameSegment.libSegment)
|
||||
where
|
||||
go ::
|
||||
(forall x. Map NameSegment x -> Map NameSegment x) ->
|
||||
V2.Branch m ->
|
||||
m (Nametree (DefnsF2 (Map NameSegment) NESet Referent TypeReference))
|
||||
go f branch = do
|
||||
terms <- for branch.terms (fmap (Set.NonEmpty.fromList . List.NonEmpty.fromList) . traverse referent2to1 . Map.keys)
|
||||
let types = Map.map (Set.NonEmpty.unsafeFromSet . Map.keysSet) branch.types
|
||||
children <-
|
||||
for (f branch.children) \childCausal -> do
|
||||
child <- childCausal.value
|
||||
go id child
|
||||
pure Nametree {value = Defns {terms, types}, children}
|
||||
|
||||
loadNamespaceInfo0_ ::
|
||||
(Monad m) =>
|
||||
(V2.Referent -> m Referent) ->
|
||||
V2.Branch m ->
|
||||
m (Nametree (DefnsF2 (Map NameSegment) Set Referent TypeReference))
|
||||
loadNamespaceInfo0_ referent2to1 branch = do
|
||||
terms <-
|
||||
branch.terms
|
||||
& Map.map Map.keysSet
|
||||
& traverse (Set.traverse referent2to1)
|
||||
let types = Map.map Map.keysSet branch.types
|
||||
children <-
|
||||
for branch.children \childCausal -> do
|
||||
childBranch <- childCausal.value
|
||||
loadNamespaceInfo0_ referent2to1 childBranch
|
||||
pure Nametree {value = Defns {terms, types}, children}
|
||||
data ConflictedName
|
||||
= ConflictedName'Term !Name !(NESet Referent)
|
||||
| ConflictedName'Type !Name !(NESet TypeReference)
|
||||
|
||||
-- | Assert that there are no unconflicted names in a namespace.
|
||||
assertNamespaceHasNoConflictedNames ::
|
||||
Nametree (DefnsF2 (Map NameSegment) Set Referent TypeReference) ->
|
||||
Either Merge.PreconditionViolation (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
|
||||
Nametree (DefnsF2 (Map NameSegment) NESet Referent TypeReference) ->
|
||||
Either ConflictedName (Nametree (DefnsF (Map NameSegment) Referent TypeReference))
|
||||
assertNamespaceHasNoConflictedNames =
|
||||
traverseNametreeWithName \names defns -> do
|
||||
terms <-
|
||||
defns.terms & Map.traverseWithKey \name ->
|
||||
assertUnconflicted (Merge.ConflictedTermName (Name.fromReverseSegments (name :| names)))
|
||||
assertUnconflicted (ConflictedName'Term (Name.fromReverseSegments (name :| names)))
|
||||
types <-
|
||||
defns.types & Map.traverseWithKey \name ->
|
||||
assertUnconflicted (Merge.ConflictedTypeName (Name.fromReverseSegments (name :| names)))
|
||||
assertUnconflicted (ConflictedName'Type (Name.fromReverseSegments (name :| names)))
|
||||
pure Defns {terms, types}
|
||||
where
|
||||
assertUnconflicted :: (Set ref -> Merge.PreconditionViolation) -> Set ref -> Either Merge.PreconditionViolation ref
|
||||
assertUnconflicted conflicted refs =
|
||||
case Set.asSingleton refs of
|
||||
Nothing -> Left (conflicted refs)
|
||||
Just ref -> Right ref
|
||||
|
||||
-- Convert a merge precondition violation to an output message.
|
||||
mergePreconditionViolationToOutput :: Merge.PreconditionViolation -> Output.Output
|
||||
mergePreconditionViolationToOutput = \case
|
||||
Merge.ConflictedAliases branch name1 name2 -> Output.MergeConflictedAliases branch name1 name2
|
||||
Merge.ConflictedTermName name refs -> Output.MergeConflictedTermName name refs
|
||||
Merge.ConflictedTypeName name refs -> Output.MergeConflictedTypeName name refs
|
||||
Merge.ConflictInvolvingBuiltin name -> Output.MergeConflictInvolvingBuiltin name
|
||||
Merge.ConstructorAlias maybeBranch name1 name2 -> Output.MergeConstructorAlias maybeBranch name1 name2
|
||||
Merge.DefnsInLib -> Output.MergeDefnsInLib
|
||||
Merge.MissingConstructorName name -> Output.MergeMissingConstructorName name
|
||||
Merge.NestedDeclAlias shorterName longerName -> Output.MergeNestedDeclAlias shorterName longerName
|
||||
Merge.StrayConstructor name -> Output.MergeStrayConstructor name
|
||||
|
||||
-- Assert that a namespace satisfies a few preconditions.
|
||||
--
|
||||
-- Fails if:
|
||||
-- * The "lib" namespace contains any top-level terms or decls. (Only child namespaces are expected here).
|
||||
-- * Any type declarations are "incoherent" (see `checkDeclCoherency`)
|
||||
assertNamespaceSatisfiesPreconditions ::
|
||||
MergeDatabase ->
|
||||
(forall void. Merge.PreconditionViolation -> Transaction void) ->
|
||||
Maybe ProjectBranchName ->
|
||||
V2.Branch Transaction ->
|
||||
Nametree (DefnsF (Map NameSegment) Referent TypeReference) ->
|
||||
Transaction (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name), DeclNameLookup)
|
||||
assertNamespaceSatisfiesPreconditions db abort maybeBranchName branch defns = do
|
||||
whenJust (Map.lookup NameSegment.libSegment branch.children) \libdepsCausal -> do
|
||||
libdepsBranch <- libdepsCausal.value
|
||||
when (not (Map.null libdepsBranch.terms) || not (Map.null libdepsBranch.types)) do
|
||||
abort Merge.DefnsInLib
|
||||
|
||||
declNameLookup <-
|
||||
checkDeclCoherency db.loadDeclNumConstructors defns
|
||||
& onLeftM (abort . incoherentDeclReasonToMergePreconditionViolation)
|
||||
|
||||
pure
|
||||
( Defns
|
||||
{ terms = flattenNametree (view #terms) defns,
|
||||
types = flattenNametree (view #types) defns
|
||||
},
|
||||
declNameLookup
|
||||
)
|
||||
where
|
||||
incoherentDeclReasonToMergePreconditionViolation :: IncoherentDeclReason -> Merge.PreconditionViolation
|
||||
incoherentDeclReasonToMergePreconditionViolation = \case
|
||||
IncoherentDeclReason'ConstructorAlias firstName secondName ->
|
||||
Merge.ConstructorAlias maybeBranchName firstName secondName
|
||||
IncoherentDeclReason'MissingConstructorName name -> Merge.MissingConstructorName name
|
||||
IncoherentDeclReason'NestedDeclAlias shorterName longerName -> Merge.NestedDeclAlias shorterName longerName
|
||||
IncoherentDeclReason'StrayConstructor name -> Merge.StrayConstructor name
|
||||
|
||||
findOneConflictedAlias ::
|
||||
TwoWay ProjectBranch ->
|
||||
Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name) ->
|
||||
TwoWay (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference) ->
|
||||
Maybe Merge.PreconditionViolation
|
||||
findOneConflictedAlias projectBranchNames lcaDefns diffs =
|
||||
aliceConflictedAliases <|> bobConflictedAliases
|
||||
where
|
||||
aliceConflictedAliases =
|
||||
findConflictedAlias lcaDefns diffs.alice <&> \(name1, name2) ->
|
||||
Merge.ConflictedAliases projectBranchNames.alice.name name1 name2
|
||||
|
||||
bobConflictedAliases =
|
||||
findConflictedAlias lcaDefns diffs.bob <&> \(name1, name2) ->
|
||||
Merge.ConflictedAliases projectBranchNames.bob.name name1 name2
|
||||
assertUnconflicted :: (NESet ref -> ConflictedName) -> NESet ref -> Either ConflictedName ref
|
||||
assertUnconflicted conflicted refs
|
||||
| Set.NonEmpty.size refs == 1 = Right (Set.NonEmpty.findMin refs)
|
||||
| otherwise = Left (conflicted refs)
|
||||
|
||||
-- @findConflictedAlias namespace diff@, given an old namespace and a diff to a new namespace, will return the first
|
||||
-- "conflicted alias" encountered (if any), where a "conflicted alias" is a pair of names that referred to the same
|
||||
@ -935,8 +945,9 @@ findOneConflictedAlias projectBranchNames lcaDefns diffs =
|
||||
--
|
||||
-- This function currently doesn't return whether the conflicted alias is a decl or a term, but it certainly could.
|
||||
findConflictedAlias ::
|
||||
Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name) ->
|
||||
DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference ->
|
||||
(Ord term, Ord typ) =>
|
||||
Defns (BiMultimap term Name) (BiMultimap typ Name) ->
|
||||
DefnsF3 (Map Name) DiffOp Synhashed term typ ->
|
||||
Maybe (Name, Name)
|
||||
findConflictedAlias defns diff =
|
||||
asum [go defns.terms diff.terms, go defns.types diff.types]
|
||||
|
@ -7,14 +7,17 @@ module Unison.Codebase.Editor.HandleInput.Pull
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Lens ((^.))
|
||||
import Control.Monad.Reader (ask)
|
||||
import Data.Text qualified as Text
|
||||
import Data.These
|
||||
import U.Codebase.Sqlite.Project qualified as Sqlite (Project)
|
||||
import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite (ProjectBranch)
|
||||
import U.Codebase.Branch qualified as V2.Branch
|
||||
import U.Codebase.Causal qualified
|
||||
import U.Codebase.Sqlite.Operations qualified as Operations
|
||||
import U.Codebase.Sqlite.Project qualified as Sqlite (Project (..))
|
||||
import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite (ProjectBranch (..))
|
||||
import U.Codebase.Sqlite.Queries qualified as Queries
|
||||
import Unison.Cli.DownloadUtils
|
||||
import Unison.Cli.MergeTypes (MergeSource (..))
|
||||
import Unison.Cli.Monad (Cli)
|
||||
import Unison.Cli.Monad qualified as Cli
|
||||
import Unison.Cli.MonadUtils qualified as Cli
|
||||
@ -25,6 +28,7 @@ import Unison.Codebase qualified as Codebase
|
||||
import Unison.Codebase.Branch (Branch (..))
|
||||
import Unison.Codebase.Branch qualified as Branch
|
||||
import Unison.Codebase.Branch.Merge qualified as Branch
|
||||
import Unison.Codebase.Editor.HandleInput.Merge2 (AliceMergeInfo (..), BobMergeInfo (..), LcaMergeInfo (..), MergeInfo (..), doMerge)
|
||||
import Unison.Codebase.Editor.HandleInput.NamespaceDiffUtils (diffHelper)
|
||||
import Unison.Codebase.Editor.Input
|
||||
import Unison.Codebase.Editor.Input qualified as Input
|
||||
@ -37,7 +41,6 @@ import Unison.Codebase.Editor.RemoteRepo qualified as RemoteRepo
|
||||
import Unison.Codebase.Patch (Patch (..))
|
||||
import Unison.Codebase.Path (Path')
|
||||
import Unison.Codebase.Path qualified as Path
|
||||
import Unison.Codebase.Verbosity qualified as Verbosity
|
||||
import Unison.CommandLine.InputPattern qualified as InputPattern
|
||||
import Unison.CommandLine.InputPatterns qualified as InputPatterns
|
||||
import Unison.NameSegment qualified as NameSegment
|
||||
@ -45,75 +48,112 @@ import Unison.Prelude
|
||||
import Unison.Project (ProjectAndBranch (..), ProjectBranchNameOrLatestRelease (..), ProjectName)
|
||||
import Witch (unsafeFrom)
|
||||
|
||||
handlePull :: PullSourceTarget -> PullMode -> Verbosity.Verbosity -> Cli ()
|
||||
handlePull unresolvedSourceAndTarget pullMode verbosity = do
|
||||
handlePull :: PullSourceTarget -> PullMode -> Cli ()
|
||||
handlePull unresolvedSourceAndTarget pullMode = do
|
||||
let includeSquashed = case pullMode of
|
||||
Input.PullWithHistory -> Share.NoSquashedHead
|
||||
Input.PullWithoutHistory -> Share.IncludeSquashedHead
|
||||
|
||||
(source, target) <- resolveSourceAndTarget includeSquashed unresolvedSourceAndTarget
|
||||
remoteBranchObject <- do
|
||||
|
||||
remoteCausalHash <- do
|
||||
Cli.Env {codebase} <- ask
|
||||
causalHash <-
|
||||
case source of
|
||||
ReadRemoteNamespaceGit repo -> do
|
||||
downloadLooseCodeFromGitRepo
|
||||
codebase
|
||||
( case pullMode of
|
||||
Input.PullWithHistory -> GitNamespaceHistoryTreatment'LetAlone
|
||||
Input.PullWithoutHistory -> GitNamespaceHistoryTreatment'DiscardAllHistory
|
||||
)
|
||||
repo
|
||||
& onLeftM (Cli.returnEarly . Output.GitError)
|
||||
ReadShare'LooseCode repo -> downloadLooseCodeFromShare repo & onLeftM (Cli.returnEarly . Output.ShareError)
|
||||
ReadShare'ProjectBranch remoteBranch ->
|
||||
downloadProjectBranchFromShare
|
||||
( case pullMode of
|
||||
Input.PullWithHistory -> Share.NoSquashedHead
|
||||
Input.PullWithoutHistory -> Share.IncludeSquashedHead
|
||||
)
|
||||
remoteBranch
|
||||
& onLeftM (Cli.returnEarly . Output.ShareError)
|
||||
liftIO (Codebase.expectBranchForHash codebase causalHash)
|
||||
when (Branch.isEmpty0 (Branch.head remoteBranchObject)) do
|
||||
Cli.respond (PulledEmptyBranch source)
|
||||
targetAbsolutePath <-
|
||||
case target of
|
||||
Left path -> Cli.resolvePath' path
|
||||
Right (ProjectAndBranch project branch) ->
|
||||
pure $ ProjectUtils.projectBranchPath (ProjectAndBranch (project ^. #projectId) (branch ^. #branchId))
|
||||
case source of
|
||||
ReadRemoteNamespaceGit repo -> do
|
||||
downloadLooseCodeFromGitRepo
|
||||
codebase
|
||||
( case pullMode of
|
||||
Input.PullWithHistory -> GitNamespaceHistoryTreatment'LetAlone
|
||||
Input.PullWithoutHistory -> GitNamespaceHistoryTreatment'DiscardAllHistory
|
||||
)
|
||||
repo
|
||||
& onLeftM (Cli.returnEarly . Output.GitError)
|
||||
ReadShare'LooseCode repo -> downloadLooseCodeFromShare repo & onLeftM (Cli.returnEarly . Output.ShareError)
|
||||
ReadShare'ProjectBranch remoteBranch ->
|
||||
downloadProjectBranchFromShare
|
||||
( case pullMode of
|
||||
Input.PullWithHistory -> Share.NoSquashedHead
|
||||
Input.PullWithoutHistory -> Share.IncludeSquashedHead
|
||||
)
|
||||
remoteBranch
|
||||
& onLeftM (Cli.returnEarly . Output.ShareError)
|
||||
|
||||
remoteBranchIsEmpty <-
|
||||
Cli.runTransaction do
|
||||
causal <- Operations.expectCausalBranchByCausalHash remoteCausalHash
|
||||
branch <- causal.value
|
||||
V2.Branch.isEmpty branch
|
||||
|
||||
when remoteBranchIsEmpty (Cli.respond (PulledEmptyBranch source))
|
||||
|
||||
let targetAbsolutePath =
|
||||
ProjectUtils.projectBranchPath (ProjectAndBranch target.project.projectId target.branch.branchId)
|
||||
|
||||
let description =
|
||||
Text.unwords
|
||||
[ Text.pack . InputPattern.patternName $
|
||||
case pullMode of
|
||||
PullWithoutHistory -> InputPatterns.pullWithoutHistory
|
||||
PullWithHistory -> InputPatterns.pull,
|
||||
printReadRemoteNamespace (\remoteBranch -> into @Text (ProjectAndBranch (remoteBranch ^. #projectName) (remoteBranch ^. #branchName))) source,
|
||||
printReadRemoteNamespace (\remoteBranch -> into @Text (ProjectAndBranch remoteBranch.projectName remoteBranch.branchName)) source,
|
||||
case target of
|
||||
Left path -> Path.toText' path
|
||||
Right (ProjectAndBranch project branch) -> into @Text (ProjectAndBranch (project ^. #name) (branch ^. #name))
|
||||
ProjectAndBranch project branch -> into @Text (ProjectAndBranch project.name branch.name)
|
||||
]
|
||||
|
||||
case pullMode of
|
||||
Input.PullWithHistory -> do
|
||||
targetBranchObject <- Cli.getBranch0At targetAbsolutePath
|
||||
|
||||
if Branch.isEmpty0 targetBranchObject
|
||||
then do
|
||||
Cli.Env {codebase} <- ask
|
||||
remoteBranchObject <- liftIO (Codebase.expectBranchForHash codebase remoteCausalHash)
|
||||
void $ Cli.updateAtM description targetAbsolutePath (const $ pure remoteBranchObject)
|
||||
Cli.respond $ MergeOverEmpty target
|
||||
else do
|
||||
Cli.respond AboutToMerge
|
||||
mergeBranchAndPropagateDefaultPatch
|
||||
Branch.RegularMerge
|
||||
description
|
||||
(Just (PullAlreadyUpToDate source target))
|
||||
remoteBranchObject
|
||||
(if Verbosity.isSilent verbosity then Nothing else Just target)
|
||||
targetAbsolutePath
|
||||
|
||||
aliceCausalHash <-
|
||||
Cli.runTransaction do
|
||||
causal <- Codebase.getShallowCausalFromRoot Nothing (Path.unabsolute targetAbsolutePath)
|
||||
pure causal.causalHash
|
||||
|
||||
lcaCausalHash <- Cli.runTransaction (Operations.lca aliceCausalHash remoteCausalHash)
|
||||
|
||||
doMerge
|
||||
MergeInfo
|
||||
{ alice =
|
||||
AliceMergeInfo
|
||||
{ causalHash = aliceCausalHash,
|
||||
project = target.project,
|
||||
projectBranch = target.branch
|
||||
},
|
||||
bob =
|
||||
BobMergeInfo
|
||||
{ causalHash = remoteCausalHash,
|
||||
source =
|
||||
case source of
|
||||
ReadShare'ProjectBranch remoteBranch ->
|
||||
MergeSource'RemoteProjectBranch (ProjectAndBranch remoteBranch.projectName remoteBranch.branchName)
|
||||
ReadShare'LooseCode info -> MergeSource'RemoteLooseCode info
|
||||
ReadRemoteNamespaceGit info -> MergeSource'RemoteGitRepo info
|
||||
},
|
||||
lca =
|
||||
LcaMergeInfo
|
||||
{ causalHash = lcaCausalHash
|
||||
},
|
||||
description
|
||||
}
|
||||
Input.PullWithoutHistory -> do
|
||||
Cli.Env {codebase} <- ask
|
||||
remoteBranchObject <- liftIO (Codebase.expectBranchForHash codebase remoteCausalHash)
|
||||
|
||||
didUpdate <-
|
||||
Cli.updateAtM
|
||||
description
|
||||
targetAbsolutePath
|
||||
(\targetBranchObject -> pure $ remoteBranchObject `Branch.consBranchSnapshot` targetBranchObject)
|
||||
|
||||
Cli.respond
|
||||
if didUpdate
|
||||
then PullSuccessful source target
|
||||
@ -124,13 +164,19 @@ resolveSourceAndTarget ::
|
||||
PullSourceTarget ->
|
||||
Cli
|
||||
( ReadRemoteNamespace Share.RemoteProjectBranch,
|
||||
Either Path' (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch)
|
||||
ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch
|
||||
)
|
||||
resolveSourceAndTarget includeSquashed = \case
|
||||
Input.PullSourceTarget0 -> liftA2 (,) (resolveImplicitSource includeSquashed) resolveImplicitTarget
|
||||
Input.PullSourceTarget1 source -> liftA2 (,) (resolveExplicitSource includeSquashed source) resolveImplicitTarget
|
||||
Input.PullSourceTarget2 source target ->
|
||||
liftA2 (,) (resolveExplicitSource includeSquashed source) (ProjectUtils.expectLooseCodeOrProjectBranch target)
|
||||
liftA2
|
||||
(,)
|
||||
(resolveExplicitSource includeSquashed source)
|
||||
( ProjectUtils.expectProjectAndBranchByTheseNames case target of
|
||||
ProjectAndBranch Nothing branch -> That branch
|
||||
ProjectAndBranch (Just project) branch -> These project branch
|
||||
)
|
||||
|
||||
resolveImplicitSource :: Share.IncludeSquashedHead -> Cli (ReadRemoteNamespace Share.RemoteProjectBranch)
|
||||
resolveImplicitSource includeSquashed =
|
||||
@ -139,8 +185,8 @@ resolveImplicitSource includeSquashed =
|
||||
Just (localProjectAndBranch, _restPath) -> do
|
||||
(remoteProjectId, remoteProjectName, remoteBranchId, remoteBranchName) <-
|
||||
Cli.runTransactionWithRollback \rollback -> do
|
||||
let localProjectId = localProjectAndBranch ^. #project . #projectId
|
||||
let localBranchId = localProjectAndBranch ^. #branch . #branchId
|
||||
let localProjectId = localProjectAndBranch.project.projectId
|
||||
let localBranchId = localProjectAndBranch.branch.branchId
|
||||
Queries.loadRemoteProjectBranch localProjectId Share.hardCodedUri localBranchId >>= \case
|
||||
Just (remoteProjectId, Just remoteBranchId) -> do
|
||||
remoteProjectName <- Queries.expectRemoteProjectName remoteProjectId Share.hardCodedUri
|
||||
@ -167,7 +213,7 @@ resolveExplicitSource includeSquashed = \case
|
||||
ReadShare'LooseCode namespace -> pure (ReadShare'LooseCode namespace)
|
||||
ReadShare'ProjectBranch (This remoteProjectName) -> do
|
||||
remoteProject <- ProjectUtils.expectRemoteProjectByName remoteProjectName
|
||||
let remoteProjectId = remoteProject ^. #projectId
|
||||
let remoteProjectId = remoteProject.projectId
|
||||
let remoteBranchName = unsafeFrom @Text "main"
|
||||
remoteProjectBranch <-
|
||||
ProjectUtils.expectRemoteProjectBranchByName
|
||||
@ -176,8 +222,8 @@ resolveExplicitSource includeSquashed = \case
|
||||
pure (ReadShare'ProjectBranch remoteProjectBranch)
|
||||
ReadShare'ProjectBranch (That branchNameOrLatestRelease) -> do
|
||||
(ProjectAndBranch localProject localBranch, _restPath) <- ProjectUtils.expectCurrentProjectBranch
|
||||
let localProjectId = localProject ^. #projectId
|
||||
let localBranchId = localBranch ^. #branchId
|
||||
let localProjectId = localProject.projectId
|
||||
let localBranchId = localBranch.branchId
|
||||
Cli.runTransaction (Queries.loadRemoteProjectBranch localProjectId Share.hardCodedUri localBranchId) >>= \case
|
||||
Just (remoteProjectId, _maybeProjectBranchId) -> do
|
||||
remoteProjectName <- Cli.runTransaction (Queries.expectRemoteProjectName remoteProjectId Share.hardCodedUri)
|
||||
@ -196,10 +242,10 @@ resolveExplicitSource includeSquashed = \case
|
||||
Cli.returnEarly $
|
||||
Output.NoAssociatedRemoteProject
|
||||
Share.hardCodedUri
|
||||
(ProjectAndBranch (localProject ^. #name) (localBranch ^. #name))
|
||||
(ProjectAndBranch localProject.name localBranch.name)
|
||||
ReadShare'ProjectBranch (These projectName branchNameOrLatestRelease) -> do
|
||||
remoteProject <- ProjectUtils.expectRemoteProjectByName projectName
|
||||
let remoteProjectId = remoteProject ^. #projectId
|
||||
let remoteProjectId = remoteProject.projectId
|
||||
branchName <-
|
||||
case branchNameOrLatestRelease of
|
||||
ProjectBranchNameOrLatestRelease'Name name -> pure name
|
||||
@ -210,11 +256,10 @@ resolveExplicitSource includeSquashed = \case
|
||||
(ProjectAndBranch (remoteProjectId, projectName) branchName)
|
||||
pure (ReadShare'ProjectBranch remoteProjectBranch)
|
||||
|
||||
resolveImplicitTarget :: Cli (Either Path' (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch))
|
||||
resolveImplicitTarget =
|
||||
ProjectUtils.getCurrentProjectBranch <&> \case
|
||||
Nothing -> Left Path.currentPath
|
||||
Just (projectAndBranch, _restPath) -> Right projectAndBranch
|
||||
resolveImplicitTarget :: Cli (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch)
|
||||
resolveImplicitTarget = do
|
||||
(projectAndBranch, _path) <- ProjectUtils.expectCurrentProjectBranch
|
||||
pure projectAndBranch
|
||||
|
||||
-- | supply `dest0` if you want to print diff messages
|
||||
-- supply unchangedMessage if you want to display it if merge had no effect
|
||||
|
@ -41,7 +41,6 @@ import Unison.Codebase.Path.Parse qualified as Path
|
||||
import Unison.Codebase.PushBehavior (PushBehavior)
|
||||
import Unison.Codebase.ShortCausalHash (ShortCausalHash)
|
||||
import Unison.Codebase.ShortCausalHash qualified as SCH
|
||||
import Unison.Codebase.Verbosity (Verbosity)
|
||||
import Unison.CommandLine.BranchRelativePath (BranchRelativePath, parseBranchRelativePath)
|
||||
import Unison.HashQualified qualified as HQ
|
||||
import Unison.Name (Name)
|
||||
@ -114,7 +113,7 @@ data Input
|
||||
MergeLocalBranchI LooseCodeOrProject LooseCodeOrProject Branch.MergeMode
|
||||
| PreviewMergeLocalBranchI LooseCodeOrProject LooseCodeOrProject
|
||||
| DiffNamespaceI BranchId BranchId -- old new
|
||||
| PullRemoteBranchI PullSourceTarget PullMode Verbosity
|
||||
| PullI !PullSourceTarget !PullMode
|
||||
| PushRemoteBranchI PushRemoteBranchInput
|
||||
| ResetRootI (Either ShortCausalHash Path')
|
||||
| ResetI
|
||||
@ -198,7 +197,6 @@ data Input
|
||||
| StructuredFindReplaceI (HQ.HashQualified Name) -- sfind.replace rewriteQuery
|
||||
| -- Show provided definitions.
|
||||
ShowDefinitionI OutputLocation ShowDefinitionScope (NonEmpty (HQ.HashQualified Name))
|
||||
| ShowDefinitionByPrefixI OutputLocation [HQ.HashQualified Name]
|
||||
| ShowReflogI
|
||||
| UpdateBuiltinsI
|
||||
| MergeBuiltinsI (Maybe Path)
|
||||
@ -276,7 +274,7 @@ data GistInput = GistInput
|
||||
data PullSourceTarget
|
||||
= PullSourceTarget0
|
||||
| PullSourceTarget1 (ReadRemoteNamespace (These ProjectName ProjectBranchNameOrLatestRelease))
|
||||
| PullSourceTarget2 (ReadRemoteNamespace (These ProjectName ProjectBranchNameOrLatestRelease)) LooseCodeOrProject
|
||||
| PullSourceTarget2 (ReadRemoteNamespace (These ProjectName ProjectBranchNameOrLatestRelease)) (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
|
||||
deriving stock (Eq, Show)
|
||||
|
||||
data PushSource
|
||||
|
@ -28,6 +28,7 @@ import U.Codebase.HashTags (CausalHash)
|
||||
import U.Codebase.Sqlite.Project qualified as Sqlite
|
||||
import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite
|
||||
import Unison.Auth.Types (CredentialFailure)
|
||||
import Unison.Cli.MergeTypes (MergeSourceOrTarget, MergeSourceAndTarget)
|
||||
import Unison.Cli.Share.Projects.Types qualified as Share
|
||||
import Unison.Codebase.Editor.Input
|
||||
import Unison.Codebase.Editor.Output.BranchDiff (BranchDiffOutput)
|
||||
@ -62,7 +63,7 @@ import Unison.Prelude
|
||||
import Unison.PrettyPrintEnv qualified as PPE
|
||||
import Unison.PrettyPrintEnvDecl qualified as PPE
|
||||
import Unison.Project (ProjectAndBranch, ProjectBranchName, ProjectName, Semver)
|
||||
import Unison.Reference (Reference, TermReferenceId)
|
||||
import Unison.Reference (Reference, TermReferenceId, TypeReference)
|
||||
import Unison.Reference qualified as Reference
|
||||
import Unison.Referent (Referent)
|
||||
import Unison.Server.Backend (ShallowListEntry (..))
|
||||
@ -283,16 +284,18 @@ data Output
|
||||
| ShowReflog [(Maybe UTCTime, SCH.ShortCausalHash, Text)]
|
||||
| PullAlreadyUpToDate
|
||||
(ReadRemoteNamespace Share.RemoteProjectBranch)
|
||||
(Either Path' (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch))
|
||||
(ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch)
|
||||
| PullSuccessful
|
||||
(ReadRemoteNamespace Share.RemoteProjectBranch)
|
||||
(Either Path' (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch))
|
||||
(ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch)
|
||||
| AboutToMerge
|
||||
| -- | Indicates a trivial merge where the destination was empty and was just replaced.
|
||||
MergeOverEmpty (Either Path' (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch))
|
||||
MergeOverEmpty (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch)
|
||||
| MergeAlreadyUpToDate
|
||||
(Either Path' (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch))
|
||||
(Either Path' (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch))
|
||||
(Either Path' (ProjectAndBranch ProjectName ProjectBranchName))
|
||||
(Either Path' (ProjectAndBranch ProjectName ProjectBranchName))
|
||||
| -- This will replace the above once `merge.old` is deleted
|
||||
MergeAlreadyUpToDate2 !MergeSourceAndTarget
|
||||
| PreviewMergeAlreadyUpToDate
|
||||
(Either Path' (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch))
|
||||
(Either Path' (ProjectAndBranch Sqlite.Project Sqlite.ProjectBranch))
|
||||
@ -395,19 +398,18 @@ data Output
|
||||
| UpgradeFailure !FilePath !NameSegment !NameSegment
|
||||
| UpgradeSuccess !NameSegment !NameSegment
|
||||
| LooseCodePushDeprecated
|
||||
| MergeFailure !FilePath !(ProjectAndBranch ProjectName ProjectBranchName) !(ProjectAndBranch ProjectName ProjectBranchName)
|
||||
| MergeSuccess !(ProjectAndBranch ProjectName ProjectBranchName) !(ProjectAndBranch ProjectName ProjectBranchName)
|
||||
| MergeSuccessFastForward !(ProjectAndBranch ProjectName ProjectBranchName) !(ProjectAndBranch ProjectName ProjectBranchName)
|
||||
| -- These are all merge precondition violations. See PreconditionViolation for more docs.
|
||||
MergeConflictedAliases !ProjectBranchName !Name !Name
|
||||
| MergeConflictedTermName !Name !(Set Referent)
|
||||
| MergeConflictedTypeName !Name !(Set Reference.TypeReference)
|
||||
| MergeFailure !FilePath !MergeSourceAndTarget
|
||||
| MergeSuccess !MergeSourceAndTarget
|
||||
| MergeSuccessFastForward !MergeSourceAndTarget
|
||||
| MergeConflictedAliases !MergeSourceOrTarget !Name !Name
|
||||
| MergeConflictedTermName !Name !(NESet Referent)
|
||||
| MergeConflictedTypeName !Name !(NESet TypeReference)
|
||||
| MergeConflictInvolvingBuiltin !Name
|
||||
| MergeConstructorAlias !(Maybe ProjectBranchName) !Name !Name
|
||||
| MergeDefnsInLib
|
||||
| MergeMissingConstructorName !Name
|
||||
| MergeNestedDeclAlias !Name !Name
|
||||
| MergeStrayConstructor !Name
|
||||
| MergeConstructorAlias !(Maybe MergeSourceOrTarget) !Name !Name
|
||||
| MergeDefnsInLib !MergeSourceOrTarget
|
||||
| MergeMissingConstructorName !(Maybe MergeSourceOrTarget) !Name
|
||||
| MergeNestedDeclAlias !(Maybe MergeSourceOrTarget) !Name !Name
|
||||
| MergeStrayConstructor !(Maybe MergeSourceOrTarget) !Name
|
||||
| InstalledLibdep !(ProjectAndBranch ProjectName ProjectBranchName) !NameSegment
|
||||
|
||||
data UpdateOrUpgrade = UOUUpdate | UOUUpgrade
|
||||
@ -560,6 +562,7 @@ isFailure o = case o of
|
||||
AboutToMerge {} -> False
|
||||
MergeOverEmpty {} -> False
|
||||
MergeAlreadyUpToDate {} -> False
|
||||
MergeAlreadyUpToDate2 {} -> False
|
||||
PreviewMergeAlreadyUpToDate {} -> False
|
||||
NoConflictsOrEdits {} -> False
|
||||
ListShallow _ es -> null es
|
||||
@ -646,7 +649,7 @@ isFailure o = case o of
|
||||
MergeConflictedTypeName {} -> True
|
||||
MergeConflictInvolvingBuiltin {} -> True
|
||||
MergeConstructorAlias {} -> True
|
||||
MergeDefnsInLib -> True
|
||||
MergeDefnsInLib {} -> True
|
||||
MergeMissingConstructorName {} -> True
|
||||
MergeNestedDeclAlias {} -> True
|
||||
MergeStrayConstructor {} -> True
|
||||
|
@ -61,10 +61,9 @@ type P = P.Parsec Void Text.Text
|
||||
|
||||
readRemoteNamespaceParser :: ProjectBranchSpecifier branch -> P (ReadRemoteNamespace (These ProjectName branch))
|
||||
readRemoteNamespaceParser specifier =
|
||||
P.label "generic repo" $
|
||||
ReadRemoteNamespaceGit <$> readGitRemoteNamespace
|
||||
<|> ReadShare'ProjectBranch <$> projectAndBranchNamesParserInTheContextOfAlsoParsingLooseCodePaths specifier
|
||||
<|> ReadShare'LooseCode <$> readShareLooseCode
|
||||
ReadRemoteNamespaceGit <$> readGitRemoteNamespace
|
||||
<|> ReadShare'ProjectBranch <$> projectAndBranchNamesParserInTheContextOfAlsoParsingLooseCodePaths specifier
|
||||
<|> ReadShare'LooseCode <$> readShareLooseCode
|
||||
|
||||
projectAndBranchNamesParserInTheContextOfAlsoParsingLooseCodePaths ::
|
||||
ProjectBranchSpecifier branch ->
|
||||
@ -109,7 +108,7 @@ writeShareRemoteNamespace =
|
||||
-- >>> P.parseMaybe readShareLooseCode ".unisonweb.base._releases.M4"
|
||||
-- >>> P.parseMaybe readShareLooseCode "unisonweb.base._releases.M4"
|
||||
-- Nothing
|
||||
-- Just (ReadShareLooseCode {server = ShareRepo, repo = "unisonweb", path = base._releases.M4})
|
||||
-- Just (ReadShareLooseCode {server = DefaultCodeserver, repo = ShareUserHandle {shareUserHandleToText = "unisonweb"}, path = base._releases.M4})
|
||||
readShareLooseCode :: P ReadShareLooseCode
|
||||
readShareLooseCode = do
|
||||
P.label "read share loose code" $
|
||||
|
@ -2,7 +2,150 @@
|
||||
This module defines 'InputPattern' values for every supported input command.
|
||||
-}
|
||||
|
||||
module Unison.CommandLine.InputPatterns where
|
||||
module Unison.CommandLine.InputPatterns
|
||||
( -- * Input commands
|
||||
add,
|
||||
aliasMany,
|
||||
aliasTerm,
|
||||
aliasType,
|
||||
api,
|
||||
authLogin,
|
||||
back,
|
||||
branchEmptyInputPattern,
|
||||
branchInputPattern,
|
||||
branchRenameInputPattern,
|
||||
branchesInputPattern,
|
||||
cd,
|
||||
clear,
|
||||
clone,
|
||||
compileScheme,
|
||||
copyPatch,
|
||||
createAuthor,
|
||||
debugClearWatchCache,
|
||||
debugDoctor,
|
||||
debugDumpNamespace,
|
||||
debugDumpNamespaceSimple,
|
||||
debugFileHashes,
|
||||
debugFormat,
|
||||
debugFuzzyOptions,
|
||||
debugLSPFoldRanges,
|
||||
debugNameDiff,
|
||||
debugNumberedArgs,
|
||||
debugTabCompletion,
|
||||
debugTerm,
|
||||
debugTermVerbose,
|
||||
debugType,
|
||||
delete,
|
||||
deleteBranch,
|
||||
deleteNamespace,
|
||||
deleteNamespaceForce,
|
||||
deletePatch,
|
||||
deleteProject,
|
||||
deleteTerm,
|
||||
deleteTermReplacement,
|
||||
deleteTermVerbose,
|
||||
deleteType,
|
||||
deleteTypeReplacement,
|
||||
deleteTypeVerbose,
|
||||
deleteVerbose,
|
||||
dependencies,
|
||||
dependents,
|
||||
diffNamespace,
|
||||
diffNamespaceToPatch,
|
||||
display,
|
||||
displayTo,
|
||||
docToMarkdown,
|
||||
docs,
|
||||
docsToHtml,
|
||||
edit,
|
||||
editNamespace,
|
||||
execute,
|
||||
find,
|
||||
findAll,
|
||||
findGlobal,
|
||||
findIn,
|
||||
findInAll,
|
||||
findPatch,
|
||||
findShallow,
|
||||
findVerbose,
|
||||
findVerboseAll,
|
||||
forkLocal,
|
||||
gist,
|
||||
help,
|
||||
helpTopics,
|
||||
history,
|
||||
ioTest,
|
||||
ioTestAll,
|
||||
libInstallInputPattern,
|
||||
load,
|
||||
makeStandalone,
|
||||
mergeBuiltins,
|
||||
mergeIOBuiltins,
|
||||
mergeInputPattern,
|
||||
mergeOldInputPattern,
|
||||
mergeOldPreviewInputPattern,
|
||||
mergeOldSquashInputPattern,
|
||||
moveAll,
|
||||
names,
|
||||
namespaceDependencies,
|
||||
patch,
|
||||
previewAdd,
|
||||
previewUpdate,
|
||||
printVersion,
|
||||
projectCreate,
|
||||
projectCreateEmptyInputPattern,
|
||||
projectRenameInputPattern,
|
||||
projectSwitch,
|
||||
projectsInputPattern,
|
||||
pull,
|
||||
pullWithoutHistory,
|
||||
push,
|
||||
pushCreate,
|
||||
pushExhaustive,
|
||||
pushForce,
|
||||
quit,
|
||||
releaseDraft,
|
||||
renameBranch,
|
||||
renamePatch,
|
||||
renameTerm,
|
||||
renameType,
|
||||
replace,
|
||||
reset,
|
||||
resetRoot,
|
||||
runScheme,
|
||||
saveExecuteResult,
|
||||
sfind,
|
||||
sfindReplace,
|
||||
test,
|
||||
testAll,
|
||||
todo,
|
||||
ui,
|
||||
undo,
|
||||
up,
|
||||
update,
|
||||
updateBuiltins,
|
||||
updateOld,
|
||||
updateOldNoPatch,
|
||||
upgrade,
|
||||
view,
|
||||
viewGlobal,
|
||||
viewPatch,
|
||||
viewReflog,
|
||||
|
||||
-- * Misc
|
||||
deleteTermReplacementCommand,
|
||||
deleteTypeReplacementCommand,
|
||||
helpFor,
|
||||
makeExample',
|
||||
makeExample,
|
||||
makeExampleEOS,
|
||||
makeExampleNoBackticks,
|
||||
patternMap,
|
||||
patternName,
|
||||
showPatternHelp,
|
||||
validInputs,
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Lens (preview, review, (^.))
|
||||
import Control.Lens.Cons qualified as Cons
|
||||
@ -11,7 +154,6 @@ import Data.List.Extra qualified as List
|
||||
import Data.List.NonEmpty qualified as NE
|
||||
import Data.Map qualified as Map
|
||||
import Data.Maybe (fromJust)
|
||||
import Data.Proxy (Proxy (..))
|
||||
import Data.Set qualified as Set
|
||||
import Data.Text qualified as Text
|
||||
import Data.These (These (..))
|
||||
@ -21,7 +163,7 @@ import System.Console.Haskeline.Completion qualified as Haskeline
|
||||
import System.Console.Haskeline.Completion qualified as Line
|
||||
import Text.Megaparsec qualified as Megaparsec
|
||||
import Text.Megaparsec.Internal qualified as Megaparsec (withParsecT)
|
||||
import U.Codebase.Sqlite.DbId (ProjectBranchId, ProjectId)
|
||||
import U.Codebase.Sqlite.DbId (ProjectBranchId)
|
||||
import U.Codebase.Sqlite.Project qualified as Sqlite
|
||||
import U.Codebase.Sqlite.Queries qualified as Queries
|
||||
import Unison.Auth.HTTPClient (AuthenticatedHttpClient)
|
||||
@ -34,15 +176,13 @@ import Unison.Codebase.Editor.Input (DeleteOutput (..), DeleteTarget (..), Input
|
||||
import Unison.Codebase.Editor.Input qualified as Input
|
||||
import Unison.Codebase.Editor.Output.PushPull (PushPull (Pull, Push))
|
||||
import Unison.Codebase.Editor.Output.PushPull qualified as PushPull
|
||||
import Unison.Codebase.Editor.RemoteRepo (ReadRemoteNamespace, WriteGitRepo, WriteRemoteNamespace)
|
||||
import Unison.Codebase.Editor.RemoteRepo (WriteGitRepo, WriteRemoteNamespace)
|
||||
import Unison.Codebase.Editor.SlurpResult qualified as SR
|
||||
import Unison.Codebase.Editor.UriParser (readRemoteNamespaceParser)
|
||||
import Unison.Codebase.Editor.UriParser qualified as UriParser
|
||||
import Unison.Codebase.Path qualified as Path
|
||||
import Unison.Codebase.Path.Parse qualified as Path
|
||||
import Unison.Codebase.PushBehavior qualified as PushBehavior
|
||||
import Unison.Codebase.Verbosity (Verbosity)
|
||||
import Unison.Codebase.Verbosity qualified as Verbosity
|
||||
import Unison.CommandLine
|
||||
import Unison.CommandLine.BranchRelativePath (parseBranchRelativePath, parseIncrementalBranchRelativePath)
|
||||
import Unison.CommandLine.BranchRelativePath qualified as BranchRelativePath
|
||||
@ -64,6 +204,7 @@ import Unison.Project
|
||||
ProjectBranchSpecifier (..),
|
||||
ProjectName,
|
||||
Semver,
|
||||
branchWithOptionalProjectParser,
|
||||
)
|
||||
import Unison.Project.Util (ProjectContext (..), projectContextFromPath)
|
||||
import Unison.Syntax.HashQualified qualified as HQ (parseText)
|
||||
@ -72,6 +213,7 @@ import Unison.Syntax.NameSegment qualified as NameSegment (renderParseErr, segme
|
||||
import Unison.Util.ColorText qualified as CT
|
||||
import Unison.Util.Monoid (intercalateMap)
|
||||
import Unison.Util.Pretty qualified as P
|
||||
import Unison.Util.Pretty.MegaParsec (prettyPrintParseError)
|
||||
|
||||
showPatternHelp :: InputPattern -> P.Pretty CT.ColorText
|
||||
showPatternHelp i =
|
||||
@ -97,8 +239,7 @@ makeExampleNoBackticks p args =
|
||||
makeExample' :: InputPattern -> P.Pretty CT.ColorText
|
||||
makeExample' p = makeExample p []
|
||||
|
||||
makeExampleEOS ::
|
||||
InputPattern -> [P.Pretty CT.ColorText] -> P.Pretty CT.ColorText
|
||||
makeExampleEOS :: InputPattern -> [P.Pretty CT.ColorText] -> P.Pretty CT.ColorText
|
||||
makeExampleEOS p args =
|
||||
P.group $
|
||||
backtick (intercalateMap " " id (P.nonEmpty $ fromString (I.patternName p) : args)) <> "."
|
||||
@ -532,18 +673,6 @@ undo =
|
||||
"`undo` reverts the most recent change to the codebase."
|
||||
(const $ pure Input.UndoI)
|
||||
|
||||
viewByPrefix :: InputPattern
|
||||
viewByPrefix =
|
||||
InputPattern
|
||||
"view.recursive"
|
||||
[]
|
||||
I.Visible
|
||||
[("definition to view", OnePlus, definitionQueryArg)]
|
||||
"`view.recursive Foo` prints the definitions of `Foo` and `Foo.blah`."
|
||||
( fmap (Input.ShowDefinitionByPrefixI Input.ConsoleLocation)
|
||||
. traverse parseHashQualifiedName
|
||||
)
|
||||
|
||||
sfind :: InputPattern
|
||||
sfind =
|
||||
InputPattern "rewrite.find" ["sfind"] I.Visible [("rewrite-rule definition", Required, definitionQueryArg)] msg parse
|
||||
@ -1330,22 +1459,18 @@ resetRoot =
|
||||
|
||||
pull :: InputPattern
|
||||
pull =
|
||||
pullImpl "pull" ["pull.silent"] Verbosity.Silent Input.PullWithHistory "without listing the merged entities"
|
||||
|
||||
pullVerbose :: InputPattern
|
||||
pullVerbose = pullImpl "pull.verbose" [] Verbosity.Verbose Input.PullWithHistory "and lists the merged entities"
|
||||
pullImpl "pull" [] Input.PullWithHistory ""
|
||||
|
||||
pullWithoutHistory :: InputPattern
|
||||
pullWithoutHistory =
|
||||
pullImpl
|
||||
"pull.without-history"
|
||||
[]
|
||||
Verbosity.Silent
|
||||
Input.PullWithoutHistory
|
||||
"without including the remote's history. This usually results in smaller codebase sizes."
|
||||
|
||||
pullImpl :: String -> [String] -> Verbosity -> Input.PullMode -> P.Pretty CT.ColorText -> InputPattern
|
||||
pullImpl name aliases verbosity pullMode addendum = do
|
||||
pullImpl :: String -> [String] -> Input.PullMode -> P.Pretty CT.ColorText -> InputPattern
|
||||
pullImpl name aliases pullMode addendum = do
|
||||
self
|
||||
where
|
||||
self =
|
||||
@ -1353,57 +1478,92 @@ pullImpl name aliases verbosity pullMode addendum = do
|
||||
{ patternName = name,
|
||||
aliases = aliases,
|
||||
visibility = I.Visible,
|
||||
args = [("remote location to pull", Optional, remoteNamespaceArg), ("destination namespace", Optional, namespaceArg)],
|
||||
args =
|
||||
[ ("remote namespace to pull", Optional, remoteNamespaceArg),
|
||||
( "destination branch",
|
||||
Optional,
|
||||
projectBranchNameArg
|
||||
ProjectBranchSuggestionsConfig
|
||||
{ showProjectCompletions = False,
|
||||
projectInclusion = AllProjects,
|
||||
branchInclusion = AllBranches
|
||||
}
|
||||
)
|
||||
],
|
||||
help =
|
||||
P.lines
|
||||
[ P.wrap $
|
||||
"The"
|
||||
<> makeExample' self
|
||||
<> "command merges a remote namespace into a local namespace"
|
||||
<> "command merges a remote namespace into a local branch"
|
||||
<> addendum,
|
||||
"",
|
||||
P.wrapColumn2
|
||||
[ ( makeExample self ["@unison/base/main"],
|
||||
"merges the branch `main`"
|
||||
<> "of the Unison Share hosted project `@unison/base`"
|
||||
<> "into the current namespace"
|
||||
<> "into the current branch"
|
||||
),
|
||||
( makeExample self ["@unison/base/main", "my-base/topic"],
|
||||
"merges the branch `main`"
|
||||
<> "of the Unison Share hosted project `@unison/base`"
|
||||
<> "into the branch `topic` of the local `my-base` project"
|
||||
),
|
||||
( makeExample self ["remote", "local"],
|
||||
"merges the remote namespace `remote`"
|
||||
<> "into the local namespace `local"
|
||||
),
|
||||
( makeExample self ["remote"],
|
||||
"merges the remote namespace `remote`"
|
||||
<> "into the current namespace"
|
||||
),
|
||||
( makeExample' self,
|
||||
"merges the remote namespace configured in `.unisonConfig`"
|
||||
<> "at the key `RemoteMappings.<namespace>` where `<namespace>` is the current namespace,"
|
||||
)
|
||||
],
|
||||
"",
|
||||
explainRemote Pull
|
||||
],
|
||||
parse =
|
||||
maybeToEither (I.help self) . \case
|
||||
[] -> Just $ Input.PullRemoteBranchI Input.PullSourceTarget0 pullMode verbosity
|
||||
[sourceString] -> do
|
||||
source <- parsePullSource (Text.pack sourceString)
|
||||
Just $ Input.PullRemoteBranchI (Input.PullSourceTarget1 source) pullMode verbosity
|
||||
[sourceString, targetString] -> do
|
||||
source <- parsePullSource (Text.pack sourceString)
|
||||
target <- parseLooseCodeOrProject targetString
|
||||
Just $
|
||||
Input.PullRemoteBranchI
|
||||
(Input.PullSourceTarget2 source target)
|
||||
pullMode
|
||||
verbosity
|
||||
_ -> Nothing
|
||||
parse = \case
|
||||
-- maybeToEither (I.help self) . \case
|
||||
[] -> Right $ Input.PullI Input.PullSourceTarget0 pullMode
|
||||
[sourceString] -> do
|
||||
source <-
|
||||
sourceString
|
||||
& Text.pack
|
||||
& megaparse (readRemoteNamespaceParser ProjectBranchSpecifier'NameOrLatestRelease)
|
||||
& mapLeft (\err -> I.help self <> P.newline <> err)
|
||||
Right $ Input.PullI (Input.PullSourceTarget1 source) pullMode
|
||||
[sourceString, targetString] -> do
|
||||
source <-
|
||||
sourceString
|
||||
& Text.pack
|
||||
& megaparse (readRemoteNamespaceParser ProjectBranchSpecifier'NameOrLatestRelease)
|
||||
& mapLeft (\err -> I.help self <> P.newline <> err)
|
||||
target <-
|
||||
targetString
|
||||
& Text.pack
|
||||
& megaparse branchWithOptionalProjectParser
|
||||
& mapLeft
|
||||
( \err ->
|
||||
-- You used to be able to pull into a path. So if target parsing fails, but path parsing succeeds,
|
||||
-- explain that the command has changed. Furthermore, in the special case that the user is trying to
|
||||
-- pull into the `lib` namespace, suggest using `lib.install`.
|
||||
case Path.parsePath' targetString of
|
||||
Left _ -> I.help self <> P.newline <> err
|
||||
Right path ->
|
||||
I.help self
|
||||
<> P.newline
|
||||
<> P.newline
|
||||
<> P.newline
|
||||
<> let pullingIntoLib =
|
||||
case path of
|
||||
Path.RelativePath'
|
||||
( Path.Relative
|
||||
(Path.toList -> lib : _)
|
||||
) -> lib == NameSegment.libSegment
|
||||
_ -> False
|
||||
in P.wrap $
|
||||
"You may only"
|
||||
<> makeExample' pull
|
||||
<> "into a branch."
|
||||
<> if pullingIntoLib
|
||||
then
|
||||
"Did you mean to run"
|
||||
<> P.group (makeExample libInstallInputPattern [P.string sourceString] <> "?")
|
||||
else mempty
|
||||
)
|
||||
Right $ Input.PullI (Input.PullSourceTarget2 source target) pullMode
|
||||
_ -> Left (I.help self)
|
||||
}
|
||||
|
||||
debugTabCompletion :: InputPattern
|
||||
@ -1939,14 +2099,6 @@ topicNameArg =
|
||||
fzfResolver = Just $ Resolvers.fuzzySelectFromList (Text.pack <$> topics)
|
||||
}
|
||||
|
||||
codebaseServerNameArg :: ArgumentType
|
||||
codebaseServerNameArg =
|
||||
ArgumentType
|
||||
{ typeName = "codebase-server",
|
||||
suggestions = \_ _ _ _ -> pure [],
|
||||
fzfResolver = Nothing
|
||||
}
|
||||
|
||||
helpTopics :: InputPattern
|
||||
helpTopics =
|
||||
InputPattern
|
||||
@ -3090,7 +3242,6 @@ validInputs =
|
||||
projectSwitch,
|
||||
projectsInputPattern,
|
||||
pull,
|
||||
pullVerbose,
|
||||
pullWithoutHistory,
|
||||
push,
|
||||
pushCreate,
|
||||
@ -3155,14 +3306,6 @@ exactDefinitionArg =
|
||||
fzfResolver = Just Resolvers.definitionResolver
|
||||
}
|
||||
|
||||
fuzzyDefinitionQueryArg :: ArgumentType
|
||||
fuzzyDefinitionQueryArg =
|
||||
ArgumentType
|
||||
{ typeName = "fuzzy definition query",
|
||||
suggestions = \q cb _http p -> Codebase.runTransaction cb (prefixCompleteTermOrType q p),
|
||||
fzfResolver = Just Resolvers.definitionResolver
|
||||
}
|
||||
|
||||
definitionQueryArg :: ArgumentType
|
||||
definitionQueryArg = exactDefinitionArg {typeName = "definition query"}
|
||||
|
||||
@ -3309,18 +3452,6 @@ data ProjectInclusion = OnlyWithinCurrentProject | OnlyOutsideCurrentProject | A
|
||||
data BranchInclusion = ExcludeCurrentBranch | AllBranches
|
||||
deriving stock (Eq, Ord, Show)
|
||||
|
||||
projectsByPrefix :: MonadIO m => ProjectInclusion -> Codebase m v a -> Path.Absolute -> Text -> m [(ProjectId, ProjectName)]
|
||||
projectsByPrefix projectInclusion codebase path query = do
|
||||
allProjectMatches <- Codebase.runTransaction codebase do
|
||||
Queries.loadAllProjectsBeginningWith (Just query)
|
||||
<&> map (\(Sqlite.Project projId projName) -> (projId, projName))
|
||||
let projectCtx = projectContextFromPath path
|
||||
pure $ case (projectCtx, projectInclusion) of
|
||||
(_, AllProjects) -> allProjectMatches
|
||||
(LooseCodePath {}, _) -> allProjectMatches
|
||||
(ProjectBranchPath currentProjectId _branchId _path, OnlyWithinCurrentProject) -> allProjectMatches & filter \(projId, _) -> projId == currentProjectId
|
||||
(ProjectBranchPath currentProjectId _branchId _path, OnlyOutsideCurrentProject) -> allProjectMatches & filter \(projId, _) -> projId /= currentProjectId
|
||||
|
||||
data ProjectBranchSuggestionsConfig = ProjectBranchSuggestionsConfig
|
||||
{ -- Whether projects (without branches) should be considered possible completions.
|
||||
showProjectCompletions :: Bool,
|
||||
@ -3682,15 +3813,6 @@ projectBranchNameArg config =
|
||||
fzfResolver = Just Resolvers.projectBranchResolver
|
||||
}
|
||||
|
||||
-- [project/]branch
|
||||
projectBranchNameWithOptionalProjectNameArg :: ArgumentType
|
||||
projectBranchNameWithOptionalProjectNameArg =
|
||||
ArgumentType
|
||||
{ typeName = "project-branch-name-with-optional-project-name",
|
||||
suggestions = \_ _ _ _ -> pure [],
|
||||
fzfResolver = Just Resolvers.projectBranchResolver
|
||||
}
|
||||
|
||||
branchRelativePathArg :: ArgumentType
|
||||
branchRelativePathArg =
|
||||
ArgumentType
|
||||
@ -3746,10 +3868,6 @@ projectNameSuggestions slash (Text.strip . Text.pack -> input) codebase = do
|
||||
isFinished = False
|
||||
}
|
||||
|
||||
parsePullSource :: Text -> Maybe (ReadRemoteNamespace (These ProjectName ProjectBranchNameOrLatestRelease))
|
||||
parsePullSource =
|
||||
Megaparsec.parseMaybe (readRemoteNamespaceParser ProjectBranchSpecifier'NameOrLatestRelease)
|
||||
|
||||
-- | Parse a 'Input.PushSource'.
|
||||
parsePushSource :: String -> Either (P.Pretty CT.ColorText) Input.PushSource
|
||||
parsePushSource sourceStr =
|
||||
@ -3787,9 +3905,6 @@ parseWriteGitRepo label input = do
|
||||
(fromString . show) -- turn any parsing errors into a Pretty.
|
||||
(Megaparsec.parse (UriParser.writeGitRepo <* Megaparsec.eof) label (Text.pack input))
|
||||
|
||||
collectNothings :: (a -> Maybe b) -> [a] -> [a]
|
||||
collectNothings f as = [a | (Nothing, a) <- map f as `zip` as]
|
||||
|
||||
explainRemote :: PushPull -> P.Pretty CT.ColorText
|
||||
explainRemote pushPull =
|
||||
P.group $
|
||||
@ -3806,23 +3921,8 @@ explainRemote pushPull =
|
||||
where
|
||||
gitRepo = PushPull.fold @(P.Pretty P.ColorText) "git@github.com:" "https://github.com/" pushPull
|
||||
|
||||
showErrorFancy :: (Megaparsec.ShowErrorComponent e) => Megaparsec.ErrorFancy e -> String
|
||||
showErrorFancy (Megaparsec.ErrorFail msg) = msg
|
||||
showErrorFancy (Megaparsec.ErrorIndentation ord ref actual) =
|
||||
"incorrect indentation (got "
|
||||
<> show (Megaparsec.unPos actual)
|
||||
<> ", should be "
|
||||
<> p
|
||||
<> show (Megaparsec.unPos ref)
|
||||
<> ")"
|
||||
where
|
||||
p = case ord of
|
||||
LT -> "less than "
|
||||
EQ -> "equal to "
|
||||
GT -> "greater than "
|
||||
showErrorFancy (Megaparsec.ErrorCustom a) = Megaparsec.showErrorComponent a
|
||||
|
||||
showErrorItem :: Megaparsec.ErrorItem (Megaparsec.Token Text) -> String
|
||||
showErrorItem (Megaparsec.Tokens ts) = Megaparsec.showTokens (Proxy @Text) ts
|
||||
showErrorItem (Megaparsec.Label label) = NE.toList label
|
||||
showErrorItem Megaparsec.EndOfInput = "end of input"
|
||||
megaparse :: Megaparsec.Parsec Void Text a -> Text -> Either (P.Pretty P.ColorText) a
|
||||
megaparse parser input =
|
||||
input
|
||||
& Megaparsec.parse (parser <* Megaparsec.eof) ""
|
||||
& mapLeft (prettyPrintParseError (Text.unpack input))
|
||||
|
@ -38,9 +38,12 @@ import U.Codebase.Branch.Diff (NameChanges (..))
|
||||
import U.Codebase.HashTags (CausalHash (..))
|
||||
import U.Codebase.Reference qualified as Reference
|
||||
import U.Codebase.Sqlite.DbId (SchemaVersion (SchemaVersion))
|
||||
import U.Codebase.Sqlite.Project (Project (..))
|
||||
import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..))
|
||||
import Unison.ABT qualified as ABT
|
||||
import Unison.Auth.Types qualified as Auth
|
||||
import Unison.Builtin.Decls qualified as DD
|
||||
import Unison.Cli.MergeTypes (MergeSourceAndTarget (..))
|
||||
import Unison.Cli.Pretty
|
||||
import Unison.Cli.ProjectUtils qualified as ProjectUtils
|
||||
import Unison.Cli.ServantClientUtils qualified as ServantClientUtils
|
||||
@ -72,9 +75,7 @@ import Unison.Codebase.Runtime qualified as Runtime
|
||||
import Unison.Codebase.ShortCausalHash (ShortCausalHash)
|
||||
import Unison.Codebase.ShortCausalHash qualified as SCH
|
||||
import Unison.Codebase.SqliteCodebase.Conversions qualified as Cv
|
||||
import Unison.Codebase.SqliteCodebase.GitError
|
||||
( GitSqliteCodebaseError (..),
|
||||
)
|
||||
import Unison.Codebase.SqliteCodebase.GitError (GitSqliteCodebaseError (..))
|
||||
import Unison.Codebase.TermEdit qualified as TermEdit
|
||||
import Unison.Codebase.Type (GitError (GitCodebaseError, GitProtocolError, GitSqliteCodebaseError))
|
||||
import Unison.Codebase.TypeEdit qualified as TypeEdit
|
||||
@ -1605,31 +1606,41 @@ notifyUser dir = \case
|
||||
PullAlreadyUpToDate ns dest ->
|
||||
pure . P.callout "😶" $
|
||||
P.wrap $
|
||||
prettyNamespaceKey dest
|
||||
prettyProjectAndBranchName (ProjectAndBranch dest.project.name dest.branch.name)
|
||||
<> "was already up-to-date with"
|
||||
<> P.group (prettyReadRemoteNamespace ns <> ".")
|
||||
PullSuccessful ns dest ->
|
||||
pure . P.okCallout $
|
||||
P.wrap $
|
||||
"Successfully updated"
|
||||
<> prettyNamespaceKey dest
|
||||
<> prettyProjectAndBranchName (ProjectAndBranch dest.project.name dest.branch.name)
|
||||
<> "from"
|
||||
<> P.group (prettyReadRemoteNamespace ns <> ".")
|
||||
AboutToMerge -> pure "Merging..."
|
||||
MergeOverEmpty dest ->
|
||||
pure . P.okCallout $
|
||||
P.wrap $
|
||||
"Successfully pulled into " <> P.group (prettyNamespaceKey dest <> ", which was empty.")
|
||||
"Successfully pulled into "
|
||||
<> P.group
|
||||
( prettyProjectAndBranchName (ProjectAndBranch dest.project.name dest.branch.name)
|
||||
<> ", which was empty."
|
||||
)
|
||||
MergeAlreadyUpToDate src dest ->
|
||||
pure . P.callout "😶" $
|
||||
P.wrap $
|
||||
prettyNamespaceKey dest
|
||||
either prettyPath' prettyProjectAndBranchName dest
|
||||
<> "was already up-to-date with"
|
||||
<> P.group (prettyNamespaceKey src <> ".")
|
||||
MergeConflictedAliases branch name1 name2 ->
|
||||
<> P.group (either prettyPath' prettyProjectAndBranchName src <> ".")
|
||||
MergeAlreadyUpToDate2 aliceAndBob ->
|
||||
pure . P.callout "😶" $
|
||||
P.wrap $
|
||||
prettyProjectAndBranchName aliceAndBob.alice
|
||||
<> "was already up-to-date with"
|
||||
<> P.group (prettyMergeSource aliceAndBob.bob <> ".")
|
||||
MergeConflictedAliases aliceOrBob name1 name2 ->
|
||||
pure . P.wrap $
|
||||
"On"
|
||||
<> P.group (prettyProjectBranchName branch <> ",")
|
||||
<> P.group (prettyMergeSourceOrTarget aliceOrBob <> ",")
|
||||
<> prettyName name1
|
||||
<> "and"
|
||||
<> prettyName name2
|
||||
@ -1645,35 +1656,49 @@ notifyUser dir = \case
|
||||
"There's a merge conflict on"
|
||||
<> P.group (prettyName name <> ",")
|
||||
<> "but it's a builtin on one or both branches. We can't yet handle merge conflicts on builtins."
|
||||
MergeConstructorAlias maybeBranch name1 name2 ->
|
||||
MergeConstructorAlias maybeAliceOrBob name1 name2 ->
|
||||
pure . P.wrap $
|
||||
"On"
|
||||
<> case maybeBranch of
|
||||
<> case maybeAliceOrBob of
|
||||
Nothing -> "the LCA,"
|
||||
Just branch -> P.group (prettyProjectBranchName branch <> ",")
|
||||
Just aliceOrBob -> P.group (prettyMergeSourceOrTarget aliceOrBob <> ",")
|
||||
<> prettyName name1
|
||||
<> "and"
|
||||
<> prettyName name2
|
||||
<> "are aliases. Every type declaration must have exactly one name for each constructor."
|
||||
MergeDefnsInLib ->
|
||||
MergeDefnsInLib aliceOrBob ->
|
||||
pure . P.wrap $
|
||||
"There's a type or term directly in the `lib` namespace, but I expected only library dependencies to be in there."
|
||||
"On"
|
||||
<> P.group (prettyMergeSourceOrTarget aliceOrBob <> ",")
|
||||
<> "there's a type or term directly in the `lib` namespace, but I expected only library dependencies to be in there."
|
||||
<> "Please remove it before merging."
|
||||
MergeMissingConstructorName name ->
|
||||
MergeMissingConstructorName maybeAliceOrBob name ->
|
||||
pure . P.wrap $
|
||||
"The type"
|
||||
"On"
|
||||
<> case maybeAliceOrBob of
|
||||
Nothing -> "the LCA,"
|
||||
Just aliceOrBob -> P.group (prettyMergeSourceOrTarget aliceOrBob <> ",")
|
||||
<> "the type"
|
||||
<> prettyName name
|
||||
<> "is missing a name for one of its constructors. Please add one before merging."
|
||||
MergeNestedDeclAlias shorterName longerName ->
|
||||
MergeNestedDeclAlias maybeAliceOrBob shorterName longerName ->
|
||||
pure . P.wrap $
|
||||
"The type"
|
||||
"On"
|
||||
<> case maybeAliceOrBob of
|
||||
Nothing -> "the LCA,"
|
||||
Just aliceOrBob -> P.group (prettyMergeSourceOrTarget aliceOrBob <> ",")
|
||||
<> "the type"
|
||||
<> prettyName longerName
|
||||
<> "is an alias of"
|
||||
<> P.group (prettyName shorterName <> ".")
|
||||
<> "Type aliases cannot be nested. Please make them disjoint before merging."
|
||||
MergeStrayConstructor name ->
|
||||
MergeStrayConstructor maybeAliceOrBob name ->
|
||||
pure . P.wrap $
|
||||
"The constructor"
|
||||
"On"
|
||||
<> case maybeAliceOrBob of
|
||||
Nothing -> "the LCA,"
|
||||
Just aliceOrBob -> P.group (prettyMergeSourceOrTarget aliceOrBob <> ",")
|
||||
<> "the constructor"
|
||||
<> prettyName name
|
||||
<> "is not in a subnamespace of a name of its type."
|
||||
<> "Please either delete it or rename it before merging."
|
||||
@ -2260,26 +2285,26 @@ notifyUser dir = \case
|
||||
"",
|
||||
"Your non-project code is still available to pull from Share, and you can pull it into a local namespace using `pull myhandle.public`"
|
||||
]
|
||||
MergeFailure path base target ->
|
||||
MergeFailure path aliceAndBob ->
|
||||
pure . P.wrap $
|
||||
"I couldn't automatically merge"
|
||||
<> prettyProjectBranchName (view #branch target)
|
||||
<> prettyMergeSource aliceAndBob.bob
|
||||
<> "into"
|
||||
<> P.group (prettyProjectBranchName (view #branch base) <> ".")
|
||||
<> P.group (prettyProjectAndBranchName aliceAndBob.alice <> ".")
|
||||
<> "However, I've added the definitions that need attention to the top of"
|
||||
<> P.group (prettyFilePath path <> ".")
|
||||
MergeSuccess base target ->
|
||||
MergeSuccess aliceAndBob ->
|
||||
pure . P.wrap $
|
||||
"I merged"
|
||||
<> prettyProjectBranchName (view #branch target)
|
||||
<> prettyMergeSource aliceAndBob.bob
|
||||
<> "into"
|
||||
<> P.group (prettyProjectBranchName (view #branch base) <> ".")
|
||||
MergeSuccessFastForward base target ->
|
||||
<> P.group (prettyProjectAndBranchName aliceAndBob.alice <> ".")
|
||||
MergeSuccessFastForward aliceAndBob ->
|
||||
pure . P.wrap $
|
||||
"I fast-forward merged"
|
||||
<> prettyProjectBranchName (view #branch target)
|
||||
<> prettyMergeSource aliceAndBob.bob
|
||||
<> "into"
|
||||
<> P.group (prettyProjectBranchName (view #branch base) <> ".")
|
||||
<> P.group (prettyProjectAndBranchName aliceAndBob.alice <> ".")
|
||||
InstalledLibdep libdep segment ->
|
||||
pure . P.wrap $
|
||||
"I installed"
|
||||
|
@ -35,6 +35,7 @@ library
|
||||
Unison.Auth.Types
|
||||
Unison.Auth.UserInfo
|
||||
Unison.Cli.DownloadUtils
|
||||
Unison.Cli.MergeTypes
|
||||
Unison.Cli.Monad
|
||||
Unison.Cli.MonadUtils
|
||||
Unison.Cli.NamesUtils
|
||||
|
@ -17,6 +17,8 @@ module Unison.Project
|
||||
ProjectBranchSpecifier (..),
|
||||
ProjectAndBranch (..),
|
||||
projectAndBranchNamesParser,
|
||||
projectAndOptionalBranchParser,
|
||||
branchWithOptionalProjectParser,
|
||||
ProjectAndBranchNames (..),
|
||||
projectAndBranchNamesParser2,
|
||||
projectNameParser,
|
||||
|
@ -16,11 +16,12 @@ import U.Codebase.Sqlite.Operations qualified as Operations
|
||||
import Unison.Builtin qualified as Builtins
|
||||
import Unison.Codebase (Codebase)
|
||||
import Unison.Codebase qualified as Codebase
|
||||
import Unison.Codebase.Branch qualified as V1
|
||||
import Unison.Codebase.SqliteCodebase.Operations qualified as Operations (expectDeclComponent)
|
||||
import Unison.ConstructorReference (GConstructorReference (..))
|
||||
import Unison.ConstructorType (ConstructorType)
|
||||
import Unison.DataDeclaration qualified as V1 (Decl)
|
||||
import Unison.DataDeclaration qualified as V1.Decl
|
||||
import Unison.Hash (Hash)
|
||||
import Unison.Parser.Ann qualified as V1 (Ann)
|
||||
import Unison.Prelude
|
||||
import Unison.Referent qualified as V1 (Referent)
|
||||
@ -29,6 +30,7 @@ import Unison.Sqlite (Transaction)
|
||||
import Unison.Sqlite qualified as Sqlite
|
||||
import Unison.Symbol qualified as V1 (Symbol)
|
||||
import Unison.Term qualified as V1 (Term)
|
||||
import Unison.Type qualified as V1 (Type)
|
||||
import Unison.Util.Cache qualified as Cache
|
||||
|
||||
------------------------------------------------------------------------------------------------------------------------
|
||||
@ -39,9 +41,10 @@ data MergeDatabase = MergeDatabase
|
||||
{ loadCausal :: CausalHash -> Transaction (CausalBranch Transaction),
|
||||
loadDeclNumConstructors :: TypeReferenceId -> Transaction Int,
|
||||
loadDeclType :: TypeReference -> Transaction ConstructorType,
|
||||
loadV1Branch :: CausalHash -> Transaction (V1.Branch Transaction),
|
||||
loadV1Decl :: TypeReferenceId -> Transaction (V1.Decl V1.Symbol V1.Ann),
|
||||
loadV1Term :: TermReferenceId -> Transaction (V1.Term V1.Symbol V1.Ann)
|
||||
loadV1DeclComponent :: Hash -> Transaction [V1.Decl V1.Symbol V1.Ann],
|
||||
loadV1Term :: TermReferenceId -> Transaction (V1.Term V1.Symbol V1.Ann),
|
||||
loadV1TermComponent :: Hash -> Transaction [(V1.Term V1.Symbol V1.Ann, V1.Type V1.Symbol V1.Ann)]
|
||||
}
|
||||
|
||||
makeMergeDatabase :: MonadIO m => Codebase IO V1.Symbol V1.Ann -> m MergeDatabase
|
||||
@ -53,7 +56,6 @@ makeMergeDatabase codebase = liftIO do
|
||||
loadDeclNumConstructors <- do
|
||||
cache <- Cache.semispaceCache 1024
|
||||
pure (Sqlite.cacheTransaction cache Operations.expectDeclNumConstructors)
|
||||
let loadV1Branch = undefined -- Codebase.expectBranchForHash codebase
|
||||
loadV1Decl <- do
|
||||
cache <- Cache.semispaceCache 1024
|
||||
pure (Sqlite.cacheTransaction cache (Codebase.unsafeGetTypeDeclaration codebase))
|
||||
@ -67,7 +69,18 @@ makeMergeDatabase codebase = liftIO do
|
||||
loadV1Term <- do
|
||||
cache <- Cache.semispaceCache 1024
|
||||
pure (Sqlite.cacheTransaction cache (Codebase.unsafeGetTerm codebase))
|
||||
pure MergeDatabase {loadCausal, loadDeclNumConstructors, loadDeclType, loadV1Branch, loadV1Decl, loadV1Term}
|
||||
let loadV1TermComponent = Codebase.unsafeGetTermComponent codebase
|
||||
let loadV1DeclComponent = Operations.expectDeclComponent
|
||||
pure
|
||||
MergeDatabase
|
||||
{ loadCausal,
|
||||
loadDeclNumConstructors,
|
||||
loadDeclType,
|
||||
loadV1Decl,
|
||||
loadV1DeclComponent,
|
||||
loadV1Term,
|
||||
loadV1TermComponent
|
||||
}
|
||||
|
||||
-- Convert a v2 referent (missing decl type) to a v1 referent.
|
||||
referent2to1 :: MergeDatabase -> Referent -> Transaction V1.Referent
|
||||
|
@ -1,39 +0,0 @@
|
||||
module Unison.Merge.PreconditionViolation
|
||||
( PreconditionViolation (..),
|
||||
)
|
||||
where
|
||||
|
||||
import U.Codebase.Reference (TypeReference)
|
||||
import Unison.Core.Project (ProjectBranchName)
|
||||
import Unison.Name (Name)
|
||||
import Unison.Prelude
|
||||
import Unison.Referent (Referent)
|
||||
|
||||
-- | A reason that a merge could not be performed.
|
||||
data PreconditionViolation
|
||||
= -- | @ConflictedAliases branch foo bar@: in project branch @branch@, @foo@ and @bar@ refer to different things,
|
||||
-- but at one time (in the LCA of another branch, in fact) they referred to the same thing.
|
||||
ConflictedAliases !ProjectBranchName !Name !Name
|
||||
| -- | @ConflictedTermName name refs@: @name@ refers to 2+ referents @refs@.
|
||||
ConflictedTermName !Name !(Set Referent)
|
||||
| -- | @ConflictedTypeName name refs@: @name@ refers to 2+ type references @refs@.
|
||||
ConflictedTypeName !Name !(Set TypeReference)
|
||||
| -- | @ConflictInvolvingBuiltin name@: @name@ is involved in a conflict, but it refers to a builtin (on at least one
|
||||
-- side). Since we can't put a builtin in a scratch file, we bomb in these cases.
|
||||
ConflictInvolvingBuiltin !Name
|
||||
| -- | A second naming of a constructor was discovered underneath a decl's name, e.g.
|
||||
--
|
||||
-- Foo#Foo
|
||||
-- Foo.Bar#Foo#0
|
||||
-- Foo.Some.Other.Name.For.Bar#Foo#0
|
||||
--
|
||||
-- If the project branch name is missing, it means the LCA is in violation.
|
||||
ConstructorAlias !(Maybe ProjectBranchName) !Name !Name -- first name we found, second name we found
|
||||
| -- | There were some definitions at the top level of lib.*, which we don't like
|
||||
DefnsInLib
|
||||
| -- | This type name is missing a name for one of its constructors.
|
||||
MissingConstructorName !Name
|
||||
| -- | This type name is a nested alias, e.g. "Foo.Bar.Baz" which is an alias of "Foo" or "Foo.Bar".
|
||||
NestedDeclAlias !Name !Name -- shorter name, longer name
|
||||
| StrayConstructor !Name
|
||||
deriving stock (Show)
|
@ -10,4 +10,4 @@ data TwoOrThreeWay a = TwoOrThreeWay
|
||||
alice :: a,
|
||||
bob :: a
|
||||
}
|
||||
deriving stock (Functor, Generic)
|
||||
deriving stock (Foldable, Functor, Generic, Traversable)
|
||||
|
@ -27,7 +27,6 @@ library
|
||||
Unison.Merge.EitherWayI
|
||||
Unison.Merge.Libdeps
|
||||
Unison.Merge.PartitionCombinedDiffs
|
||||
Unison.Merge.PreconditionViolation
|
||||
Unison.Merge.Synhash
|
||||
Unison.Merge.Synhashed
|
||||
Unison.Merge.ThreeWay
|
||||
|
@ -24,7 +24,7 @@ Merge result:
|
||||
```ucm
|
||||
project/alice> merge /bob
|
||||
|
||||
I merged bob into alice.
|
||||
I merged project/bob into project/alice.
|
||||
|
||||
project/alice> view foo bar
|
||||
|
||||
@ -58,7 +58,7 @@ Merge result:
|
||||
```ucm
|
||||
project/alice> merge /bob
|
||||
|
||||
I merged bob into alice.
|
||||
I merged project/bob into project/alice.
|
||||
|
||||
project/alice> view foo bar
|
||||
|
||||
@ -101,7 +101,7 @@ Merge result:
|
||||
```ucm
|
||||
project/alice> merge /bob
|
||||
|
||||
I merged bob into alice.
|
||||
I merged project/bob into project/alice.
|
||||
|
||||
project/alice> view foo bar
|
||||
|
||||
@ -164,7 +164,7 @@ Merge result:
|
||||
```ucm
|
||||
project/alice> merge /bob
|
||||
|
||||
I merged bob into alice.
|
||||
I merged project/bob into project/alice.
|
||||
|
||||
project/alice> view foo bar baz
|
||||
|
||||
@ -234,7 +234,7 @@ Merge result:
|
||||
```ucm
|
||||
project/alice> merge /bob
|
||||
|
||||
I merged bob into alice.
|
||||
I merged project/bob into project/alice.
|
||||
|
||||
project/alice> view foo bar baz
|
||||
|
||||
@ -283,7 +283,7 @@ Merge result:
|
||||
```ucm
|
||||
project/alice> merge /bob
|
||||
|
||||
I merged bob into alice.
|
||||
I merged project/bob into project/alice.
|
||||
|
||||
project/alice> view foo
|
||||
|
||||
@ -325,7 +325,7 @@ Merge result:
|
||||
```ucm
|
||||
project/alice> merge bob
|
||||
|
||||
I merged bob into alice.
|
||||
I merged project/bob into project/alice.
|
||||
|
||||
project/alice> view foo bar baz
|
||||
|
||||
@ -446,7 +446,7 @@ project/bob> add
|
||||
|
||||
project/alice> merge /bob
|
||||
|
||||
I fast-forward merged bob into alice.
|
||||
I fast-forward merged project/bob into project/alice.
|
||||
|
||||
```
|
||||
## Merge failure: someone deleted something
|
||||
@ -485,15 +485,12 @@ project/bob> add
|
||||
|
||||
project/alice> merge /bob
|
||||
|
||||
I couldn't automatically merge bob into alice. However, I've
|
||||
added the definitions that need attention to the top of
|
||||
scratch.u.
|
||||
I couldn't automatically merge project/bob into project/alice.
|
||||
However, I've added the definitions that need attention to the
|
||||
top of scratch.u.
|
||||
|
||||
```
|
||||
```unison:added-by-ucm scratch.u
|
||||
-- The definitions below are not conflicted, but they each depend on one or more
|
||||
-- conflicted definitions above.
|
||||
|
||||
bar : Text
|
||||
bar =
|
||||
use Text ++
|
||||
@ -529,15 +526,12 @@ bar = foo ++ " - " ++ foo
|
||||
```ucm
|
||||
project/alice> merge /bob
|
||||
|
||||
I couldn't automatically merge bob into alice. However, I've
|
||||
added the definitions that need attention to the top of
|
||||
scratch.u.
|
||||
I couldn't automatically merge project/bob into project/alice.
|
||||
However, I've added the definitions that need attention to the
|
||||
top of scratch.u.
|
||||
|
||||
```
|
||||
```unison:added-by-ucm scratch.u
|
||||
-- The definitions below are not conflicted, but they each depend on one or more
|
||||
-- conflicted definitions above.
|
||||
|
||||
bar : Text
|
||||
bar =
|
||||
use Text ++
|
||||
@ -585,9 +579,9 @@ baz = "bobs baz"
|
||||
```ucm
|
||||
project/alice> merge /bob
|
||||
|
||||
I couldn't automatically merge bob into alice. However, I've
|
||||
added the definitions that need attention to the top of
|
||||
scratch.u.
|
||||
I couldn't automatically merge project/bob into project/alice.
|
||||
However, I've added the definitions that need attention to the
|
||||
top of scratch.u.
|
||||
|
||||
```
|
||||
```unison:added-by-ucm scratch.u
|
||||
@ -642,9 +636,9 @@ unique type Foo = MkFoo Nat Text
|
||||
```ucm
|
||||
project/alice> merge /bob
|
||||
|
||||
I couldn't automatically merge bob into alice. However, I've
|
||||
added the definitions that need attention to the top of
|
||||
scratch.u.
|
||||
I couldn't automatically merge project/bob into project/alice.
|
||||
However, I've added the definitions that need attention to the
|
||||
top of scratch.u.
|
||||
|
||||
```
|
||||
```unison:added-by-ucm scratch.u
|
||||
@ -679,9 +673,9 @@ unique type Foo = Baz Nat | BobQux Text
|
||||
```ucm
|
||||
project/alice> merge /bob
|
||||
|
||||
I couldn't automatically merge bob into alice. However, I've
|
||||
added the definitions that need attention to the top of
|
||||
scratch.u.
|
||||
I couldn't automatically merge project/bob into project/alice.
|
||||
However, I've added the definitions that need attention to the
|
||||
top of scratch.u.
|
||||
|
||||
```
|
||||
```unison:added-by-ucm scratch.u
|
||||
@ -720,9 +714,9 @@ project/bob> move.term Foo.Qux Foo.Bob
|
||||
```ucm
|
||||
project/alice> merge bob
|
||||
|
||||
I couldn't automatically merge bob into alice. However, I've
|
||||
added the definitions that need attention to the top of
|
||||
scratch.u.
|
||||
I couldn't automatically merge project/bob into project/alice.
|
||||
However, I've added the definitions that need attention to the
|
||||
top of scratch.u.
|
||||
|
||||
```
|
||||
```unison:added-by-ucm scratch.u
|
||||
@ -754,9 +748,9 @@ unique ability my.cool where
|
||||
```ucm
|
||||
project/alice> merge bob
|
||||
|
||||
I couldn't automatically merge bob into alice. However, I've
|
||||
added the definitions that need attention to the top of
|
||||
scratch.u.
|
||||
I couldn't automatically merge project/bob into project/alice.
|
||||
However, I've added the definitions that need attention to the
|
||||
top of scratch.u.
|
||||
|
||||
```
|
||||
```unison:added-by-ucm scratch.u
|
||||
@ -800,9 +794,9 @@ These won't cleanly merge.
|
||||
```ucm
|
||||
project/alice> merge bob
|
||||
|
||||
I couldn't automatically merge bob into alice. However, I've
|
||||
added the definitions that need attention to the top of
|
||||
scratch.u.
|
||||
I couldn't automatically merge project/bob into project/alice.
|
||||
However, I've added the definitions that need attention to the
|
||||
top of scratch.u.
|
||||
|
||||
```
|
||||
```unison:added-by-ucm scratch.u
|
||||
@ -862,9 +856,9 @@ Notably, Alice's "unconflicted" update on the name "Foo.Bar.Baz" (because she ch
|
||||
```ucm
|
||||
project/alice> merge bob
|
||||
|
||||
I couldn't automatically merge bob into alice. However, I've
|
||||
added the definitions that need attention to the top of
|
||||
scratch.u.
|
||||
I couldn't automatically merge project/bob into project/alice.
|
||||
However, I've added the definitions that need attention to the
|
||||
top of scratch.u.
|
||||
|
||||
```
|
||||
```unison:added-by-ucm scratch.u
|
||||
@ -909,9 +903,9 @@ bob _ = 19
|
||||
```ucm
|
||||
project/alice> merge bob
|
||||
|
||||
I couldn't automatically merge bob into alice. However, I've
|
||||
added the definitions that need attention to the top of
|
||||
scratch.u.
|
||||
I couldn't automatically merge project/bob into project/alice.
|
||||
However, I've added the definitions that need attention to the
|
||||
top of scratch.u.
|
||||
|
||||
```
|
||||
```unison:added-by-ucm scratch.u
|
||||
@ -970,7 +964,8 @@ baz = "baz"
|
||||
```ucm
|
||||
project/alice> merge /bob
|
||||
|
||||
On alice, bar and foo are not aliases, but they used to be.
|
||||
On project/alice, bar and foo are not aliases, but they used
|
||||
to be.
|
||||
|
||||
```
|
||||
### Conflict involving builtin
|
||||
@ -1024,9 +1019,9 @@ bob = 100
|
||||
```ucm
|
||||
project/alice> merge /bob
|
||||
|
||||
On alice, Foo.Bar and Foo.some.other.Alias are aliases. Every
|
||||
type declaration must have exactly one name for each
|
||||
constructor.
|
||||
On project/alice, Foo.Bar and Foo.some.other.Alias are
|
||||
aliases. Every type declaration must have exactly one name for
|
||||
each constructor.
|
||||
|
||||
```
|
||||
### Missing constructor name
|
||||
@ -1053,8 +1048,8 @@ bob = 100
|
||||
```ucm
|
||||
project/alice> merge /bob
|
||||
|
||||
The type Foo is missing a name for one of its constructors.
|
||||
Please add one before merging.
|
||||
On project/alice, the type Foo is missing a name for one of
|
||||
its constructors. Please add one before merging.
|
||||
|
||||
```
|
||||
### Nested decl alias
|
||||
@ -1086,8 +1081,9 @@ bob = 100
|
||||
```ucm
|
||||
project/alice> merge /bob
|
||||
|
||||
The type A.inner.X is an alias of A. Type aliases cannot be
|
||||
nested. Please make them disjoint before merging.
|
||||
On project/alice, the type A.inner.X is an alias of A. Type
|
||||
aliases cannot be nested. Please make them disjoint before
|
||||
merging.
|
||||
|
||||
```
|
||||
### Stray constructor alias
|
||||
@ -1119,9 +1115,9 @@ project/bob> add
|
||||
```ucm
|
||||
project/alice> merge bob
|
||||
|
||||
The constructor AliasOutsideFooNamespace is not in a
|
||||
subnamespace of a name of its type. Please either delete it or
|
||||
rename it before merging.
|
||||
On project/alice, the constructor AliasOutsideFooNamespace is
|
||||
not in a subnamespace of a name of its type. Please either
|
||||
delete it or rename it before merging.
|
||||
|
||||
```
|
||||
### Term or type in `lib`
|
||||
@ -1143,8 +1139,8 @@ bob = 100
|
||||
```ucm
|
||||
project/alice> merge /bob
|
||||
|
||||
There's a type or term directly in the `lib` namespace, but I
|
||||
expected only library dependencies to be in there. Please
|
||||
remove it before merging.
|
||||
On project/alice, there's a type or term directly in the `lib`
|
||||
namespace, but I expected only library dependencies to be in
|
||||
there. Please remove it before merging.
|
||||
|
||||
```
|
||||
|
Loading…
Reference in New Issue
Block a user