mirror of
https://github.com/unisonweb/unison.git
synced 2024-09-11 02:25:39 +03:00
Merge remote-tracking branch 'upstream/trunk' into better-CLI-error-messages
This commit is contained in:
Greg Pfeil
commit
532236bbc0
48
.github/ISSUE_TEMPLATE/bug_report.md
vendored
Normal file
48
.github/ISSUE_TEMPLATE/bug_report.md
vendored
Normal file
@ -0,0 +1,48 @@
|
||||
---
|
||||
name: Bug report
|
||||
about: Create a report to help us improve
|
||||
title: ''
|
||||
labels: bug
|
||||
assignees: ''
|
||||
|
||||
---
|
||||
|
||||
**Describe and demonstrate the bug**
|
||||
Please attach a [ucm transcript](https://www.unison-lang.org/docs/tooling/transcripts/) if possible, calling out the unexpected behavior in the text. e.g.
|
||||
|
||||
Input:
|
||||
````
|
||||
```unison:hide
|
||||
a = 1
|
||||
```
|
||||
Here I typo the next command and `ucm` silently does nothing. I would have expected an error message:
|
||||
```ucm
|
||||
.> add b
|
||||
```
|
||||
````
|
||||
|
||||
Output:
|
||||
````
|
||||
```unison
|
||||
a = 1
|
||||
```
|
||||
|
||||
Here I typo the next command and `ucm` silently does nothing, I would have expected an error message:
|
||||
```ucm
|
||||
.> add b
|
||||
|
||||
|
||||
|
||||
```
|
||||
````
|
||||
|
||||
**Screenshots**
|
||||
If applicable, add screenshots to help explain your problem.
|
||||
|
||||
**Environment (please complete the following information):**
|
||||
- `ucm --version` [e.g. "0.5.21", or "1cb2437 (built on 2024-06-03)"]
|
||||
- OS/Architecture: [e.g. "macOS 14.5, Intel"]
|
||||
- Browser, if applicable: [e.g. "chrome 125.0.6422.142"] (Version numbers are typically found the about menu option)
|
||||
|
||||
**Additional context**
|
||||
Add any other context about the problem here.
|
||||
38
.github/ISSUE_TEMPLATE/error-message-suggestion.md
vendored
Normal file
38
.github/ISSUE_TEMPLATE/error-message-suggestion.md
vendored
Normal file
@ -0,0 +1,38 @@
|
||||
---
|
||||
name: Error message suggestion
|
||||
about: Suggest improved wording or design for an error message
|
||||
title: ''
|
||||
labels: error-message
|
||||
assignees: ''
|
||||
|
||||
---
|
||||
|
||||
**What's the message you're seeing?**
|
||||
Please paste from your terminal or paste a screenshot, e.g:
|
||||
```
|
||||
project/alice> merge /bob
|
||||
|
||||
On project/alice, bar and foo are not aliases, but they used
|
||||
to be.
|
||||
|
||||
```
|
||||
|
||||
**What would a better version look like?**
|
||||
```
|
||||
Sorry, I wasn't able to perform the merge:
|
||||
|
||||
On the merge ancestor, bar and foo were aliases for the same definition; but on project/alice the names have different definitions currently. I'd need just a single new definition to use in their dependents when I merge.
|
||||
|
||||
Please fix up project/alice to resolve this. For example,
|
||||
|
||||
* update the definitions to be the same again, so that there's nothing for me to decide.
|
||||
* rename or delete one of the definitions; I'll use the remaining name when propagating updates,
|
||||
and you can change the name back after the merge.
|
||||
|
||||
```
|
||||
|
||||
Environment (please complete the following information):
|
||||
|
||||
* `ucm --version` [e.g. "0.5.21", or "1cb2437 (built on 2024-06-03)"]
|
||||
* OS/Architecture: [e.g. "macOS 14.5, Intel"]
|
||||
* Browser, if applicable: [e.g. "chrome 125.0.6422.142"] (Version numbers are typically found the about menu option)
|
||||
20
.github/ISSUE_TEMPLATE/feature_request.md
vendored
Normal file
20
.github/ISSUE_TEMPLATE/feature_request.md
vendored
Normal file
@ -0,0 +1,20 @@
|
||||
---
|
||||
name: Feature request
|
||||
about: Suggest an idea for this project
|
||||
title: ''
|
||||
labels: feature request
|
||||
assignees: ''
|
||||
|
||||
---
|
||||
|
||||
**Is your feature request related to a problem? Please describe.**
|
||||
A clear and concise description of what the problem is. Ex. I'm always frustrated when [...]
|
||||
|
||||
**Describe the solution you'd like**
|
||||
A clear and concise description of what you want to happen.
|
||||
|
||||
**Describe alternatives you've considered**
|
||||
A clear and concise description of any alternative solutions or features you've considered.
|
||||
|
||||
**Additional context**
|
||||
Add any other context or screenshots about the feature request here.
|
||||
@ -60,6 +60,7 @@ import Data.Bytes.VarInt (VarInt (VarInt), unVarInt)
|
||||
import Data.List (elemIndex)
|
||||
import Data.Set qualified as Set
|
||||
import Data.Vector (Vector)
|
||||
import U.Codebase.Decl (Modifier)
|
||||
import U.Codebase.Decl qualified as Decl
|
||||
import U.Codebase.Kind (Kind)
|
||||
import U.Codebase.Kind qualified as Kind
|
||||
@ -94,7 +95,6 @@ import Unison.Hash32 qualified as Hash32
|
||||
import Unison.Prelude
|
||||
import Unison.Util.Monoid qualified as Monoid
|
||||
import Prelude hiding (getChar, putChar)
|
||||
import U.Codebase.Decl (Modifier)
|
||||
|
||||
debug :: Bool
|
||||
debug = False
|
||||
|
||||
@ -1073,7 +1073,6 @@ handle = Type.fileHandle ()
|
||||
phandle = Type.processHandle ()
|
||||
unit = DD.unitType ()
|
||||
|
||||
|
||||
udpSocket, udpListenSocket, udpClientSockAddr :: Type
|
||||
udpSocket = Type.udpSocket ()
|
||||
udpListenSocket = Type.udpListenSocket ()
|
||||
|
||||
@ -22,9 +22,12 @@ module Unison.Codebase.Path
|
||||
relativeEmpty',
|
||||
currentPath,
|
||||
prefix,
|
||||
prefixAbs,
|
||||
prefixRel,
|
||||
maybePrefix,
|
||||
unprefix,
|
||||
prefixName,
|
||||
prefixName2,
|
||||
maybePrefixName,
|
||||
prefixNameIfRel,
|
||||
unprefixName,
|
||||
HQSplit,
|
||||
Split,
|
||||
@ -62,8 +65,7 @@ module Unison.Codebase.Path
|
||||
unsplitAbsolute,
|
||||
unsplitHQ,
|
||||
unsplitHQ',
|
||||
|
||||
-- * things that could be replaced with `Parse` instances
|
||||
nameFromSplit',
|
||||
splitFromName,
|
||||
splitFromName',
|
||||
hqSplitFromName',
|
||||
@ -81,6 +83,7 @@ where
|
||||
|
||||
import Control.Lens hiding (cons, snoc, unsnoc, pattern Empty)
|
||||
import Control.Lens qualified as Lens
|
||||
import Data.Bitraversable (bitraverse)
|
||||
import Data.Foldable qualified as Foldable
|
||||
import Data.List.Extra (dropPrefix)
|
||||
import Data.List.NonEmpty (NonEmpty ((:|)))
|
||||
@ -90,7 +93,7 @@ import Data.Sequence qualified as Seq
|
||||
import Data.Text qualified as Text
|
||||
import GHC.Exts qualified as GHC
|
||||
import Unison.HashQualified' qualified as HQ'
|
||||
import Unison.Name (Convert (..), Name, Parse)
|
||||
import Unison.Name (Convert (..), Name)
|
||||
import Unison.Name qualified as Name
|
||||
import Unison.NameSegment (NameSegment)
|
||||
import Unison.Prelude hiding (empty, toList)
|
||||
@ -187,16 +190,25 @@ unprefix (Absolute prefix) = \case
|
||||
AbsolutePath' abs -> unabsolute abs
|
||||
RelativePath' rel -> fromList $ dropPrefix (toList prefix) (toList (unrelative rel))
|
||||
|
||||
-- too many types
|
||||
prefix :: Absolute -> Path' -> Path
|
||||
prefix (Absolute (Path prefix)) = \case
|
||||
AbsolutePath' abs -> unabsolute abs
|
||||
RelativePath' rel -> Path $ prefix <> toSeq (unrelative rel)
|
||||
prefixAbs :: Absolute -> Relative -> Absolute
|
||||
prefixAbs prefix = Absolute . Path . (toSeq (unabsolute prefix) <>) . toSeq . unrelative
|
||||
|
||||
prefix2 :: Path -> Path' -> Path
|
||||
prefix2 (Path prefix) = \case
|
||||
AbsolutePath' abs -> unabsolute abs
|
||||
RelativePath' rel -> Path $ prefix <> toSeq (unrelative rel)
|
||||
prefixRel :: Relative -> Relative -> Relative
|
||||
prefixRel prefix = Relative . Path . (toSeq (unrelative prefix) <>) . toSeq . unrelative
|
||||
|
||||
-- | This always prefixes, since the secend argument can never be Absolute.
|
||||
prefix :: Path' -> Relative -> Path'
|
||||
prefix prefix =
|
||||
Path' . case prefix of
|
||||
AbsolutePath' abs -> Left . prefixAbs abs
|
||||
RelativePath' rel -> pure . prefixRel rel
|
||||
|
||||
-- | Returns `Nothing` if the second argument is absolute. A common pattern is
|
||||
-- @fromMaybe path $ maybePrefix prefix path@ to use the unmodified path in that case.
|
||||
maybePrefix :: Path' -> Path' -> Maybe Path'
|
||||
maybePrefix pre = \case
|
||||
AbsolutePath' _ -> Nothing
|
||||
RelativePath' rel -> pure $ prefix pre rel
|
||||
|
||||
-- | Finds the longest shared path prefix of two paths.
|
||||
-- Returns (shared prefix, path to first location from shared prefix, path to second location from shared prefix)
|
||||
@ -244,8 +256,8 @@ fromList = Path . Seq.fromList
|
||||
ancestors :: Absolute -> Seq Absolute
|
||||
ancestors (Absolute (Path segments)) = Absolute . Path <$> Seq.inits segments
|
||||
|
||||
hqSplitFromName' :: Name -> Maybe HQSplit'
|
||||
hqSplitFromName' = fmap (fmap HQ'.fromName) . Lens.unsnoc . fromName'
|
||||
hqSplitFromName' :: Name -> HQSplit'
|
||||
hqSplitFromName' = fmap HQ'.fromName . splitFromName'
|
||||
|
||||
-- |
|
||||
-- >>> splitFromName "a.b.c"
|
||||
@ -268,6 +280,11 @@ splitFromName' name =
|
||||
seg
|
||||
)
|
||||
|
||||
nameFromSplit' :: Split' -> Name
|
||||
nameFromSplit' (path', seg) = case path' of
|
||||
AbsolutePath' abs -> Name.makeAbsolute . Name.fromReverseSegments $ seg :| reverse (toList $ unabsolute abs)
|
||||
RelativePath' rel -> Name.makeRelative . Name.fromReverseSegments $ seg :| reverse (toList $ unrelative rel)
|
||||
|
||||
-- | Remove a path prefix from a name.
|
||||
-- Returns 'Nothing' if there are no remaining segments to construct the name from.
|
||||
--
|
||||
@ -276,11 +293,13 @@ splitFromName' name =
|
||||
unprefixName :: Absolute -> Name -> Maybe Name
|
||||
unprefixName prefix = toName . unprefix prefix . fromName'
|
||||
|
||||
prefixName :: Absolute -> Name -> Name
|
||||
prefixName p n = fromMaybe n . toName . prefix p . fromName' $ n
|
||||
-- | Returns `Nothing` if the second argument is absolute. A common pattern is
|
||||
-- @fromMaybe name $ maybePrefixName prefix name@ to use the unmodified path in that case.
|
||||
maybePrefixName :: Path' -> Name -> Maybe Name
|
||||
maybePrefixName pre = fmap nameFromSplit' . bitraverse (maybePrefix pre) pure . splitFromName'
|
||||
|
||||
prefixName2 :: Path -> Name -> Name
|
||||
prefixName2 p n = fromMaybe n . toName . prefix2 p . fromName' $ n
|
||||
prefixNameIfRel :: Path' -> Name -> Name
|
||||
prefixNameIfRel p name = fromMaybe name $ maybePrefixName p name
|
||||
|
||||
singleton :: NameSegment -> Path
|
||||
singleton n = fromList [n]
|
||||
@ -546,5 +565,3 @@ instance Convert (path, NameSegment) (path, HQ'.HQSegment) where
|
||||
instance (Convert path0 path1) => Convert (path0, name) (path1, name) where
|
||||
convert =
|
||||
over _1 convert
|
||||
|
||||
instance Parse Name HQSplit' where parse = hqSplitFromName'
|
||||
|
||||
@ -5,7 +5,7 @@ module Unison.PrettyPrintEnv.MonadPretty where
|
||||
import Control.Lens (views, _1, _2)
|
||||
import Control.Monad.Reader (MonadReader, Reader, local, runReader)
|
||||
import Data.Set qualified as Set
|
||||
import Unison.Prelude
|
||||
import Unison.Prelude
|
||||
import Unison.PrettyPrintEnv (PrettyPrintEnv)
|
||||
import Unison.Var (Var)
|
||||
|
||||
|
||||
@ -32,11 +32,15 @@ import Unison.Referent (Referent)
|
||||
------------------------------------------------------------------------------------------------------------------------
|
||||
-- Namer
|
||||
|
||||
-- | A "namer" associates a set of (possibly hash-qualified) names with a referent / type reference.
|
||||
data Namer = Namer
|
||||
{ nameTerm :: Referent -> Set (HQ'.HashQualified Name),
|
||||
nameType :: TypeReference -> Set (HQ'.HashQualified Name)
|
||||
}
|
||||
|
||||
-- | Make a "namer" out of a collection of names, ignoring conflicted names. That is, if references #foo and #bar are
|
||||
-- both associated with name "baz", then the returned namer maps #foo too "baz" (not "baz"#foo) and #bar to "baz" (not
|
||||
-- "baz"#bar).
|
||||
namer :: Names -> Namer
|
||||
namer names =
|
||||
Namer
|
||||
@ -44,6 +48,9 @@ namer names =
|
||||
nameType = Set.map HQ'.fromName . Names.namesForReference names
|
||||
}
|
||||
|
||||
-- | Make a "namer" out of a collection of names, respecting conflicted names. That is, if references #foo and #bar are
|
||||
-- both associated with name "baz", then the returned namer maps #foo too "baz"#foo and #bar to "baz"#bar, but otherwise
|
||||
-- if a reference #qux has a single name "qux", then the returned namer maps #qux to "qux" (not "qux"#qux).
|
||||
hqNamer :: Int -> Names -> Namer
|
||||
hqNamer hashLen names =
|
||||
Namer
|
||||
|
||||
@ -56,7 +56,6 @@ import Data.Primitive.PrimArray as EPA hiding
|
||||
import Data.Primitive.PrimArray qualified as PA
|
||||
import Data.Primitive.Types
|
||||
import Data.Word (Word8)
|
||||
|
||||
import GHC.Exts (toList)
|
||||
|
||||
#ifdef ARRAY_CHECK
|
||||
|
||||
@ -81,15 +81,17 @@ import Network.Simple.TCP as SYS
|
||||
send,
|
||||
)
|
||||
import Network.Socket as SYS
|
||||
( Socket,
|
||||
( PortNumber,
|
||||
Socket,
|
||||
accept,
|
||||
socketPort, PortNumber,
|
||||
socketPort,
|
||||
)
|
||||
import Network.TLS as TLS
|
||||
import Network.TLS.Extra.Cipher as Cipher
|
||||
import Network.UDP as UDP
|
||||
( UDPSocket (..),
|
||||
ClientSockAddr,
|
||||
( ClientSockAddr,
|
||||
ListenSocket,
|
||||
UDPSocket (..),
|
||||
clientSocket,
|
||||
close,
|
||||
recv,
|
||||
@ -99,8 +101,6 @@ import Network.UDP as UDP
|
||||
serverSocket,
|
||||
stop,
|
||||
)
|
||||
|
||||
import Network.TLS.Extra.Cipher as Cipher
|
||||
import System.Clock (Clock (..), getTime, nsec, sec)
|
||||
import System.Directory as SYS
|
||||
( createDirectoryIfMissing,
|
||||
@ -154,7 +154,6 @@ import System.Process as SYS
|
||||
)
|
||||
import System.X509 qualified as X
|
||||
import Unison.ABT.Normalized hiding (TTm)
|
||||
import Unison.Runtime.Crypto.Rsa as Rsa
|
||||
import Unison.Builtin qualified as Ty (builtinTypes)
|
||||
import Unison.Builtin.Decls qualified as Ty
|
||||
import Unison.Prelude hiding (Text, some)
|
||||
@ -164,6 +163,7 @@ import Unison.Runtime.ANF as ANF
|
||||
import Unison.Runtime.ANF.Rehash (checkGroupHashes)
|
||||
import Unison.Runtime.ANF.Serialize as ANF
|
||||
import Unison.Runtime.Array qualified as PA
|
||||
import Unison.Runtime.Crypto.Rsa as Rsa
|
||||
import Unison.Runtime.Exception (die)
|
||||
import Unison.Runtime.Foreign
|
||||
( Foreign (Wrap),
|
||||
@ -1561,13 +1561,13 @@ outIoFailBool stack1 stack2 stack3 extra fail result =
|
||||
)
|
||||
]
|
||||
|
||||
outIoFailTup :: forall v . (Var v) => v -> v -> v -> v -> v -> v -> v -> v -> ANormal v
|
||||
outIoFailTup :: forall v. (Var v) => v -> v -> v -> v -> v -> v -> v -> v -> ANormal v
|
||||
outIoFailTup stack1 stack2 stack3 stack4 stack5 extra fail result =
|
||||
TMatch result . MatchSum $
|
||||
mapFromList
|
||||
[ failureCase stack1 stack2 stack3 extra fail,
|
||||
( 1,
|
||||
([BX, BX],
|
||||
( [BX, BX],
|
||||
TAbss [stack1, stack2]
|
||||
. TLetD stack3 BX (TCon Ty.unitRef 0 [])
|
||||
. TLetD stack4 BX (TCon Ty.pairRef 0 [stack2, stack3])
|
||||
@ -1575,7 +1575,7 @@ outIoFailTup stack1 stack2 stack3 stack4 stack5 extra fail result =
|
||||
$ right stack5
|
||||
)
|
||||
)
|
||||
]
|
||||
]
|
||||
|
||||
outIoFailG ::
|
||||
(Var v) =>
|
||||
@ -2346,7 +2346,7 @@ declareUdpForeigns = do
|
||||
$ \(host :: Util.Text.Text, port :: Util.Text.Text) ->
|
||||
let hostStr = Util.Text.toString host
|
||||
portStr = Util.Text.toString port
|
||||
in UDP.clientSocket hostStr portStr True
|
||||
in UDP.clientSocket hostStr portStr True
|
||||
|
||||
declareForeign Tracked "IO.UDP.UDPSocket.recv.impl.v1" boxToEFBox
|
||||
. mkForeignIOF
|
||||
@ -2374,25 +2374,27 @@ declareUdpForeigns = do
|
||||
$ \(ip :: Util.Text.Text, port :: Util.Text.Text) ->
|
||||
let maybeIp = readMaybe $ Util.Text.toString ip :: Maybe IP
|
||||
maybePort = readMaybe $ Util.Text.toString port :: Maybe PortNumber
|
||||
in case (maybeIp, maybePort) of
|
||||
(Nothing, _) -> fail "Invalid IP Address"
|
||||
(_, Nothing) -> fail "Invalid Port Number"
|
||||
(Just ip, Just pt) -> UDP.serverSocket (ip, pt)
|
||||
in case (maybeIp, maybePort) of
|
||||
(Nothing, _) -> fail "Invalid IP Address"
|
||||
(_, Nothing) -> fail "Invalid Port Number"
|
||||
(Just ip, Just pt) -> UDP.serverSocket (ip, pt)
|
||||
|
||||
declareForeign Tracked "IO.UDP.ListenSocket.toText.impl.v1" boxDirect
|
||||
. mkForeign
|
||||
$ \(sock :: ListenSocket) -> pure $ show sock
|
||||
|
||||
declareForeign Tracked "IO.UDP.ListenSocket.recvFrom.impl.v1" boxToEFTup .
|
||||
mkForeignIOF $ fmap (first Bytes.fromArray) <$> UDP.recvFrom
|
||||
declareForeign Tracked "IO.UDP.ListenSocket.recvFrom.impl.v1" boxToEFTup
|
||||
. mkForeignIOF
|
||||
$ fmap (first Bytes.fromArray) <$> UDP.recvFrom
|
||||
|
||||
declareForeign Tracked "IO.UDP.ClientSockAddr.toText.v1" boxDirect
|
||||
. mkForeign
|
||||
$ \(sock :: ClientSockAddr) -> pure $ show sock
|
||||
|
||||
declareForeign Tracked "IO.UDP.ListenSocket.sendTo.impl.v1" boxBoxBoxToEF0 .
|
||||
mkForeignIOF $ \(socket :: ListenSocket, bytes :: Bytes.Bytes, addr :: ClientSockAddr) ->
|
||||
UDP.sendTo socket (Bytes.toArray bytes) addr
|
||||
declareForeign Tracked "IO.UDP.ListenSocket.sendTo.impl.v1" boxBoxBoxToEF0
|
||||
. mkForeignIOF
|
||||
$ \(socket :: ListenSocket, bytes :: Bytes.Bytes, addr :: ClientSockAddr) ->
|
||||
UDP.sendTo socket (Bytes.toArray bytes) addr
|
||||
|
||||
declareForeigns :: FDecl Symbol ()
|
||||
declareForeigns = do
|
||||
|
||||
@ -1,8 +1,9 @@
|
||||
module Unison.Runtime.Crypto.Rsa (
|
||||
parseRsaPublicKey,
|
||||
parseRsaPrivateKey,
|
||||
rsaErrorToText,
|
||||
) where
|
||||
module Unison.Runtime.Crypto.Rsa
|
||||
( parseRsaPublicKey,
|
||||
parseRsaPrivateKey,
|
||||
rsaErrorToText,
|
||||
)
|
||||
where
|
||||
|
||||
import Crypto.Number.Basic qualified as Crypto
|
||||
import Crypto.PubKey.RSA qualified as RSA
|
||||
|
||||
@ -21,9 +21,9 @@ import Unison.Reference (Reference, pattern Builtin)
|
||||
import Unison.Referent (pattern Ref)
|
||||
import Unison.Runtime.ANF (maskTags)
|
||||
import Unison.Runtime.Array
|
||||
( Array
|
||||
, ByteArray
|
||||
, byteArrayToList
|
||||
( Array,
|
||||
ByteArray,
|
||||
byteArrayToList,
|
||||
)
|
||||
import Unison.Runtime.Foreign
|
||||
( Foreign (..),
|
||||
@ -64,13 +64,13 @@ import Unison.Type
|
||||
booleanRef,
|
||||
charRef,
|
||||
floatRef,
|
||||
iarrayRef,
|
||||
ibytearrayRef,
|
||||
intRef,
|
||||
listRef,
|
||||
natRef,
|
||||
termLinkRef,
|
||||
typeLinkRef,
|
||||
iarrayRef,
|
||||
ibytearrayRef,
|
||||
)
|
||||
import Unison.Util.Bytes qualified as By
|
||||
import Unison.Util.Pretty (indentN, lines, lit, syntaxToColor, wrap)
|
||||
@ -219,8 +219,8 @@ decompileForeign backref topTerms f
|
||||
| Just l <- maybeUnwrapForeign typeLinkRef f =
|
||||
pure $ typeLink () l
|
||||
| Just (a :: Array Closure) <- maybeUnwrapForeign iarrayRef f =
|
||||
app () (ref () iarrayFromListRef) . list () <$>
|
||||
traverse (decompile backref topTerms) (toList a)
|
||||
app () (ref () iarrayFromListRef) . list ()
|
||||
<$> traverse (decompile backref topTerms) (toList a)
|
||||
| Just (a :: ByteArray) <- maybeUnwrapForeign ibytearrayRef f =
|
||||
pure $
|
||||
app
|
||||
|
||||
@ -27,8 +27,8 @@ import Data.Primitive (ByteArray, MutableArray, MutableByteArray)
|
||||
import Data.Tagged (Tagged (..))
|
||||
import Data.X509 qualified as X509
|
||||
import Network.Socket (Socket)
|
||||
import Network.UDP (ListenSocket, UDPSocket, ClientSockAddr)
|
||||
import Network.TLS qualified as TLS (ClientParams, Context, ServerParams)
|
||||
import Network.UDP (ClientSockAddr, ListenSocket, UDPSocket)
|
||||
import System.Clock (TimeSpec)
|
||||
import System.IO (Handle)
|
||||
import System.Process (ProcessHandle)
|
||||
|
||||
@ -3,6 +3,7 @@ module Unison.Syntax.DeclPrinter
|
||||
prettyDeclW,
|
||||
prettyDeclHeader,
|
||||
prettyDeclOrBuiltinHeader,
|
||||
getFieldAndAccessorNames,
|
||||
AccessorName,
|
||||
)
|
||||
where
|
||||
@ -26,7 +27,7 @@ import Unison.PrettyPrintEnv (PrettyPrintEnv)
|
||||
import Unison.PrettyPrintEnv qualified as PPE
|
||||
import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl (..))
|
||||
import Unison.PrettyPrintEnvDecl qualified as PPED
|
||||
import Unison.Reference (Reference, Reference' (DerivedId), TypeReference)
|
||||
import Unison.Reference (Reference, TypeReference)
|
||||
import Unison.Referent qualified as Referent
|
||||
import Unison.Syntax.HashQualified qualified as HQ (toText)
|
||||
import Unison.Syntax.Name qualified as Name
|
||||
@ -125,20 +126,20 @@ prettyDataDecl (PrettyPrintEnvDecl unsuffixifiedPPE suffixifiedPPE) r name dd =
|
||||
constructor (n, (_, _, t)) = constructor' n t
|
||||
constructor' n t = case Type.unArrows t of
|
||||
Nothing -> pure $ prettyPattern unsuffixifiedPPE CT.Data name (ConstructorReference r n)
|
||||
Just ts -> case fieldNames unsuffixifiedPPE r name dd of
|
||||
Just ts -> case getFieldAndAccessorNames unsuffixifiedPPE r name dd of
|
||||
Nothing ->
|
||||
pure
|
||||
. P.group
|
||||
. P.hang' (prettyPattern unsuffixifiedPPE CT.Data name (ConstructorReference r n)) " "
|
||||
$ P.spaced (runPretty suffixifiedPPE (traverse (TypePrinter.prettyRaw Map.empty 10) (init ts)))
|
||||
Just fs -> do
|
||||
Just (fieldNames, _) -> do
|
||||
tell $
|
||||
Set.fromList $
|
||||
[ case accessor of
|
||||
Nothing -> declName `Name.joinDot` fieldName
|
||||
Just accessor -> declName `Name.joinDot` fieldName `Name.joinDot` accessor
|
||||
| HQ.NameOnly declName <- [name],
|
||||
fieldName <- fs,
|
||||
fieldName <- fieldNames,
|
||||
accessor <-
|
||||
[ Nothing,
|
||||
Just (Name.fromSegment NameSegment.setSegment),
|
||||
@ -149,7 +150,7 @@ prettyDataDecl (PrettyPrintEnvDecl unsuffixifiedPPE suffixifiedPPE) r name dd =
|
||||
fmt S.DelimiterChar "{ "
|
||||
<> P.sep
|
||||
(fmt S.DelimiterChar "," <> " " `P.orElse` "\n ")
|
||||
(field <$> zip fs (init ts))
|
||||
(field <$> zip fieldNames (init ts))
|
||||
<> fmt S.DelimiterChar " }"
|
||||
field (fname, typ) =
|
||||
P.group $
|
||||
@ -158,28 +159,31 @@ prettyDataDecl (PrettyPrintEnvDecl unsuffixifiedPPE suffixifiedPPE) r name dd =
|
||||
`P.hang` runPretty suffixifiedPPE (TypePrinter.prettyRaw Map.empty (-1) typ)
|
||||
header = prettyDataHeader name dd <> fmt S.DelimiterChar (" = " `P.orElse` "\n = ")
|
||||
|
||||
-- Comes up with field names for a data declaration which has the form of a
|
||||
-- record, like `type Pt = { x : Int, y : Int }`. Works by generating the
|
||||
-- record accessor terms for the data type, hashing these terms, and then
|
||||
-- checking the `PrettyPrintEnv` for the names of those hashes. If the names for
|
||||
-- these hashes are:
|
||||
-- This function determines if a data declaration "looks like a record", and if so, returns both its auto-generated
|
||||
-- accessor names (such as "Pt.x.set") and field names (such as "x"). Because we generate three accessors per field,
|
||||
-- there will always be three times as many accessors as there are fields.
|
||||
--
|
||||
-- It works by works by generating the record accessor terms for the data type, hashing these terms, and then checking
|
||||
-- the `PrettyPrintEnv` for the names of those hashes.
|
||||
--
|
||||
-- For example, for a type named "Pt", if the names of its accessors are
|
||||
--
|
||||
-- `Pt.x`, `Pt.x.set`, `Pt.x.modify`, `Pt.y`, `Pt.y.set`, `Pt.y.modify`
|
||||
--
|
||||
-- then this matches the naming convention generated by the parser, and we
|
||||
-- return `x` and `y` as the field names.
|
||||
-- then we will return those accessors along with the field names
|
||||
--
|
||||
-- This function bails with `Nothing` if the names aren't an exact match for
|
||||
-- the expected record naming convention.
|
||||
fieldNames ::
|
||||
-- `x`, `y`
|
||||
--
|
||||
-- This function returns `Nothing` if the given data declaration does not "look like a record".
|
||||
getFieldAndAccessorNames ::
|
||||
forall v a.
|
||||
(Var v) =>
|
||||
PrettyPrintEnv ->
|
||||
TypeReference ->
|
||||
HQ.HashQualified Name ->
|
||||
DataDeclaration v a ->
|
||||
Maybe [Name]
|
||||
fieldNames env r hqTypename dd = do
|
||||
Maybe ([Name], [Name]) -- field names, accessor names
|
||||
getFieldAndAccessorNames env r hqTypename dd = do
|
||||
-- If we only have a hash for the decl, then we can't know where in the namespace to look for the generated accessors,
|
||||
-- so we just give up trying to infer whether this was a record (even if it was one).
|
||||
typename <- HQ.toName hqTypename
|
||||
@ -212,10 +216,11 @@ fieldNames env r hqTypename dd = do
|
||||
-- ( #sety , "Pt.y.set" )
|
||||
-- ( #modifyy , "Pt.y.modify" )
|
||||
-- ]
|
||||
let names =
|
||||
[ (r, HQ.toText . PPE.termName env . Referent.Ref $ DerivedId r)
|
||||
| r <- (\(refId, _trm, _typ) -> refId) <$> Map.elems hashes
|
||||
]
|
||||
let accessorNamesByHash =
|
||||
hashes
|
||||
& Map.elems
|
||||
& map \(refId, _term, _typ) ->
|
||||
(refId, HQ.toText (PPE.termName env (Referent.fromTermReferenceId refId)))
|
||||
|
||||
-- {
|
||||
-- #getx => "x"
|
||||
@ -225,10 +230,10 @@ fieldNames env r hqTypename dd = do
|
||||
-- #sety => "y"
|
||||
-- #modifyy => "y"
|
||||
-- }
|
||||
let fieldNames =
|
||||
let fieldNamesByHash =
|
||||
Map.fromList
|
||||
[ (r, f)
|
||||
| (r, n) <- names,
|
||||
| (r, n) <- accessorNamesByHash,
|
||||
let typenameText = Name.toText typename,
|
||||
typenameText `Text.isPrefixOf` n,
|
||||
let rest = Text.drop (Text.length typenameText + 1) n,
|
||||
@ -236,17 +241,19 @@ fieldNames env r hqTypename dd = do
|
||||
rest `elem` ["", ".set", ".modify"]
|
||||
]
|
||||
|
||||
if Map.size fieldNames == length names
|
||||
if Map.size fieldNamesByHash == length accessorNamesByHash
|
||||
then
|
||||
Just
|
||||
[ Name.unsafeParseText name
|
||||
| -- "_0"
|
||||
v <- vars,
|
||||
-- #getx
|
||||
Just (ref, _, _) <- [Map.lookup (Var.namespaced (Name.toVar typename :| [v])) hashes],
|
||||
-- "x"
|
||||
Just name <- [Map.lookup ref fieldNames]
|
||||
]
|
||||
( [ Name.unsafeParseText name
|
||||
| -- "_0"
|
||||
v <- vars,
|
||||
-- #getx
|
||||
Just (ref, _, _) <- [Map.lookup (Var.namespaced (Name.toVar typename :| [v])) hashes],
|
||||
-- "x"
|
||||
Just name <- [Map.lookup ref fieldNamesByHash]
|
||||
],
|
||||
map (Name.unsafeParseText . snd) accessorNamesByHash
|
||||
)
|
||||
else Nothing
|
||||
|
||||
prettyModifier :: DD.Modifier -> Pretty SyntaxText
|
||||
|
||||
@ -84,6 +84,7 @@ import Unison.DataDeclaration
|
||||
import Unison.DataDeclaration qualified as DD
|
||||
import Unison.DataDeclaration.ConstructorId (ConstructorId)
|
||||
import Unison.KindInference qualified as KindInference
|
||||
import Unison.Name (Name)
|
||||
import Unison.Pattern (Pattern)
|
||||
import Unison.Pattern qualified as Pattern
|
||||
import Unison.PatternMatchCoverage (checkMatch)
|
||||
@ -104,7 +105,6 @@ import Unison.Typechecker.TypeLookup qualified as TL
|
||||
import Unison.Typechecker.TypeVar qualified as TypeVar
|
||||
import Unison.Var (Var)
|
||||
import Unison.Var qualified as Var
|
||||
import Unison.Name (Name)
|
||||
|
||||
type TypeVar v loc = TypeVar.TypeVar (B.Blank loc) v
|
||||
|
||||
|
||||
@ -157,8 +157,9 @@ compile (Many correct p) !_ !success = case p of
|
||||
Char cp -> walker (charPatternPred cp)
|
||||
p -> go
|
||||
where
|
||||
go | correct = try "Many" (compile p) success success'
|
||||
| otherwise = compile p success success'
|
||||
go
|
||||
| correct = try "Many" (compile p) success success'
|
||||
| otherwise = compile p success success'
|
||||
success' acc rem
|
||||
| Text.size rem == 0 = success acc rem
|
||||
| otherwise = go acc rem
|
||||
|
||||
@ -1181,7 +1181,7 @@ handleFindI isVerbose fscope ws input = do
|
||||
Cli.Env {codebase} <- ask
|
||||
(pped, names, searchRoot, branch0) <- case fscope of
|
||||
FindLocal p -> do
|
||||
searchRoot <- Cli.resolvePath p
|
||||
searchRoot <- Cli.resolvePath' p
|
||||
branch0 <- Cli.getBranch0At searchRoot
|
||||
let names = Branch.toNames (Branch.withoutLib branch0)
|
||||
-- Don't exclude anything from the pretty printer, since the type signatures we print for
|
||||
@ -1189,7 +1189,7 @@ handleFindI isVerbose fscope ws input = do
|
||||
pped <- Cli.currentPrettyPrintEnvDecl
|
||||
pure (pped, names, Just p, branch0)
|
||||
FindLocalAndDeps p -> do
|
||||
searchRoot <- Cli.resolvePath p
|
||||
searchRoot <- Cli.resolvePath' p
|
||||
branch0 <- Cli.getBranch0At searchRoot
|
||||
let names = Branch.toNames (Branch.withoutTransitiveLibs branch0)
|
||||
-- Don't exclude anything from the pretty printer, since the type signatures we print for
|
||||
|
||||
@ -1,8 +1,11 @@
|
||||
module Unison.Codebase.Editor.HandleInput.EditNamespace (handleEditNamespace) where
|
||||
|
||||
import Control.Monad.Reader
|
||||
import Data.Foldable qualified as Foldable
|
||||
import Data.List.Extra qualified as List
|
||||
import Data.Map qualified as Map
|
||||
import Data.Set qualified as Set
|
||||
import U.Codebase.Reference (Reference' (..))
|
||||
import Unison.Cli.Monad (Cli)
|
||||
import Unison.Cli.Monad qualified as Cli
|
||||
import Unison.Cli.MonadUtils qualified as Cli
|
||||
@ -10,58 +13,87 @@ import Unison.Cli.PrettyPrintUtils qualified as NamesUtils
|
||||
import Unison.Codebase qualified as Codebase
|
||||
import Unison.Codebase.Branch qualified as Branch
|
||||
import Unison.Codebase.Branch.Names qualified as Branch
|
||||
import Unison.Codebase.Editor.DisplayObject qualified as DisplayObject
|
||||
import Unison.Codebase.Editor.HandleInput.ShowDefinition (showDefinitions)
|
||||
import Unison.Codebase.Editor.Input (OutputLocation (..))
|
||||
import Unison.Codebase.Path (Path)
|
||||
import Unison.Codebase.Path qualified as Path
|
||||
import Unison.HashQualified qualified as HQ
|
||||
import Unison.Name (Name)
|
||||
import Unison.Names qualified as Names
|
||||
import Unison.Prelude
|
||||
import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl (..))
|
||||
import Unison.Referent qualified as Referent
|
||||
import Unison.Server.Backend qualified as Backend
|
||||
import Unison.Syntax.DeclPrinter qualified as DeclPrinter
|
||||
import Unison.Util.Monoid (foldMapM)
|
||||
|
||||
handleEditNamespace :: OutputLocation -> [Path] -> Cli ()
|
||||
handleEditNamespace outputLoc inputPaths = do
|
||||
handleEditNamespace outputLoc paths0 = do
|
||||
Cli.Env {codebase} <- ask
|
||||
currentBranch <- Cli.getCurrentBranch0
|
||||
ppe <- NamesUtils.currentPrettyPrintEnvDecl
|
||||
|
||||
-- Adjust the requested list of paths slightly: if it's missing (i.e. `edit.namespace` without arguments), then behave
|
||||
-- as if the empty path (which there is no syntax for, heh) was supplied.
|
||||
let paths =
|
||||
if null inputPaths
|
||||
if null paths0
|
||||
then [Path.empty]
|
||||
else inputPaths
|
||||
else paths0
|
||||
|
||||
-- Make a names object that contains the union of all names in the supplied paths (each prefixed with the associated
|
||||
-- path of course). Special case: if the path is the empty path, then ignore `lib`.
|
||||
let allNamesToEdit =
|
||||
(List.nubOrd paths) & foldMap \path ->
|
||||
let b = Branch.withoutLib $ Branch.getAt0 path currentBranch
|
||||
names = (Branch.toNames b)
|
||||
prefixedNames = case Path.toName path of
|
||||
List.nubOrd paths & foldMap \path ->
|
||||
let branch = (if path == Path.empty then Branch.withoutLib else id) (Branch.getAt0 path currentBranch)
|
||||
names = Branch.toNames branch
|
||||
in -- PPED.makePPED (PPE.hqNamer hashLen ns) (PPE.suffixifyByHash ns)
|
||||
|
||||
case Path.toName path of
|
||||
Nothing -> names
|
||||
Just pathPrefix -> Names.prefix0 pathPrefix names
|
||||
in prefixedNames
|
||||
|
||||
let termRefs = Names.termReferences allNamesToEdit
|
||||
-- We only need to (optionally) include cycles for type references, not term references,
|
||||
-- because 'update' is smart enough to patch-up cycles as expected for terms.
|
||||
let typeRefsWithoutCycles = Names.typeReferences allNamesToEdit
|
||||
typeRefs <- Cli.runTransaction $
|
||||
case includeCycles of
|
||||
Backend.IncludeCycles -> foldMapM Codebase.componentReferencesForReference typeRefsWithoutCycles
|
||||
Backend.DontIncludeCycles -> pure typeRefsWithoutCycles
|
||||
let typeRefs = Names.typeReferences allNamesToEdit
|
||||
|
||||
terms <-
|
||||
termRefs
|
||||
& foldMapM \ref ->
|
||||
Map.singleton ref <$> Backend.displayTerm codebase ref
|
||||
& Cli.runTransaction
|
||||
(types, terms) <-
|
||||
Cli.runTransaction do
|
||||
(types, accessorNames) <-
|
||||
Foldable.foldlM
|
||||
( \(types, accessorNames) ref ->
|
||||
case ref of
|
||||
ReferenceBuiltin _ -> do
|
||||
let !types1 = Map.insert ref (DisplayObject.BuiltinObject ()) types
|
||||
pure (types1, accessorNames)
|
||||
ReferenceDerived refId -> do
|
||||
decl <- Codebase.unsafeGetTypeDeclaration codebase refId
|
||||
let !types1 = Map.insert ref (DisplayObject.UserObject decl) types
|
||||
let !accessorNames1 =
|
||||
accessorNames <> case decl of
|
||||
Left _effectDecl -> Set.empty
|
||||
Right dataDecl ->
|
||||
let declAccessorNames :: Name -> Set Name
|
||||
declAccessorNames declName =
|
||||
case DeclPrinter.getFieldAndAccessorNames
|
||||
ppe.unsuffixifiedPPE
|
||||
ref
|
||||
(HQ.fromName declName)
|
||||
dataDecl of
|
||||
Nothing -> Set.empty
|
||||
Just (_fieldNames, theAccessorNames) -> Set.fromList theAccessorNames
|
||||
in foldMap declAccessorNames (Names.namesForReference allNamesToEdit ref)
|
||||
pure (types1, accessorNames1)
|
||||
)
|
||||
(Map.empty, Set.empty)
|
||||
typeRefs
|
||||
terms <-
|
||||
termRefs & foldMapM \ref ->
|
||||
let isRecordAccessor =
|
||||
not (Set.disjoint (Names.namesForReferent allNamesToEdit (Referent.fromTermReference ref)) accessorNames)
|
||||
in if isRecordAccessor
|
||||
then pure Map.empty
|
||||
else Map.singleton ref <$> Backend.displayTerm codebase ref
|
||||
pure (types, terms)
|
||||
|
||||
types <-
|
||||
typeRefs
|
||||
& foldMapM \ref ->
|
||||
Map.singleton ref <$> Backend.displayType codebase ref
|
||||
& Cli.runTransaction
|
||||
let misses = []
|
||||
showDefinitions outputLoc ppe terms types misses
|
||||
where
|
||||
-- `view`: don't include cycles; `edit`: include cycles
|
||||
includeCycles =
|
||||
case outputLoc of
|
||||
ConsoleLocation -> Backend.DontIncludeCycles
|
||||
FileLocation _ -> Backend.IncludeCycles
|
||||
LatestFileLocation -> Backend.IncludeCycles
|
||||
|
||||
@ -974,6 +974,8 @@ findConflictedAlias defns diff =
|
||||
g hashed1 alias =
|
||||
case Map.lookup alias diff of
|
||||
Just (DiffOp'Update hashed2) | hashed1 == hashed2.new -> Nothing
|
||||
-- If "foo" was updated but its alias "bar" was deleted, that's ok
|
||||
Just (DiffOp'Delete _) -> Nothing
|
||||
_ -> Just (name, alias)
|
||||
|
||||
-- Given a name like "base", try "base__1", then "base__2", etc, until we find a name that doesn't
|
||||
|
||||
@ -452,22 +452,23 @@ data UploadPlan = UploadPlan
|
||||
-- Execute an upload plan.
|
||||
executeUploadPlan :: UploadPlan -> Cli ()
|
||||
executeUploadPlan UploadPlan {remoteBranch, causalHash, afterUploadAction} = do
|
||||
numUploaded <-
|
||||
(uploadResult, numUploaded) <-
|
||||
Cli.with withEntitiesUploadedProgressCallback \(uploadedCallback, getNumUploaded) -> do
|
||||
let upload =
|
||||
Share.uploadEntities
|
||||
(codeserverBaseURL Codeserver.defaultCodeserver)
|
||||
-- On the wire, the remote branch is encoded as e.g.
|
||||
-- { "repo_info": "@unison/base/@arya/topic", ... }
|
||||
(Share.RepoInfo (into @Text (ProjectAndBranch (remoteBranch ^. #project) (remoteBranch ^. #branch))))
|
||||
(Set.NonEmpty.singleton causalHash)
|
||||
uploadedCallback
|
||||
upload & onLeftM \err0 -> do
|
||||
(Cli.returnEarly . Output.ShareError) case err0 of
|
||||
Share.SyncError err -> ShareErrorUploadEntities err
|
||||
Share.TransportError err -> ShareErrorTransport err
|
||||
liftIO getNumUploaded
|
||||
uploadResult <-
|
||||
Share.uploadEntities
|
||||
(codeserverBaseURL Codeserver.defaultCodeserver)
|
||||
-- On the wire, the remote branch is encoded as e.g.
|
||||
-- { "repo_info": "@unison/base/@arya/topic", ... }
|
||||
(Share.RepoInfo (into @Text (ProjectAndBranch (remoteBranch ^. #project) (remoteBranch ^. #branch))))
|
||||
(Set.NonEmpty.singleton causalHash)
|
||||
uploadedCallback
|
||||
numUploaded <- liftIO getNumUploaded
|
||||
pure (uploadResult, numUploaded)
|
||||
Cli.respond (Output.UploadedEntities numUploaded)
|
||||
uploadResult & onLeft \err0 -> do
|
||||
(Cli.returnEarly . Output.ShareError) case err0 of
|
||||
Share.SyncError err -> ShareErrorUploadEntities err
|
||||
Share.TransportError err -> ShareErrorTransport err
|
||||
afterUploadAction
|
||||
let ProjectAndBranch projectName branchName = remoteBranch
|
||||
Cli.respond (ViewOnShare (Right (Share.hardCodedUri, projectName, branchName)))
|
||||
|
||||
@ -79,7 +79,7 @@ resolveTerm name = do
|
||||
case lookupTerm name names of
|
||||
[] -> Cli.returnEarly (TermNotFound $ fromJust parsed)
|
||||
where
|
||||
parsed = hqSplitFromName' =<< HQ.toName name
|
||||
parsed = hqSplitFromName' <$> HQ.toName name
|
||||
[rf] -> pure rf
|
||||
rfs ->
|
||||
Cli.returnEarly (TermAmbiguous suffixifiedPPE name (fromList rfs))
|
||||
@ -92,7 +92,7 @@ resolveCon name = do
|
||||
case lookupCon name names of
|
||||
([], _) -> Cli.returnEarly (TermNotFound $ fromJust parsed)
|
||||
where
|
||||
parsed = hqSplitFromName' =<< HQ.toName name
|
||||
parsed = hqSplitFromName' <$> HQ.toName name
|
||||
([co], _) -> pure co
|
||||
(_, rfts) ->
|
||||
Cli.returnEarly (TermAmbiguous suffixifiedPPE name (fromList rfts))
|
||||
@ -105,7 +105,7 @@ resolveTermRef name = do
|
||||
case lookupTermRefs name names of
|
||||
([], _) -> Cli.returnEarly (TermNotFound $ fromJust parsed)
|
||||
where
|
||||
parsed = hqSplitFromName' =<< HQ.toName name
|
||||
parsed = hqSplitFromName' <$> HQ.toName name
|
||||
([rf], _) -> pure rf
|
||||
(_, rfts) ->
|
||||
Cli.returnEarly (TermAmbiguous suffixifiedPPE name (fromList rfts))
|
||||
|
||||
@ -41,8 +41,8 @@ import Unison.Cli.Pretty qualified as Pretty
|
||||
import Unison.Cli.TypeCheck (computeTypecheckingEnvironment)
|
||||
import Unison.Cli.UniqueTypeGuidLookup qualified as Cli
|
||||
import Unison.Codebase qualified as Codebase
|
||||
import Unison.Codebase.Branch qualified as Branch
|
||||
import Unison.Codebase.Branch (Branch0)
|
||||
import Unison.Codebase.Branch qualified as Branch
|
||||
import Unison.Codebase.Branch.Names qualified as Branch
|
||||
import Unison.Codebase.BranchUtil qualified as BranchUtil
|
||||
import Unison.Codebase.Editor.Output (Output)
|
||||
|
||||
@ -284,8 +284,8 @@ data OutputLocation
|
||||
deriving (Eq, Show)
|
||||
|
||||
data FindScope
|
||||
= FindLocal Path
|
||||
| FindLocalAndDeps Path
|
||||
= FindLocal Path'
|
||||
| FindLocalAndDeps Path'
|
||||
| FindGlobal
|
||||
deriving stock (Eq, Show)
|
||||
|
||||
|
||||
@ -409,7 +409,6 @@ data Output
|
||||
| UseLibInstallNotPull !(ProjectAndBranch ProjectName ProjectBranchName)
|
||||
| PullIntoMissingBranch !(ReadRemoteNamespace Share.RemoteProjectBranch) !(ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
|
||||
|
||||
|
||||
data UpdateOrUpgrade = UOUUpdate | UOUUpgrade
|
||||
|
||||
-- | What did we create a project branch from?
|
||||
|
||||
@ -3,7 +3,7 @@ module Unison.Codebase.Editor.StructuredArgument where
|
||||
import GHC.Generics (Generic)
|
||||
import U.Codebase.HashTags (CausalHash)
|
||||
import Unison.Codebase.Editor.Input
|
||||
import Unison.Codebase.Path (Path, Path')
|
||||
import Unison.Codebase.Path (Path')
|
||||
import Unison.Codebase.Path qualified as Path
|
||||
import Unison.HashQualified qualified as HQ
|
||||
import Unison.HashQualified' qualified as HQ'
|
||||
@ -25,5 +25,5 @@ data StructuredArgument
|
||||
| NameWithBranchPrefix AbsBranchId Name
|
||||
| HashQualifiedWithBranchPrefix AbsBranchId (HQ'.HashQualified Name)
|
||||
| ShallowListEntry Path' (ShallowListEntry Symbol Ann)
|
||||
| SearchResult (Maybe Path) SearchResult
|
||||
| SearchResult (Maybe Path') SearchResult
|
||||
deriving (Eq, Generic, Show)
|
||||
|
||||
@ -136,6 +136,7 @@ where
|
||||
|
||||
import Control.Lens (preview, review)
|
||||
import Control.Lens.Cons qualified as Cons
|
||||
import Data.Bitraversable (bitraverse)
|
||||
import Data.List (intercalate)
|
||||
import Data.List.Extra qualified as List
|
||||
import Data.List.NonEmpty qualified as NE
|
||||
@ -245,7 +246,7 @@ formatStructuredArgument schLength = \case
|
||||
prefixBranchId :: Input.AbsBranchId -> Name -> Text
|
||||
prefixBranchId branchId name = case branchId of
|
||||
Left sch -> "#" <> SCH.toText sch <> ":" <> Name.toText (Name.makeAbsolute name)
|
||||
Right pathPrefix -> Name.toText (Name.makeAbsolute . Path.prefixName pathPrefix $ name)
|
||||
Right pathPrefix -> Name.toText (Path.prefixNameIfRel (Path.AbsolutePath' pathPrefix) name)
|
||||
|
||||
entryToHQText :: Path' -> ShallowListEntry v Ann -> Text
|
||||
entryToHQText pathArg =
|
||||
@ -280,15 +281,22 @@ showPatternHelp i =
|
||||
I.help i
|
||||
]
|
||||
|
||||
shallowListEntryToHQ' :: ShallowListEntry v Ann -> HQ'.HashQualified Name
|
||||
shallowListEntryToHQ' = \case
|
||||
ShallowTermEntry termEntry -> Backend.termEntryHQName termEntry
|
||||
ShallowTypeEntry typeEntry -> Backend.typeEntryHQName typeEntry
|
||||
ShallowBranchEntry ns _ _ -> HQ'.fromName $ Name.fromSegment ns
|
||||
ShallowPatchEntry ns -> HQ'.fromName $ Name.fromSegment ns
|
||||
|
||||
-- | restores the full hash to these search results, for _numberedArgs purposes
|
||||
searchResultToHQ :: Maybe Path -> SearchResult -> HQ.HashQualified Name
|
||||
searchResultToHQ :: Maybe Path' -> SearchResult -> HQ.HashQualified Name
|
||||
searchResultToHQ oprefix = \case
|
||||
SR.Tm' n r _ -> HQ.requalify (addPrefix <$> n) r
|
||||
SR.Tp' n r _ -> HQ.requalify (addPrefix <$> n) (Referent.Ref r)
|
||||
_ -> error "impossible match failure"
|
||||
where
|
||||
addPrefix :: Name -> Name
|
||||
addPrefix = maybe id Path.prefixName2 oprefix
|
||||
addPrefix = maybe id Path.prefixNameIfRel oprefix
|
||||
|
||||
unsupportedStructuredArgument :: Text -> Text -> I.Argument -> Either (P.Pretty CT.ColorText) String
|
||||
unsupportedStructuredArgument command expected =
|
||||
@ -328,7 +336,7 @@ wrongStructuredArgument expected actual =
|
||||
SA.HashQualified _ -> "a hash-qualified name"
|
||||
SA.NameWithBranchPrefix _ _ -> "a name"
|
||||
SA.HashQualifiedWithBranchPrefix _ _ -> "a hash-qualified name"
|
||||
SA.ShallowListEntry _ _ -> "an annotated symbol"
|
||||
SA.ShallowListEntry _ _ -> "a name"
|
||||
SA.SearchResult _ _ -> "a search result"
|
||||
|
||||
wrongArgsLength :: Text -> [a] -> Either (P.Pretty CT.ColorText) b
|
||||
@ -399,23 +407,34 @@ handleHashQualifiedNameArg =
|
||||
\case
|
||||
SA.Name name -> pure $ HQ.NameOnly name
|
||||
SA.NameWithBranchPrefix mprefix name ->
|
||||
pure . HQ.NameOnly $ foldr (\prefix -> Name.makeAbsolute . Path.prefixName prefix) name mprefix
|
||||
pure . HQ.NameOnly $ foldr (Path.prefixNameIfRel . Path.AbsolutePath') name mprefix
|
||||
SA.HashQualified hqname -> pure hqname
|
||||
SA.HashQualifiedWithBranchPrefix mprefix hqname ->
|
||||
pure . HQ'.toHQ $ foldr (\prefix -> fmap $ Name.makeAbsolute . Path.prefixName prefix) hqname mprefix
|
||||
pure . HQ'.toHQ $ foldr (\prefix -> fmap $ Path.prefixNameIfRel (Path.AbsolutePath' prefix)) hqname mprefix
|
||||
SA.ShallowListEntry prefix entry ->
|
||||
pure . HQ'.toHQ . fmap (Path.prefixNameIfRel prefix) $ shallowListEntryToHQ' entry
|
||||
SA.SearchResult mpath result -> pure $ searchResultToHQ mpath result
|
||||
otherArgType -> Left $ wrongStructuredArgument "a hash-qualified name" otherArgType
|
||||
|
||||
handlePathArg :: I.Argument -> Either (P.Pretty CT.ColorText) Path.Path
|
||||
handlePathArg :: I.Argument -> Either (P.Pretty CT.ColorText) Path
|
||||
handlePathArg =
|
||||
either
|
||||
(first P.text . Path.parsePath)
|
||||
\case
|
||||
SA.Name name -> pure $ Path.fromName name
|
||||
SA.NameWithBranchPrefix mprefix name -> pure . Path.fromName $ foldr Path.prefixName name mprefix
|
||||
otherArgType -> Left $ wrongStructuredArgument "a relative path" otherArgType
|
||||
SA.NameWithBranchPrefix _ name -> pure $ Path.fromName name
|
||||
otherArgType ->
|
||||
either
|
||||
(const . Left $ wrongStructuredArgument "a relative path" otherArgType)
|
||||
( \name ->
|
||||
if Name.isRelative name
|
||||
then pure $ Path.fromName name
|
||||
else Left $ wrongStructuredArgument "a relative path" otherArgType
|
||||
)
|
||||
. handleNameArg
|
||||
$ pure otherArgType
|
||||
|
||||
handlePath'Arg :: I.Argument -> Either (P.Pretty CT.ColorText) Path.Path'
|
||||
handlePath'Arg :: I.Argument -> Either (P.Pretty CT.ColorText) Path'
|
||||
handlePath'Arg =
|
||||
either
|
||||
(first P.text . Path.parsePath')
|
||||
@ -423,8 +442,9 @@ handlePath'Arg =
|
||||
SA.AbsolutePath path -> pure $ Path.absoluteToPath' path
|
||||
SA.Name name -> pure $ Path.fromName' name
|
||||
SA.NameWithBranchPrefix mprefix name ->
|
||||
pure . Path.fromName' $ foldr (\prefix -> Name.makeAbsolute . Path.prefixName prefix) name mprefix
|
||||
otherArgType -> Left $ wrongStructuredArgument "a namespace" otherArgType
|
||||
pure . Path.fromName' $ foldr (Path.prefixNameIfRel . Path.AbsolutePath') name mprefix
|
||||
otherArgType ->
|
||||
bimap (const $ wrongStructuredArgument "a path" otherArgType) Path.fromName' . handleNameArg $ pure otherArgType
|
||||
|
||||
handleNewName :: I.Argument -> Either (P.Pretty CT.ColorText) Path.Split'
|
||||
handleNewName =
|
||||
@ -432,7 +452,7 @@ handleNewName =
|
||||
(first P.text . Path.parseSplit')
|
||||
(const . Left $ "can’t use a numbered argument for a new name")
|
||||
|
||||
handleNewPath :: I.Argument -> Either (P.Pretty CT.ColorText) Path.Path'
|
||||
handleNewPath :: I.Argument -> Either (P.Pretty CT.ColorText) Path'
|
||||
handleNewPath =
|
||||
either
|
||||
(first P.text . Path.parsePath')
|
||||
@ -445,9 +465,7 @@ handleSplitArg =
|
||||
(first P.text . Path.parseSplit)
|
||||
\case
|
||||
SA.Name name | Name.isRelative name -> pure $ Path.splitFromName name
|
||||
SA.NameWithBranchPrefix (Left _) name | Name.isRelative name -> pure $ Path.splitFromName name
|
||||
SA.NameWithBranchPrefix (Right prefix) name
|
||||
| Name.isRelative name -> pure . Path.splitFromName . Name.makeAbsolute $ Path.prefixName prefix name
|
||||
SA.NameWithBranchPrefix _ name | Name.isRelative name -> pure $ Path.splitFromName name
|
||||
otherNumArg -> Left $ wrongStructuredArgument "a relative name" otherNumArg
|
||||
|
||||
handleSplit'Arg :: I.Argument -> Either (P.Pretty CT.ColorText) Path.Split'
|
||||
@ -458,7 +476,7 @@ handleSplit'Arg =
|
||||
SA.Name name -> pure $ Path.splitFromName' name
|
||||
SA.NameWithBranchPrefix (Left _) name -> pure $ Path.splitFromName' name
|
||||
SA.NameWithBranchPrefix (Right prefix) name ->
|
||||
pure . Path.splitFromName' . Name.makeAbsolute $ Path.prefixName prefix name
|
||||
pure . Path.splitFromName' $ Path.prefixNameIfRel (Path.AbsolutePath' prefix) name
|
||||
otherNumArg -> Left $ wrongStructuredArgument "a name" otherNumArg
|
||||
|
||||
handleProjectBranchNameArg :: I.Argument -> Either (P.Pretty CT.ColorText) ProjectBranchName
|
||||
@ -477,7 +495,7 @@ handleBranchIdArg =
|
||||
SA.AbsolutePath path -> pure . pure $ Path.absoluteToPath' path
|
||||
SA.Name name -> pure . pure $ Path.fromName' name
|
||||
SA.NameWithBranchPrefix mprefix name ->
|
||||
pure . pure . Path.fromName' $ either (const name) (Name.makeAbsolute . flip Path.prefixName name) mprefix
|
||||
pure . pure . Path.fromName' $ foldr (Path.prefixNameIfRel . Path.AbsolutePath') name mprefix
|
||||
SA.Namespace hash -> pure . Left $ SCH.fromFullHash hash
|
||||
otherNumArg -> Left $ wrongStructuredArgument "a branch id" otherNumArg
|
||||
|
||||
@ -493,7 +511,7 @@ handleBranchIdOrProjectArg =
|
||||
SA.Name name -> pure . This . pure $ Path.fromName' name
|
||||
SA.NameWithBranchPrefix (Left _) name -> pure . This . pure $ Path.fromName' name
|
||||
SA.NameWithBranchPrefix (Right prefix) name ->
|
||||
pure . This . pure . Path.fromName' . Name.makeAbsolute $ Path.prefixName prefix name
|
||||
pure . This . pure . Path.fromName' $ Path.prefixNameIfRel (Path.AbsolutePath' prefix) name
|
||||
SA.ProjectBranch pb -> pure $ pure pb
|
||||
otherArgType -> Left $ wrongStructuredArgument "a branch" otherArgType
|
||||
where
|
||||
@ -525,7 +543,7 @@ handleBranchId2Arg =
|
||||
SA.Name name -> pure . pure . LoosePath $ Path.fromName' name
|
||||
SA.NameWithBranchPrefix (Left _) name -> pure . pure . LoosePath $ Path.fromName' name
|
||||
SA.NameWithBranchPrefix (Right prefix) name ->
|
||||
pure . pure . LoosePath . Path.fromName' . Name.makeAbsolute $ Path.prefixName prefix name
|
||||
pure . pure . LoosePath . Path.fromName' $ Path.prefixNameIfRel (Path.AbsolutePath' prefix) name
|
||||
SA.ProjectBranch (ProjectAndBranch mproject branch) ->
|
||||
pure . pure . BranchRelative . This $ maybe (Left branch) (pure . (,branch)) mproject
|
||||
otherNumArg -> Left $ wrongStructuredArgument "a branch id" otherNumArg
|
||||
@ -539,7 +557,7 @@ handleBranchRelativePathArg =
|
||||
SA.Name name -> pure . LoosePath $ Path.fromName' name
|
||||
SA.NameWithBranchPrefix (Left _) name -> pure . LoosePath $ Path.fromName' name
|
||||
SA.NameWithBranchPrefix (Right prefix) name ->
|
||||
pure . LoosePath . Path.fromName' . Name.makeAbsolute $ Path.prefixName prefix name
|
||||
pure . LoosePath . Path.fromName' $ Path.prefixNameIfRel (Path.AbsolutePath' prefix) name
|
||||
SA.ProjectBranch (ProjectAndBranch mproject branch) ->
|
||||
pure . BranchRelative . This $ maybe (Left branch) (pure . (,branch)) mproject
|
||||
otherNumArg -> Left $ wrongStructuredArgument "a branch id" otherNumArg
|
||||
@ -571,10 +589,13 @@ handleHashQualifiedSplit'Arg =
|
||||
either
|
||||
(first P.text . Path.parseHQSplit')
|
||||
\case
|
||||
SA.Name name -> pure $ Path.hqSplitFromName' name
|
||||
hq@(SA.HashQualified name) -> first (const $ expectedButActually "a name" hq "a hash") $ hqNameToSplit' name
|
||||
SA.HashQualifiedWithBranchPrefix (Left _) hqname -> pure $ hq'NameToSplit' hqname
|
||||
SA.HashQualifiedWithBranchPrefix (Right prefix) hqname ->
|
||||
pure . hq'NameToSplit' $ Name.makeAbsolute . Path.prefixName prefix <$> hqname
|
||||
pure . hq'NameToSplit' $ Path.prefixNameIfRel (Path.AbsolutePath' prefix) <$> hqname
|
||||
SA.ShallowListEntry prefix entry ->
|
||||
pure . hq'NameToSplit' . fmap (Path.prefixNameIfRel prefix) $ shallowListEntryToHQ' entry
|
||||
sr@(SA.SearchResult mpath result) ->
|
||||
first (const $ expectedButActually "a name" sr "a hash") . hqNameToSplit' $ searchResultToHQ mpath result
|
||||
otherNumArg -> Left $ wrongStructuredArgument "a name" otherNumArg
|
||||
@ -584,10 +605,19 @@ handleHashQualifiedSplitArg =
|
||||
either
|
||||
(first P.text . Path.parseHQSplit)
|
||||
\case
|
||||
n@(SA.Name name) ->
|
||||
bitraverse
|
||||
( \case
|
||||
Path.AbsolutePath' _ -> Left $ expectedButActually "a relative name" n "an absolute name"
|
||||
Path.RelativePath' p -> pure $ Path.unrelative p
|
||||
)
|
||||
pure
|
||||
$ Path.hqSplitFromName' name
|
||||
hq@(SA.HashQualified name) -> first (const $ expectedButActually "a name" hq "a hash") $ hqNameToSplit name
|
||||
SA.HashQualifiedWithBranchPrefix (Left _) hqname -> pure $ hq'NameToSplit hqname
|
||||
SA.HashQualifiedWithBranchPrefix (Right prefix) hqname ->
|
||||
pure . hq'NameToSplit $ Name.makeAbsolute . Path.prefixName prefix <$> hqname
|
||||
pure . hq'NameToSplit $ Path.prefixNameIfRel (Path.AbsolutePath' prefix) <$> hqname
|
||||
SA.ShallowListEntry _ entry -> pure . hq'NameToSplit $ shallowListEntryToHQ' entry
|
||||
sr@(SA.SearchResult mpath result) ->
|
||||
first (const $ expectedButActually "a name" sr "a hash") . hqNameToSplit $ searchResultToHQ mpath result
|
||||
otherNumArg -> Left $ wrongStructuredArgument "a relative name" otherNumArg
|
||||
@ -609,7 +639,9 @@ handleShortHashOrHQSplit'Arg =
|
||||
SA.HashQualified name -> pure $ hqNameToSplit' name
|
||||
SA.HashQualifiedWithBranchPrefix (Left _) hqname -> pure . pure $ hq'NameToSplit' hqname
|
||||
SA.HashQualifiedWithBranchPrefix (Right prefix) hqname ->
|
||||
pure . pure $ hq'NameToSplit' (Name.makeAbsolute . Path.prefixName prefix <$> hqname)
|
||||
pure . pure $ hq'NameToSplit' (Path.prefixNameIfRel (Path.AbsolutePath' prefix) <$> hqname)
|
||||
SA.ShallowListEntry prefix entry ->
|
||||
pure . pure . hq'NameToSplit' . fmap (Path.prefixNameIfRel prefix) $ shallowListEntryToHQ' entry
|
||||
SA.SearchResult mpath result -> pure . hqNameToSplit' $ searchResultToHQ mpath result
|
||||
otherNumArg -> Left $ wrongStructuredArgument "a hash or name" otherNumArg
|
||||
|
||||
@ -628,11 +660,13 @@ handleNameArg =
|
||||
\case
|
||||
SA.Name name -> pure name
|
||||
SA.NameWithBranchPrefix (Left _) name -> pure name
|
||||
SA.NameWithBranchPrefix (Right prefix) name -> pure . Name.makeAbsolute $ Path.prefixName prefix name
|
||||
SA.NameWithBranchPrefix (Right prefix) name -> pure $ Path.prefixNameIfRel (Path.AbsolutePath' prefix) name
|
||||
SA.HashQualified hqname -> maybe (Left "can’t find a name from the numbered arg") pure $ HQ.toName hqname
|
||||
SA.HashQualifiedWithBranchPrefix (Left _) hqname -> pure $ HQ'.toName hqname
|
||||
SA.HashQualifiedWithBranchPrefix (Right prefix) hqname ->
|
||||
pure . Name.makeAbsolute . Path.prefixName prefix $ HQ'.toName hqname
|
||||
pure . Path.prefixNameIfRel (Path.AbsolutePath' prefix) $ HQ'.toName hqname
|
||||
SA.ShallowListEntry prefix entry ->
|
||||
pure . HQ'.toName . fmap (Path.prefixNameIfRel prefix) $ shallowListEntryToHQ' entry
|
||||
SA.SearchResult mpath result ->
|
||||
maybe (Left "can’t find a name from the numbered arg") pure . HQ.toName $ searchResultToHQ mpath result
|
||||
otherNumArg -> Left $ wrongStructuredArgument "a name" otherNumArg
|
||||
@ -671,7 +705,7 @@ handlePushSourceArg =
|
||||
SA.Name name -> pure . Input.PathySource $ Path.fromName' name
|
||||
SA.NameWithBranchPrefix (Left _) name -> pure . Input.PathySource $ Path.fromName' name
|
||||
SA.NameWithBranchPrefix (Right prefix) name ->
|
||||
pure . Input.PathySource . Path.fromName' . Name.makeAbsolute $ Path.prefixName prefix name
|
||||
pure . Input.PathySource . Path.fromName' $ Path.prefixNameIfRel (Path.AbsolutePath' prefix) name
|
||||
SA.Project project -> pure . Input.ProjySource $ This project
|
||||
SA.ProjectBranch (ProjectAndBranch project branch) -> pure . Input.ProjySource $ maybe That These project branch
|
||||
otherNumArg -> Left $ wrongStructuredArgument "a source to push from" otherNumArg
|
||||
@ -1054,7 +1088,7 @@ sfind =
|
||||
InputPattern "rewrite.find" ["sfind"] I.Visible [("rewrite-rule definition", Required, definitionQueryArg)] msg parse
|
||||
where
|
||||
parse = \case
|
||||
[q] -> Input.StructuredFindI (Input.FindLocal Path.empty) <$> handleHashQualifiedNameArg q
|
||||
[q] -> Input.StructuredFindI (Input.FindLocal Path.relativeEmpty') <$> handleHashQualifiedNameArg q
|
||||
args -> wrongArgsLength "exactly one argument" args
|
||||
msg =
|
||||
P.lines
|
||||
@ -1112,10 +1146,10 @@ sfindReplace =
|
||||
]
|
||||
|
||||
find :: InputPattern
|
||||
find = find' "find" (Input.FindLocal Path.empty)
|
||||
find = find' "find" (Input.FindLocal Path.relativeEmpty')
|
||||
|
||||
findAll :: InputPattern
|
||||
findAll = find' "find.all" (Input.FindLocalAndDeps Path.empty)
|
||||
findAll = find' "find.all" (Input.FindLocalAndDeps Path.relativeEmpty')
|
||||
|
||||
findGlobal :: InputPattern
|
||||
findGlobal = find' "find.global" Input.FindGlobal
|
||||
@ -1124,7 +1158,7 @@ findIn, findInAll :: InputPattern
|
||||
findIn = findIn' "find-in" Input.FindLocal
|
||||
findInAll = findIn' "find-in.all" Input.FindLocalAndDeps
|
||||
|
||||
findIn' :: String -> (Path.Path -> Input.FindScope) -> InputPattern
|
||||
findIn' :: String -> (Path' -> Input.FindScope) -> InputPattern
|
||||
findIn' cmd mkfscope =
|
||||
InputPattern
|
||||
cmd
|
||||
@ -1133,7 +1167,7 @@ findIn' cmd mkfscope =
|
||||
[("namespace", Required, namespaceArg), ("query", ZeroPlus, exactDefinitionArg)]
|
||||
findHelp
|
||||
\case
|
||||
p : args -> Input.FindI False . mkfscope <$> handlePathArg p <*> pure (unifyArgument <$> args)
|
||||
p : args -> Input.FindI False . mkfscope <$> handlePath'Arg p <*> pure (unifyArgument <$> args)
|
||||
args -> wrongArgsLength "at least one argument" args
|
||||
|
||||
findHelp :: P.Pretty CT.ColorText
|
||||
@ -1211,7 +1245,7 @@ findVerbose =
|
||||
( "`find.verbose` searches for definitions like `find`, but includes hashes "
|
||||
<> "and aliases in the results."
|
||||
)
|
||||
(pure . Input.FindI True (Input.FindLocal Path.empty) . fmap unifyArgument)
|
||||
(pure . Input.FindI True (Input.FindLocal Path.relativeEmpty') . fmap unifyArgument)
|
||||
|
||||
findVerboseAll :: InputPattern
|
||||
findVerboseAll =
|
||||
@ -1223,7 +1257,7 @@ findVerboseAll =
|
||||
( "`find.all.verbose` searches for definitions like `find.all`, but includes hashes "
|
||||
<> "and aliases in the results."
|
||||
)
|
||||
(pure . Input.FindI True (Input.FindLocalAndDeps Path.empty) . fmap unifyArgument)
|
||||
(pure . Input.FindI True (Input.FindLocalAndDeps Path.relativeEmpty') . fmap unifyArgument)
|
||||
|
||||
renameTerm :: InputPattern
|
||||
renameTerm =
|
||||
|
||||
@ -1372,6 +1372,7 @@ notifyUser dir = \case
|
||||
<> "or"
|
||||
<> IP.makeExample' IP.delete
|
||||
<> "all but one of the definitions; I'll use the remaining name when propagating updates."
|
||||
<> "(You can `rename` it back after the merge.)"
|
||||
)
|
||||
]
|
||||
)
|
||||
|
||||
@ -45,7 +45,7 @@ relocateToNameRoot perspective query rootBranch = do
|
||||
(_sharedPrefix, remainder, Path.Empty) -> do
|
||||
-- Since the project is higher up, we need to prefix the query
|
||||
-- with the remainder of the path
|
||||
pure . Right $ (projectRoot, query <&> Path.prefixName (Path.Absolute remainder))
|
||||
pure $ Right (projectRoot, query <&> Path.prefixNameIfRel (Path.AbsolutePath' $ Path.Absolute remainder))
|
||||
-- The namesRoot and project root are disjoint, this shouldn't ever happen.
|
||||
(_, _, _) -> pure $ Left (DisjointProjectAndPerspective perspective projectRoot)
|
||||
|
||||
|
||||
@ -130,7 +130,8 @@ nameSearchForPerspective codebase namesPerspective@Ops.NamesPerspective {pathToM
|
||||
|
||||
-- Fully qualify a name by prepending the current namespace perspective's path
|
||||
fullyQualifyName :: Name -> Name
|
||||
fullyQualifyName name = Path.prefixName (Path.Absolute (Path.fromList . coerce $ pathToMountedNameLookup)) name
|
||||
fullyQualifyName =
|
||||
Path.prefixNameIfRel (Path.AbsolutePath' . Path.Absolute . Path.fromList $ coerce pathToMountedNameLookup)
|
||||
|
||||
-- | Look up types in the codebase by short hash, and include builtins.
|
||||
typeReferencesByShortHash :: SH.ShortHash -> Sqlite.Transaction (Set Reference)
|
||||
|
||||
@ -1,8 +1,9 @@
|
||||
```ucm:hide
|
||||
.> builtins.mergeio lib.builtin
|
||||
.> project.create-empty project
|
||||
project/main> builtins.mergeio lib.builtin
|
||||
```
|
||||
|
||||
```unison:hide
|
||||
```unison
|
||||
{{ ping doc }}
|
||||
nested.cycle.ping n = n Nat.+ pong n
|
||||
|
||||
@ -16,26 +17,23 @@ simple.y = 20
|
||||
|
||||
-- Shouldn't edit things in lib
|
||||
lib.project.ignoreMe = 30
|
||||
```
|
||||
|
||||
```ucm:hide
|
||||
.> add
|
||||
-- Shouldn't render record accessors
|
||||
unique type Foo = { bar : Nat, baz : Nat }
|
||||
```
|
||||
|
||||
Edit current namespace
|
||||
|
||||
```ucm
|
||||
.simple> edit.namespace
|
||||
project/main> add
|
||||
```
|
||||
|
||||
Edit should hit things recursively
|
||||
`edit.namespace` edits the whole namespace (minus the top-level `lib`).
|
||||
|
||||
```ucm
|
||||
.> edit.namespace
|
||||
project/main> edit.namespace
|
||||
```
|
||||
|
||||
Edit should handle multiple explicit paths at once.
|
||||
`edit.namespace` can also accept explicit paths
|
||||
|
||||
```ucm
|
||||
.> edit.namespace nested.cycle simple
|
||||
project/main> edit.namespace nested simple
|
||||
```
|
||||
|
||||
@ -12,43 +12,76 @@ simple.y = 20
|
||||
|
||||
-- Shouldn't edit things in lib
|
||||
lib.project.ignoreMe = 30
|
||||
|
||||
-- Shouldn't render record accessors
|
||||
unique type Foo = { bar : Nat, baz : Nat }
|
||||
```
|
||||
|
||||
Edit current namespace
|
||||
```ucm
|
||||
|
||||
Loading changes detected in scratch.u.
|
||||
|
||||
I found and typechecked these definitions in scratch.u. If you
|
||||
do an `add` or `update`, here's how your codebase would
|
||||
change:
|
||||
|
||||
⍟ These new definitions are ok to `add`:
|
||||
|
||||
type Foo
|
||||
Foo.bar : Foo -> Nat
|
||||
Foo.bar.modify : (Nat ->{g} Nat) -> Foo ->{g} Foo
|
||||
Foo.bar.set : Nat -> Foo -> Foo
|
||||
Foo.baz : Foo -> Nat
|
||||
Foo.baz.modify : (Nat ->{g} Nat) -> Foo ->{g} Foo
|
||||
Foo.baz.set : Nat -> Foo -> Foo
|
||||
lib.project.ignoreMe : Nat
|
||||
nested.cycle.ping : Nat -> Nat
|
||||
nested.cycle.ping.doc : Doc2
|
||||
nested.cycle.pong : Nat -> Nat
|
||||
nested.cycle.pong.doc : Doc2
|
||||
simple.x : Nat
|
||||
simple.y : Nat
|
||||
toplevel : Text
|
||||
|
||||
```
|
||||
```ucm
|
||||
project/main> add
|
||||
|
||||
⍟ I've added these definitions:
|
||||
|
||||
type Foo
|
||||
Foo.bar : Foo -> Nat
|
||||
Foo.bar.modify : (Nat ->{g} Nat) -> Foo ->{g} Foo
|
||||
Foo.bar.set : Nat -> Foo -> Foo
|
||||
Foo.baz : Foo -> Nat
|
||||
Foo.baz.modify : (Nat ->{g} Nat) -> Foo ->{g} Foo
|
||||
Foo.baz.set : Nat -> Foo -> Foo
|
||||
lib.project.ignoreMe : Nat
|
||||
nested.cycle.ping : Nat -> Nat
|
||||
nested.cycle.ping.doc : Doc2
|
||||
nested.cycle.pong : Nat -> Nat
|
||||
nested.cycle.pong.doc : Doc2
|
||||
simple.x : Nat
|
||||
simple.y : Nat
|
||||
toplevel : Text
|
||||
|
||||
```
|
||||
`edit.namespace` edits the whole namespace (minus the top-level `lib`).
|
||||
|
||||
```ucm
|
||||
.simple> edit.namespace
|
||||
project/main> edit.namespace
|
||||
|
||||
☝️
|
||||
|
||||
I added 2 definitions to the top of scratch.u
|
||||
I added 8 definitions to the top of scratch.u
|
||||
|
||||
You can edit them there, then run `update` to replace the
|
||||
definitions currently in this namespace.
|
||||
|
||||
```
|
||||
```unison:added-by-ucm scratch.u
|
||||
x : ##Nat
|
||||
x = 10
|
||||
type Foo = { bar : Nat, baz : Nat }
|
||||
|
||||
y : ##Nat
|
||||
y = 20
|
||||
```
|
||||
|
||||
Edit should hit things recursively
|
||||
|
||||
```ucm
|
||||
.> edit.namespace
|
||||
|
||||
☝️
|
||||
|
||||
I added 7 definitions to the top of scratch.u
|
||||
|
||||
You can edit them there, then run `update` to replace the
|
||||
definitions currently in this namespace.
|
||||
|
||||
```
|
||||
```unison:added-by-ucm scratch.u
|
||||
nested.cycle.ping : Nat -> Nat
|
||||
nested.cycle.ping n =
|
||||
use Nat +
|
||||
@ -75,10 +108,10 @@ toplevel : Text
|
||||
toplevel = "hi"
|
||||
```
|
||||
|
||||
Edit should handle multiple explicit paths at once.
|
||||
`edit.namespace` can also accept explicit paths
|
||||
|
||||
```ucm
|
||||
.> edit.namespace nested.cycle simple
|
||||
project/main> edit.namespace nested simple
|
||||
|
||||
☝️
|
||||
|
||||
|
||||
16
unison-src/transcripts/fix-ls.md
Normal file
16
unison-src/transcripts/fix-ls.md
Normal file
@ -0,0 +1,16 @@
|
||||
```ucm
|
||||
.> project.create-empty test-ls
|
||||
test-ls/main> builtins.merge
|
||||
```
|
||||
|
||||
```unison
|
||||
foo.bar.add x y = x Int.+ y
|
||||
|
||||
foo.bar.subtract x y = x Int.- y
|
||||
```
|
||||
|
||||
```ucm
|
||||
test-ls/main> add
|
||||
test-ls/main> ls foo
|
||||
test-ls/main> ls 1
|
||||
```
|
||||
60
unison-src/transcripts/fix-ls.output.md
Normal file
60
unison-src/transcripts/fix-ls.output.md
Normal file
@ -0,0 +1,60 @@
|
||||
```ucm
|
||||
.> project.create-empty test-ls
|
||||
|
||||
🎉 I've created the project test-ls.
|
||||
|
||||
🎨 Type `ui` to explore this project's code in your browser.
|
||||
🔭 Discover libraries at https://share.unison-lang.org
|
||||
📖 Use `help-topic projects` to learn more about projects.
|
||||
|
||||
Write your first Unison code with UCM:
|
||||
|
||||
1. Open scratch.u.
|
||||
2. Write some Unison code and save the file.
|
||||
3. In UCM, type `add` to save it to your new project.
|
||||
|
||||
🎉 🥳 Happy coding!
|
||||
|
||||
test-ls/main> builtins.merge
|
||||
|
||||
Done.
|
||||
|
||||
```
|
||||
```unison
|
||||
foo.bar.add x y = x Int.+ y
|
||||
|
||||
foo.bar.subtract x y = x Int.- y
|
||||
```
|
||||
|
||||
```ucm
|
||||
|
||||
Loading changes detected in scratch.u.
|
||||
|
||||
I found and typechecked these definitions in scratch.u. If you
|
||||
do an `add` or `update`, here's how your codebase would
|
||||
change:
|
||||
|
||||
⍟ These new definitions are ok to `add`:
|
||||
|
||||
foo.bar.add : Int -> Int -> Int
|
||||
foo.bar.subtract : Int -> Int -> Int
|
||||
|
||||
```
|
||||
```ucm
|
||||
test-ls/main> add
|
||||
|
||||
⍟ I've added these definitions:
|
||||
|
||||
foo.bar.add : Int -> Int -> Int
|
||||
foo.bar.subtract : Int -> Int -> Int
|
||||
|
||||
test-ls/main> ls foo
|
||||
|
||||
1. bar/ (2 terms)
|
||||
|
||||
test-ls/main> ls 1
|
||||
|
||||
1. add (Int -> Int -> Int)
|
||||
2. subtract (Int -> Int -> Int)
|
||||
|
||||
```
|
||||
16
unison-src/transcripts/fix5055.md
Normal file
16
unison-src/transcripts/fix5055.md
Normal file
@ -0,0 +1,16 @@
|
||||
```ucm
|
||||
.> project.create-empty test-5055
|
||||
test-5055/main> builtins.merge
|
||||
```
|
||||
|
||||
```unison
|
||||
foo.add x y = x Int.+ y
|
||||
|
||||
foo.subtract x y = x Int.- y
|
||||
```
|
||||
|
||||
```ucm
|
||||
test-5055/main> add
|
||||
test-5055/main> ls foo
|
||||
test-5055/main> view 1
|
||||
```
|
||||
63
unison-src/transcripts/fix5055.output.md
Normal file
63
unison-src/transcripts/fix5055.output.md
Normal file
@ -0,0 +1,63 @@
|
||||
```ucm
|
||||
.> project.create-empty test-5055
|
||||
|
||||
🎉 I've created the project test-5055.
|
||||
|
||||
🎨 Type `ui` to explore this project's code in your browser.
|
||||
🔭 Discover libraries at https://share.unison-lang.org
|
||||
📖 Use `help-topic projects` to learn more about projects.
|
||||
|
||||
Write your first Unison code with UCM:
|
||||
|
||||
1. Open scratch.u.
|
||||
2. Write some Unison code and save the file.
|
||||
3. In UCM, type `add` to save it to your new project.
|
||||
|
||||
🎉 🥳 Happy coding!
|
||||
|
||||
test-5055/main> builtins.merge
|
||||
|
||||
Done.
|
||||
|
||||
```
|
||||
```unison
|
||||
foo.add x y = x Int.+ y
|
||||
|
||||
foo.subtract x y = x Int.- y
|
||||
```
|
||||
|
||||
```ucm
|
||||
|
||||
Loading changes detected in scratch.u.
|
||||
|
||||
I found and typechecked these definitions in scratch.u. If you
|
||||
do an `add` or `update`, here's how your codebase would
|
||||
change:
|
||||
|
||||
⍟ These new definitions are ok to `add`:
|
||||
|
||||
foo.add : Int -> Int -> Int
|
||||
foo.subtract : Int -> Int -> Int
|
||||
|
||||
```
|
||||
```ucm
|
||||
test-5055/main> add
|
||||
|
||||
⍟ I've added these definitions:
|
||||
|
||||
foo.add : Int -> Int -> Int
|
||||
foo.subtract : Int -> Int -> Int
|
||||
|
||||
test-5055/main> ls foo
|
||||
|
||||
1. add (Int -> Int -> Int)
|
||||
2. subtract (Int -> Int -> Int)
|
||||
|
||||
test-5055/main> view 1
|
||||
|
||||
foo.add : Int -> Int -> Int
|
||||
foo.add x y =
|
||||
use Int +
|
||||
x + y
|
||||
|
||||
```
|
||||
@ -1367,3 +1367,49 @@ project/alice> merge /bob
|
||||
```ucm:hide
|
||||
.> project.delete project
|
||||
```
|
||||
|
||||
## Regression tests
|
||||
|
||||
### Delete one alias and update the other
|
||||
|
||||
|
||||
```ucm:hide
|
||||
.> project.create-empty project
|
||||
project/main> builtins.mergeio
|
||||
```
|
||||
|
||||
```unison
|
||||
foo = 17
|
||||
bar = 17
|
||||
```
|
||||
|
||||
```ucm
|
||||
project/main> add
|
||||
project/main> branch alice
|
||||
project/alice> delete.term bar
|
||||
```
|
||||
|
||||
```unison
|
||||
foo = 18
|
||||
```
|
||||
|
||||
```ucm
|
||||
project/alice> update
|
||||
project/main> branch bob
|
||||
```
|
||||
|
||||
```unison
|
||||
bob = 101
|
||||
```
|
||||
|
||||
```ucm
|
||||
project/bob> add
|
||||
```
|
||||
|
||||
```ucm
|
||||
project/alice> merge /bob
|
||||
```
|
||||
|
||||
```ucm:hide
|
||||
.> project.delete project
|
||||
```
|
||||
|
||||
@ -976,7 +976,8 @@ project/alice> merge /bob
|
||||
* `update` the definitions to be the same again, so that
|
||||
there's nothing for me to decide.
|
||||
* `move` or `delete` all but one of the definitions; I'll
|
||||
use the remaining name when propagating updates.
|
||||
use the remaining name when propagating updates. (You can
|
||||
`rename` it back after the merge.)
|
||||
|
||||
and then try merging again.
|
||||
|
||||
@ -1322,3 +1323,112 @@ project/alice> merge /bob
|
||||
I merged project/bob into project/alice.
|
||||
|
||||
```
|
||||
## Regression tests
|
||||
|
||||
### Delete one alias and update the other
|
||||
|
||||
|
||||
```unison
|
||||
foo = 17
|
||||
bar = 17
|
||||
```
|
||||
|
||||
```ucm
|
||||
|
||||
Loading changes detected in scratch.u.
|
||||
|
||||
I found and typechecked these definitions in scratch.u. If you
|
||||
do an `add` or `update`, here's how your codebase would
|
||||
change:
|
||||
|
||||
⍟ These new definitions are ok to `add`:
|
||||
|
||||
bar : Nat
|
||||
foo : Nat
|
||||
|
||||
```
|
||||
```ucm
|
||||
project/main> add
|
||||
|
||||
⍟ I've added these definitions:
|
||||
|
||||
bar : Nat
|
||||
foo : Nat
|
||||
|
||||
project/main> branch alice
|
||||
|
||||
Done. I've created the alice branch based off of main.
|
||||
|
||||
Tip: To merge your work back into the main branch, first
|
||||
`switch /main` then `merge /alice`.
|
||||
|
||||
project/alice> delete.term bar
|
||||
|
||||
Done.
|
||||
|
||||
```
|
||||
```unison
|
||||
foo = 18
|
||||
```
|
||||
|
||||
```ucm
|
||||
|
||||
Loading changes detected in scratch.u.
|
||||
|
||||
I found and typechecked these definitions in scratch.u. If you
|
||||
do an `add` or `update`, here's how your codebase would
|
||||
change:
|
||||
|
||||
⍟ These names already exist. You can `update` them to your
|
||||
new definition:
|
||||
|
||||
foo : Nat
|
||||
|
||||
```
|
||||
```ucm
|
||||
project/alice> update
|
||||
|
||||
Okay, I'm searching the branch for code that needs to be
|
||||
updated...
|
||||
|
||||
Done.
|
||||
|
||||
project/main> branch bob
|
||||
|
||||
Done. I've created the bob branch based off of main.
|
||||
|
||||
Tip: To merge your work back into the main branch, first
|
||||
`switch /main` then `merge /bob`.
|
||||
|
||||
```
|
||||
```unison
|
||||
bob = 101
|
||||
```
|
||||
|
||||
```ucm
|
||||
|
||||
Loading changes detected in scratch.u.
|
||||
|
||||
I found and typechecked these definitions in scratch.u. If you
|
||||
do an `add` or `update`, here's how your codebase would
|
||||
change:
|
||||
|
||||
⍟ These new definitions are ok to `add`:
|
||||
|
||||
bob : Nat
|
||||
|
||||
```
|
||||
```ucm
|
||||
project/bob> add
|
||||
|
||||
⍟ I've added these definitions:
|
||||
|
||||
bob : Nat
|
||||
|
||||
```
|
||||
```ucm
|
||||
project/alice> merge /bob
|
||||
|
||||
I merged project/bob into project/alice.
|
||||
|
||||
```
|
||||
|
||||
Loading…
Reference in New Issue
Block a user