mirror of
https://github.com/unisonweb/unison.git
synced 2024-09-11 10:35:57 +03:00
Restrict NameSegment
operations
With `OverloadedStrings` enabled globally and an `IsString` instance, the `newtype` was rendered useless. This extracts the `NameSegment` constructor/eliminator to a `.Internal` module, has `Unison.NameSegment` only re-export the type, and moves the `*Segment` members to `Unison.Syntax.NameSegment`. This forces cascading changes, including eliminating a bunch of magic literals scattered throughout the code.
This commit is contained in:
parent
faa7b92c6f
commit
b9c62164f8
@ -36,7 +36,7 @@ import U.Codebase.Type qualified as V2.Type
|
||||
import U.Core.ABT qualified as ABT
|
||||
import Unison.Hash (Hash)
|
||||
import Unison.Hashing.V2 qualified as H2
|
||||
import Unison.NameSegment (NameSegment (..))
|
||||
import Unison.NameSegment.Internal (NameSegment (NameSegment))
|
||||
import Unison.Prelude
|
||||
import Unison.Symbol qualified as Unison
|
||||
import Unison.Util.Map qualified as Map
|
||||
|
@ -201,6 +201,7 @@ import U.Util.Serialization qualified as S
|
||||
import Unison.Hash qualified as H
|
||||
import Unison.Hash32 qualified as Hash32
|
||||
import Unison.NameSegment (NameSegment)
|
||||
import Unison.NameSegment.Internal qualified as NameSegment
|
||||
import Unison.Prelude
|
||||
import Unison.ShortHash (ShortCausalHash (..), ShortNamespaceHash (..))
|
||||
import Unison.Sqlite
|
||||
@ -243,13 +244,13 @@ loadRootCausalHash =
|
||||
|
||||
-- | Load the causal hash at the given path from the provided root, if Nothing, use the
|
||||
-- codebase root.
|
||||
loadCausalHashAtPath :: Maybe CausalHash -> Q.TextPathSegments -> Transaction (Maybe CausalHash)
|
||||
loadCausalHashAtPath :: Maybe CausalHash -> [NameSegment] -> Transaction (Maybe CausalHash)
|
||||
loadCausalHashAtPath mayRootCausalHash =
|
||||
let go :: Db.CausalHashId -> [Text] -> MaybeT Transaction CausalHash
|
||||
let go :: Db.CausalHashId -> [NameSegment] -> MaybeT Transaction CausalHash
|
||||
go hashId = \case
|
||||
[] -> lift (Q.expectCausalHash hashId)
|
||||
t : ts -> do
|
||||
tid <- MaybeT (Q.loadTextId t)
|
||||
tid <- MaybeT (Q.loadTextId $ NameSegment.toUnescapedText t)
|
||||
S.Branch {children} <- MaybeT (loadDbBranchByCausalHashId hashId)
|
||||
(_, hashId') <- MaybeT (pure (Map.lookup tid children))
|
||||
go hashId' ts
|
||||
@ -261,13 +262,13 @@ loadCausalHashAtPath mayRootCausalHash =
|
||||
|
||||
-- | Expect the causal hash at the given path from the provided root, if Nothing, use the
|
||||
-- codebase root.
|
||||
expectCausalHashAtPath :: Maybe CausalHash -> Q.TextPathSegments -> Transaction CausalHash
|
||||
expectCausalHashAtPath :: Maybe CausalHash -> [NameSegment] -> Transaction CausalHash
|
||||
expectCausalHashAtPath mayRootCausalHash =
|
||||
let go :: Db.CausalHashId -> [Text] -> Transaction CausalHash
|
||||
let go :: Db.CausalHashId -> [NameSegment] -> Transaction CausalHash
|
||||
go hashId = \case
|
||||
[] -> Q.expectCausalHash hashId
|
||||
t : ts -> do
|
||||
tid <- Q.expectTextId t
|
||||
tid <- Q.expectTextId $ NameSegment.toUnescapedText t
|
||||
S.Branch {children} <- expectDbBranchByCausalHashId hashId
|
||||
let (_, hashId') = children Map.! tid
|
||||
go hashId' ts
|
||||
@ -279,14 +280,14 @@ expectCausalHashAtPath mayRootCausalHash =
|
||||
|
||||
loadCausalBranchAtPath ::
|
||||
Maybe CausalHash ->
|
||||
Q.TextPathSegments ->
|
||||
[NameSegment] ->
|
||||
Transaction (Maybe (C.Branch.CausalBranch Transaction))
|
||||
loadCausalBranchAtPath maybeRootCausalHash path =
|
||||
loadCausalHashAtPath maybeRootCausalHash path >>= \case
|
||||
Nothing -> pure Nothing
|
||||
Just causalHash -> Just <$> expectCausalBranchByCausalHash causalHash
|
||||
|
||||
loadBranchAtPath :: Maybe CausalHash -> Q.TextPathSegments -> Transaction (Maybe (C.Branch.Branch Transaction))
|
||||
loadBranchAtPath :: Maybe CausalHash -> [NameSegment] -> Transaction (Maybe (C.Branch.Branch Transaction))
|
||||
loadBranchAtPath maybeRootCausalHash path =
|
||||
loadCausalBranchAtPath maybeRootCausalHash path >>= \case
|
||||
Nothing -> pure Nothing
|
||||
|
@ -394,8 +394,8 @@ import Unison.Hash qualified as Hash
|
||||
import Unison.Hash32 (Hash32)
|
||||
import Unison.Hash32 qualified as Hash32
|
||||
import Unison.Hash32.Orphans.Sqlite ()
|
||||
import Unison.NameSegment (NameSegment (NameSegment))
|
||||
import Unison.NameSegment qualified as NameSegment
|
||||
import Unison.NameSegment.Internal (NameSegment (NameSegment))
|
||||
import Unison.NameSegment.Internal qualified as NameSegment
|
||||
import Unison.Prelude
|
||||
import Unison.Sqlite
|
||||
import Unison.Util.Alternative qualified as Alternative
|
||||
@ -4264,7 +4264,7 @@ expectMostRecentNamespace =
|
||||
Right namespace -> Right (map NameSegment namespace)
|
||||
|
||||
-- | Set the most recent namespace the user has visited.
|
||||
setMostRecentNamespace :: [Text] -> Transaction ()
|
||||
setMostRecentNamespace :: [NameSegment] -> Transaction ()
|
||||
setMostRecentNamespace namespace =
|
||||
execute
|
||||
[sql|
|
||||
@ -4274,7 +4274,7 @@ setMostRecentNamespace namespace =
|
||||
where
|
||||
json :: Text
|
||||
json =
|
||||
Text.Lazy.toStrict (Aeson.encodeToLazyText namespace)
|
||||
Text.Lazy.toStrict (Aeson.encodeToLazyText $ NameSegment.toUnescapedText <$> namespace)
|
||||
|
||||
-- | Get the causal hash result from squashing the provided branch hash if we've squashed it
|
||||
-- at some point in the past.
|
||||
|
@ -1,57 +1,15 @@
|
||||
module Unison.NameSegment
|
||||
( NameSegment (..),
|
||||
toUnescapedText,
|
||||
isPrefixOf,
|
||||
( NameSegment,
|
||||
|
||||
-- * Sentinel name segments
|
||||
defaultPatchSegment,
|
||||
docSegment,
|
||||
libSegment,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Text qualified as Text
|
||||
import Unison.Prelude
|
||||
import Unison.Util.Alphabetical (Alphabetical)
|
||||
import Unison.NameSegment.Internal (NameSegment (NameSegment))
|
||||
|
||||
-- Represents the parts of a name between the `.`s
|
||||
newtype NameSegment
|
||||
= NameSegment Text
|
||||
deriving stock (Eq, Ord, Generic)
|
||||
deriving newtype (Alphabetical)
|
||||
|
||||
instance IsString NameSegment where
|
||||
fromString =
|
||||
NameSegment . Text.pack
|
||||
|
||||
instance Show NameSegment where
|
||||
show =
|
||||
Text.unpack . toUnescapedText
|
||||
|
||||
-- | Convert a name segment to unescaped text.
|
||||
-- |
|
||||
--
|
||||
-- You might use this when storing a name segment as text in a database, where the literal name segment bytes are all
|
||||
-- that matter. However, you wouldn't use this to display the name segment to a user - that depends on concrete syntax.
|
||||
-- See Unison.Syntax.NameSegment (or indeed, some actual yet-built interface that abstracts concrete syntax) for that
|
||||
-- kind of function.
|
||||
--
|
||||
-- > toUnescapedText (unsafeFromText ".~") = ".~"
|
||||
toUnescapedText :: NameSegment -> Text
|
||||
toUnescapedText =
|
||||
coerce
|
||||
|
||||
isPrefixOf :: NameSegment -> NameSegment -> Bool
|
||||
isPrefixOf =
|
||||
coerce Text.isPrefixOf
|
||||
|
||||
defaultPatchSegment :: NameSegment
|
||||
defaultPatchSegment =
|
||||
"patch"
|
||||
|
||||
docSegment :: NameSegment
|
||||
docSegment =
|
||||
"doc"
|
||||
|
||||
-- __TODO__: This should live in "Unison.Syntax.NameSegment", but it’s currently used in unison-core.
|
||||
libSegment :: NameSegment
|
||||
libSegment =
|
||||
"lib"
|
||||
libSegment = NameSegment "lib"
|
||||
|
21
codebase2/core/Unison/NameSegment/Internal.hs
Normal file
21
codebase2/core/Unison/NameSegment/Internal.hs
Normal file
@ -0,0 +1,21 @@
|
||||
-- | This module exposes the underlying representation of `NameSegment`, and
|
||||
-- thus should only be imported by parsers & printers.
|
||||
module Unison.NameSegment.Internal (NameSegment (..)) where
|
||||
|
||||
import Unison.Prelude
|
||||
import Unison.Util.Alphabetical (Alphabetical)
|
||||
|
||||
-- Represents the parts of a name between the `.`s
|
||||
newtype NameSegment = NameSegment
|
||||
{ -- | Convert a name segment to unescaped text.
|
||||
--
|
||||
-- You might use this when storing a name segment as text in a database, where the literal name segment bytes are all
|
||||
-- that matter. However, you wouldn't use this to display the name segment to a user - that depends on concrete syntax.
|
||||
-- See Unison.Syntax.NameSegment (or indeed, some actual yet-built interface that abstracts concrete syntax) for that
|
||||
-- kind of function.
|
||||
--
|
||||
-- > toUnescapedText (unsafeFromText ".~") = ".~"
|
||||
toUnescapedText :: Text
|
||||
}
|
||||
deriving stock (Eq, Generic, Ord, Show)
|
||||
deriving newtype (Alphabetical)
|
@ -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
|
||||
|
||||
@ -22,6 +22,7 @@ library
|
||||
U.Core.ABT.Var
|
||||
Unison.Core.Project
|
||||
Unison.NameSegment
|
||||
Unison.NameSegment.Internal
|
||||
Unison.ShortHash
|
||||
Unison.Util.Alphabetical
|
||||
hs-source-dirs:
|
||||
|
@ -8,10 +8,10 @@ import Unison.Codebase.Path (Path)
|
||||
import Unison.Codebase.Path qualified as Path
|
||||
import Unison.Codebase.ShortCausalHash (ShortCausalHash)
|
||||
import Unison.Codebase.ShortCausalHash qualified as SCH
|
||||
import Unison.NameSegment qualified as NameSegment
|
||||
import Unison.Prelude
|
||||
import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectName)
|
||||
import Unison.Share.Types
|
||||
import Unison.Syntax.NameSegment qualified as NameSegment
|
||||
import Unison.Util.Monoid qualified as Monoid
|
||||
|
||||
data ReadRepo
|
||||
@ -132,7 +132,7 @@ data ReadShareLooseCode = ReadShareLooseCode
|
||||
isPublic :: ReadShareLooseCode -> Bool
|
||||
isPublic ReadShareLooseCode {path} =
|
||||
case path of
|
||||
((NameSegment.toUnescapedText -> "public") Path.:< _) -> True
|
||||
(segment Path.:< _) -> segment == NameSegment.publicLooseCodeSegment
|
||||
_ -> False
|
||||
|
||||
data WriteRemoteNamespace a
|
||||
|
@ -47,7 +47,7 @@ import Unison.Hash (Hash)
|
||||
import Unison.Hashing.V2.Convert qualified as Hashing
|
||||
import Unison.Name (Name)
|
||||
import Unison.Name qualified as Name
|
||||
import Unison.NameSegment (NameSegment (..))
|
||||
import Unison.NameSegment.Internal (NameSegment (NameSegment))
|
||||
import Unison.Names (Names (Names))
|
||||
import Unison.Names qualified as Names
|
||||
import Unison.Parser.Ann (Ann)
|
||||
|
@ -40,7 +40,8 @@ import Unison.DataDeclaration qualified as Memory.DD
|
||||
import Unison.Hash (Hash, HashFor (HashFor))
|
||||
import Unison.Hashing.V2 qualified as Hashing
|
||||
import Unison.Kind qualified as Memory.Kind
|
||||
import Unison.NameSegment qualified as Memory.NameSegment
|
||||
import Unison.NameSegment qualified as Memory (NameSegment)
|
||||
import Unison.NameSegment.Internal qualified as Memory.NameSegment
|
||||
import Unison.Names.ResolutionResult (ResolutionResult)
|
||||
import Unison.Pattern qualified as Memory.Pattern
|
||||
import Unison.Reference qualified as Memory.Reference
|
||||
@ -373,7 +374,7 @@ m2hBranch0 b =
|
||||
where
|
||||
-- is there a more readable way to structure these that's also linear?
|
||||
doTerms ::
|
||||
Memory.Branch.Star Memory.Referent.Referent Memory.NameSegment.NameSegment ->
|
||||
Memory.Branch.Star Memory.Referent.Referent Memory.NameSegment ->
|
||||
Map Hashing.NameSegment (Map Hashing.Referent Hashing.MdValues)
|
||||
doTerms s =
|
||||
Map.fromList
|
||||
@ -388,7 +389,7 @@ m2hBranch0 b =
|
||||
]
|
||||
|
||||
doTypes ::
|
||||
Memory.Branch.Star Memory.Reference.Reference Memory.NameSegment.NameSegment ->
|
||||
Memory.Branch.Star Memory.Reference.Reference Memory.NameSegment ->
|
||||
Map Hashing.NameSegment (Map Hashing.Reference Hashing.MdValues)
|
||||
doTypes s =
|
||||
Map.fromList
|
||||
@ -409,10 +410,10 @@ m2hBranch0 b =
|
||||
doPatches = Map.bimap m2hNameSegment (unPatchHash . fst)
|
||||
|
||||
doChildren ::
|
||||
Map Memory.NameSegment.NameSegment (Memory.Branch.Branch m) ->
|
||||
Map Memory.NameSegment (Memory.Branch.Branch m) ->
|
||||
Map Hashing.NameSegment Hash
|
||||
doChildren = Map.bimap m2hNameSegment (unCausalHash . Memory.Branch.headHash)
|
||||
|
||||
m2hNameSegment :: Memory.NameSegment.NameSegment -> Hashing.NameSegment
|
||||
m2hNameSegment :: Memory.NameSegment -> Hashing.NameSegment
|
||||
m2hNameSegment =
|
||||
Hashing.NameSegment . Memory.NameSegment.toUnescapedText
|
||||
|
@ -13,7 +13,7 @@ import Unison.LabeledDependency (LabeledDependency)
|
||||
import Unison.LabeledDependency qualified as LD
|
||||
import Unison.Name (Name)
|
||||
import Unison.Name qualified as Name
|
||||
import Unison.NameSegment (NameSegment (..))
|
||||
import Unison.NameSegment.Internal (NameSegment (NameSegment))
|
||||
import Unison.Names qualified as Names
|
||||
import Unison.Prelude
|
||||
import Unison.PrettyPrintEnv.Names qualified as PPE
|
||||
|
@ -40,6 +40,7 @@ import Unison.Kind qualified as Kind
|
||||
import Unison.KindInference.Error.Pretty (prettyKindError)
|
||||
import Unison.Name (Name)
|
||||
import Unison.Name qualified as Name
|
||||
import Unison.NameSegment.Internal (NameSegment (NameSegment))
|
||||
import Unison.Names qualified as Names
|
||||
import Unison.Names.ResolutionResult qualified as Names
|
||||
import Unison.Parser.Ann (Ann (..))
|
||||
@ -1701,7 +1702,7 @@ renderParseErrors s = \case
|
||||
else unknownTypesMsg <> "\n\n" <> dupDataAndAbilitiesMsg
|
||||
in (msgs, allRanges)
|
||||
go (Parser.DidntExpectExpression _tok (Just t@(L.payload -> L.SymbolyId (HQ'.NameOnly name))))
|
||||
| name == Name.fromSegment "::" =
|
||||
| name == Name.fromSegment (NameSegment "::") =
|
||||
let msg =
|
||||
mconcat
|
||||
[ "This looks like the start of an expression here but I was expecting a binding.",
|
||||
|
@ -19,8 +19,8 @@ import Data.UUID (UUID)
|
||||
import Data.UUID qualified as UUID
|
||||
import U.Codebase.Sqlite.DbId (ProjectBranchId (..), ProjectId (..))
|
||||
import Unison.Codebase.Path qualified as Path
|
||||
import Unison.NameSegment (NameSegment (..))
|
||||
import Unison.NameSegment qualified as NameSegment
|
||||
import Unison.NameSegment.Internal (NameSegment (NameSegment))
|
||||
import Unison.NameSegment.Internal qualified as NameSegment
|
||||
import Unison.Project (ProjectAndBranch (..))
|
||||
|
||||
-- | Get the path that a project is stored at. Users aren't supposed to go here.
|
||||
@ -152,9 +152,7 @@ pattern BranchesNameSegment <-
|
||||
BranchesNameSegment = branchesNameSegment
|
||||
|
||||
projectsNameSegment :: NameSegment
|
||||
projectsNameSegment =
|
||||
"__projects"
|
||||
projectsNameSegment = NameSegment "__projects"
|
||||
|
||||
branchesNameSegment :: NameSegment
|
||||
branchesNameSegment =
|
||||
"branches"
|
||||
branchesNameSegment = NameSegment "branches"
|
||||
|
@ -10,6 +10,7 @@ where
|
||||
import Control.Monad.Writer (Writer, runWriter, tell)
|
||||
import Data.List.NonEmpty (pattern (:|))
|
||||
import Data.Map qualified as Map
|
||||
import Data.Set qualified as Set
|
||||
import Data.Text qualified as Text
|
||||
import Unison.ConstructorReference (ConstructorReference, GConstructorReference (..))
|
||||
import Unison.ConstructorType qualified as CT
|
||||
@ -29,6 +30,7 @@ import Unison.Referent qualified as Referent
|
||||
import Unison.Syntax.HashQualified qualified as HQ (toText)
|
||||
import Unison.Syntax.Name qualified as Name
|
||||
import Unison.Syntax.NamePrinter (prettyName, styleHashQualified'')
|
||||
import Unison.Syntax.NameSegment qualified as NameSegment
|
||||
import Unison.Syntax.TypePrinter (runPretty)
|
||||
import Unison.Syntax.TypePrinter qualified as TypePrinter
|
||||
import Unison.Syntax.Var qualified as Var (namespaced)
|
||||
@ -38,7 +40,6 @@ import Unison.Util.Pretty qualified as P
|
||||
import Unison.Util.SyntaxText qualified as S
|
||||
import Unison.Var (Var)
|
||||
import Unison.Var qualified as Var (freshenId, name, named)
|
||||
import qualified Data.Set as Set
|
||||
|
||||
type SyntaxText = S.SyntaxText' Reference
|
||||
|
||||
@ -131,14 +132,19 @@ prettyDataDecl (PrettyPrintEnvDecl unsuffixifiedPPE suffixifiedPPE) r name dd =
|
||||
. 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
|
||||
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,
|
||||
accessor <- [Nothing, Just (Name.fromSegment "set"), Just (Name.fromSegment "modify")]
|
||||
]
|
||||
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,
|
||||
accessor <-
|
||||
[ Nothing,
|
||||
Just (Name.fromSegment NameSegment.setSegment),
|
||||
Just (Name.fromSegment NameSegment.modifySegment)
|
||||
]
|
||||
]
|
||||
pure . P.group $
|
||||
fmt S.DelimiterChar "{ "
|
||||
<> P.sep
|
||||
|
@ -26,6 +26,7 @@ import Unison.Reference (TypeReferenceId)
|
||||
import Unison.Syntax.DeclParser (declarations)
|
||||
import Unison.Syntax.Lexer qualified as L
|
||||
import Unison.Syntax.Name qualified as Name (toText, unsafeParseVar)
|
||||
import Unison.Syntax.NameSegment qualified as NameSegment
|
||||
import Unison.Syntax.Parser
|
||||
import Unison.Syntax.TermParser qualified as TermParser
|
||||
import Unison.Syntax.Var qualified as Var (namespaced)
|
||||
@ -243,7 +244,7 @@ watched = P.try do
|
||||
kind <- (fmap . fmap . fmap) (Text.unpack . Name.toText) (optional importWordyId)
|
||||
guid <- uniqueName 10
|
||||
op <- optional (L.payload <$> P.lookAhead importSymbolyId)
|
||||
guard (op == Just (Name.fromSegment ">"))
|
||||
guard (op == Just (Name.fromSegment NameSegment.watchSegment))
|
||||
tok <- anyToken
|
||||
guard $ maybe True (`L.touches` tok) kind
|
||||
pure (maybe UF.RegularWatch L.payload kind, guid, maybe mempty ann kind <> ann tok)
|
||||
|
@ -45,7 +45,7 @@ import Unison.Reference (Reference)
|
||||
import Unison.Referent (Referent)
|
||||
import Unison.Syntax.Lexer qualified as L
|
||||
import Unison.Syntax.Name qualified as Name (toText, toVar, unsafeParseVar)
|
||||
import Unison.Syntax.NameSegment qualified as NameSegment (toEscapedText)
|
||||
import Unison.Syntax.NameSegment qualified as NameSegment
|
||||
import Unison.Syntax.Parser hiding (seq)
|
||||
import Unison.Syntax.Parser qualified as Parser (seq, uniqueName)
|
||||
import Unison.Syntax.TypeParser qualified as TypeParser
|
||||
@ -992,9 +992,12 @@ bang = P.label "bang" do
|
||||
|
||||
seqOp :: (Ord v) => P v m Pattern.SeqOp
|
||||
seqOp =
|
||||
Pattern.Snoc <$ matchToken (L.SymbolyId (HQ'.fromName (Name.fromSegment ":+")))
|
||||
<|> Pattern.Cons <$ matchToken (L.SymbolyId (HQ'.fromName (Name.fromSegment "+:")))
|
||||
<|> Pattern.Concat <$ matchToken (L.SymbolyId (HQ'.fromName (Name.fromSegment "++")))
|
||||
Pattern.Snoc
|
||||
<$ matchToken (L.SymbolyId (HQ'.fromName (Name.fromSegment NameSegment.snocSegment)))
|
||||
<|> Pattern.Cons
|
||||
<$ matchToken (L.SymbolyId (HQ'.fromName (Name.fromSegment NameSegment.consSegment)))
|
||||
<|> Pattern.Concat
|
||||
<$ matchToken (L.SymbolyId (HQ'.fromName (Name.fromSegment NameSegment.concatSegment)))
|
||||
|
||||
term4 :: (Monad m, Var v) => TermP v m
|
||||
term4 = f <$> some termLeaf
|
||||
|
@ -5,6 +5,7 @@ import Data.List.NonEmpty qualified as List.NonEmpty
|
||||
import Data.Set qualified as Set
|
||||
import EasyTest
|
||||
import Unison.Name as Name
|
||||
import Unison.NameSegment.Internal (NameSegment (NameSegment))
|
||||
import Unison.Syntax.Name qualified as Name (unsafeParseText)
|
||||
import Unison.Util.Relation qualified as R
|
||||
|
||||
@ -36,10 +37,10 @@ testEndsWithReverseSegments =
|
||||
[ scope "a.b.c ends with []" (expectEqual True (endsWithReverseSegments (Name.unsafeParseText "a.b.c") [])),
|
||||
scope
|
||||
"a.b.c ends with [c, b]"
|
||||
(expectEqual True (endsWithReverseSegments (Name.unsafeParseText "a.b.c") ["c", "b"])),
|
||||
(expectEqual True (endsWithReverseSegments (Name.unsafeParseText "a.b.c") [NameSegment "c", NameSegment "b"])),
|
||||
scope
|
||||
"a.b.c doesn't end with [d]"
|
||||
(expectEqual False (endsWithReverseSegments (Name.unsafeParseText "a.b.c") ["d"]))
|
||||
(expectEqual False (endsWithReverseSegments (Name.unsafeParseText "a.b.c") [NameSegment "d"]))
|
||||
]
|
||||
|
||||
testEndsWithSegments :: [Test ()]
|
||||
@ -47,31 +48,31 @@ testEndsWithSegments =
|
||||
[ scope "a.b.c ends with []" (expectEqual True (endsWithSegments (Name.unsafeParseText "a.b.c") [])),
|
||||
scope
|
||||
"a.b.c ends with [b, c]"
|
||||
(expectEqual True (endsWithSegments (Name.unsafeParseText "a.b.c") ["b", "c"])),
|
||||
(expectEqual True (endsWithSegments (Name.unsafeParseText "a.b.c") [NameSegment "b", NameSegment "c"])),
|
||||
scope
|
||||
"a.b.c doesn't end with [d]"
|
||||
(expectEqual False (endsWithSegments (Name.unsafeParseText "a.b.c") ["d"]))
|
||||
(expectEqual False (endsWithSegments (Name.unsafeParseText "a.b.c") [NameSegment "d"]))
|
||||
]
|
||||
|
||||
testSegments :: [Test ()]
|
||||
testSegments =
|
||||
[ do
|
||||
n <- int' 1 10
|
||||
segs <- List.NonEmpty.fromList <$> listOf n (pick [".", "foo"])
|
||||
segs <- List.NonEmpty.fromList <$> listOf n (pick [NameSegment ".", NameSegment "foo"])
|
||||
expectEqual (segments (fromSegments segs)) segs
|
||||
]
|
||||
|
||||
testSplitName :: [Test ()]
|
||||
testSplitName =
|
||||
[ scope "x" (expectEqual (splits (Name.unsafeParseText "x")) [([], Name.unsafeParseText "x")]),
|
||||
scope "A.x" (expectEqual (splits (Name.unsafeParseText "A.x")) [([], Name.unsafeParseText "A.x"), (["A"], Name.unsafeParseText "x")]),
|
||||
scope "A.x" (expectEqual (splits (Name.unsafeParseText "A.x")) [([], Name.unsafeParseText "A.x"), ([NameSegment "A"], Name.unsafeParseText "x")]),
|
||||
scope
|
||||
"A.B.x"
|
||||
( expectEqual
|
||||
(splits (Name.unsafeParseText "A.B.x"))
|
||||
[ ([], Name.unsafeParseText "A.B.x"),
|
||||
(["A"], Name.unsafeParseText "B.x"),
|
||||
(["A", "B"], Name.unsafeParseText "x")
|
||||
([NameSegment "A"], Name.unsafeParseText "B.x"),
|
||||
([NameSegment "A", NameSegment "B"], Name.unsafeParseText "x")
|
||||
]
|
||||
)
|
||||
]
|
||||
@ -98,8 +99,8 @@ testSuffixSearch =
|
||||
(n ".`.`", 6)
|
||||
]
|
||||
n = Name.unsafeParseText
|
||||
expectEqual' ("." :| []) (Name.reverseSegments (n ".`.`"))
|
||||
expectEqual' ("." :| []) (Name.reverseSegments (n ".`.`"))
|
||||
expectEqual' (NameSegment "." :| []) (Name.reverseSegments (n ".`.`"))
|
||||
expectEqual' (NameSegment "." :| []) (Name.reverseSegments (n ".`.`"))
|
||||
|
||||
expectEqual' (Set.fromList [1, 2]) (Name.searchBySuffix (n "map") rel)
|
||||
expectEqual' (n "List.map") (Name.suffixifyByHash (n "base.List.map") rel)
|
||||
@ -120,22 +121,22 @@ testUnsafeFromString :: [Test ()]
|
||||
testUnsafeFromString =
|
||||
[ scope "." do
|
||||
expectEqual' (isAbsolute (Name.unsafeParseText "`.`")) False
|
||||
expectEqual' (segments (Name.unsafeParseText "`.`")) ("." :| [])
|
||||
expectEqual' (segments (Name.unsafeParseText "`.`")) (NameSegment "." :| [])
|
||||
ok,
|
||||
scope ".`.`" do
|
||||
expectEqual' (isAbsolute (Name.unsafeParseText ".`.`")) True
|
||||
expectEqual' (segments (Name.unsafeParseText ".`.`")) ("." :| [])
|
||||
expectEqual' (segments (Name.unsafeParseText ".`.`")) (NameSegment "." :| [])
|
||||
ok,
|
||||
scope "foo.bar" do
|
||||
expectEqual' (isAbsolute (Name.unsafeParseText "foo.bar")) False
|
||||
expectEqual' (segments (Name.unsafeParseText "foo.bar")) ("foo" :| ["bar"])
|
||||
expectEqual' (segments (Name.unsafeParseText "foo.bar")) (NameSegment "foo" :| [NameSegment "bar"])
|
||||
ok,
|
||||
scope ".foo.bar" do
|
||||
expectEqual' (isAbsolute (Name.unsafeParseText ".foo.bar")) True
|
||||
expectEqual' (segments (Name.unsafeParseText ".foo.bar")) ("foo" :| ["bar"])
|
||||
expectEqual' (segments (Name.unsafeParseText ".foo.bar")) (NameSegment "foo" :| [NameSegment "bar"])
|
||||
ok,
|
||||
scope "foo.`.`" do
|
||||
expectEqual' (isAbsolute (Name.unsafeParseText "foo.`.`")) False
|
||||
expectEqual' (segments (Name.unsafeParseText "foo.`.`")) ("foo" :| ["."])
|
||||
expectEqual' (segments (Name.unsafeParseText "foo.`.`")) (NameSegment "foo" :| [NameSegment "."])
|
||||
ok
|
||||
]
|
||||
|
@ -13,6 +13,7 @@ import Unison.Codebase.Branch (Branch (Branch), Branch0)
|
||||
import Unison.Codebase.Branch qualified as Branch
|
||||
import Unison.Codebase.Causal qualified as Causal
|
||||
import Unison.Codebase.Metadata qualified as Metadata
|
||||
import Unison.NameSegment.Internal (NameSegment (NameSegment))
|
||||
import Unison.Reference (Reference)
|
||||
import Unison.Reference qualified as Reference
|
||||
import Unison.Util.Relation qualified as Relation
|
||||
@ -34,7 +35,7 @@ branch0Tests =
|
||||
Branch.branch0
|
||||
mempty
|
||||
( mempty
|
||||
& Star2.insertD1 (dummy, "b")
|
||||
& Star2.insertD1 (dummy, NameSegment "b")
|
||||
& Metadata.insert (dummy, dummy)
|
||||
)
|
||||
Map.empty
|
||||
@ -45,10 +46,10 @@ branch0Tests =
|
||||
Branch.branch0
|
||||
mempty
|
||||
( mempty
|
||||
& Star2.insertD1 (dummy, "b")
|
||||
& Star2.insertD1 (dummy, NameSegment "b")
|
||||
& Metadata.insert (dummy, dummy)
|
||||
)
|
||||
(Map.singleton "a" (Branch (Causal.one b0)))
|
||||
(Map.singleton (NameSegment "a") (Branch (Causal.one b0)))
|
||||
Map.empty
|
||||
|
||||
let -- b.a.b
|
||||
@ -57,7 +58,7 @@ branch0Tests =
|
||||
Branch.branch0
|
||||
mempty
|
||||
mempty
|
||||
(Map.singleton "b" (Branch (Causal.one b1)))
|
||||
(Map.singleton (NameSegment "b") (Branch (Causal.one b1)))
|
||||
Map.empty
|
||||
|
||||
expect (Set.valid (Relation.ran (Branch.deepTypes b2)))
|
||||
|
@ -7,7 +7,7 @@ import EasyTest
|
||||
import Unison.Codebase.Path (Path (..), Path' (..), Relative (..))
|
||||
import Unison.Codebase.Path.Parse (parseHQSplit', parseShortHashOrHQSplit')
|
||||
import Unison.HashQualified' qualified as HQ'
|
||||
import Unison.NameSegment (NameSegment)
|
||||
import Unison.NameSegment.Internal (NameSegment (NameSegment))
|
||||
import Unison.Prelude
|
||||
import Unison.ShortHash qualified as SH
|
||||
|
||||
@ -19,12 +19,12 @@ test =
|
||||
in scope s . expect $
|
||||
parseShortHashOrHQSplit' s
|
||||
== (Right . Right)
|
||||
(relative ["foo"], HQ'.HashQualified "bar" (fromJust (SH.fromText "#34"))),
|
||||
(relative ["foo"], HQ'.HashQualified (NameSegment "bar") (fromJust (SH.fromText "#34"))),
|
||||
let s = "foo.bar.+"
|
||||
in scope s . expect $
|
||||
parseShortHashOrHQSplit' s
|
||||
== (Right . Right)
|
||||
(relative ["foo", "bar"], HQ'.NameOnly "+"),
|
||||
(relative ["foo", "bar"], HQ'.NameOnly (NameSegment "+")),
|
||||
let s = "#123"
|
||||
in scope s . expect $
|
||||
parseShortHashOrHQSplit' s
|
||||
@ -33,13 +33,13 @@ test =
|
||||
scope "parseHQ'Split'" . tests $
|
||||
[ let s = "foo.bar#34"
|
||||
in scope s . expect $
|
||||
parseHQSplit' s == Right (relative ["foo"], HQ'.HashQualified "bar" (fromJust (SH.fromText "#34"))),
|
||||
parseHQSplit' s == Right (relative ["foo"], HQ'.HashQualified (NameSegment "bar") (fromJust (SH.fromText "#34"))),
|
||||
let s = "foo.bar.+"
|
||||
in scope s . expect $
|
||||
parseHQSplit' s == Right (relative ["foo", "bar"], HQ'.NameOnly "+"),
|
||||
parseHQSplit' s == Right (relative ["foo", "bar"], HQ'.NameOnly (NameSegment "+")),
|
||||
let s = "#123" in scope s . expect $ isLeft $ parseHQSplit' s
|
||||
]
|
||||
]
|
||||
|
||||
relative :: Seq NameSegment -> Path'
|
||||
relative = Path' . Right . Relative . Path
|
||||
relative :: Seq Text -> Path'
|
||||
relative = Path' . Right . Relative . Path . fmap NameSegment
|
||||
|
@ -30,7 +30,7 @@ import Unison.Codebase.Path qualified as Path
|
||||
import Unison.Codebase.Type (GitError)
|
||||
import Unison.Codebase.Type qualified as Codebase (viewRemoteBranch')
|
||||
import Unison.Core.Project (ProjectAndBranch (..))
|
||||
import Unison.NameSegment qualified as NameSegment
|
||||
import Unison.NameSegment.Internal qualified as NameSegment
|
||||
import Unison.Parser.Ann (Ann)
|
||||
import Unison.Prelude
|
||||
import Unison.Share.API.Hash qualified as Share
|
||||
|
@ -79,7 +79,6 @@ import Unison.Codebase.Editor.UCMVersion (UCMVersion)
|
||||
import Unison.Codebase.Path qualified as Path
|
||||
import Unison.Codebase.Runtime (Runtime)
|
||||
import Unison.Debug qualified as Debug
|
||||
import Unison.NameSegment qualified as NameSegment
|
||||
import Unison.Parser.Ann (Ann)
|
||||
import Unison.Prelude
|
||||
import Unison.Server.CodebaseServer qualified as Server
|
||||
@ -409,7 +408,7 @@ popd = do
|
||||
|
||||
setMostRecentNamespace :: Path.Absolute -> Cli ()
|
||||
setMostRecentNamespace =
|
||||
runTransaction . Queries.setMostRecentNamespace . map NameSegment.toUnescapedText . Path.toList . Path.unabsolute
|
||||
runTransaction . Queries.setMostRecentNamespace . Path.toList . Path.unabsolute
|
||||
|
||||
respond :: Output -> Cli ()
|
||||
respond output = do
|
||||
|
@ -111,7 +111,6 @@ import Unison.Codebase.ShortCausalHash qualified as SCH
|
||||
import Unison.HashQualified qualified as HQ
|
||||
import Unison.HashQualified' qualified as HQ'
|
||||
import Unison.Name qualified as Name
|
||||
import Unison.NameSegment qualified as NameSegment
|
||||
import Unison.Names (Names)
|
||||
import Unison.Parser.Ann (Ann (..))
|
||||
import Unison.Prelude
|
||||
@ -120,6 +119,7 @@ import Unison.Referent (Referent)
|
||||
import Unison.Sqlite qualified as Sqlite
|
||||
import Unison.Symbol (Symbol)
|
||||
import Unison.Syntax.Name qualified as Name (toText)
|
||||
import Unison.Syntax.NameSegment qualified as NameSegment
|
||||
import Unison.Term qualified as Term
|
||||
import Unison.UnisonFile (TypecheckedUnisonFile, UnisonFile)
|
||||
import Unison.UnisonFile qualified as UF
|
||||
|
@ -99,8 +99,8 @@ import Unison.HashQualified' qualified as HQ'
|
||||
import Unison.LabeledDependency as LD
|
||||
import Unison.Name (Name)
|
||||
import Unison.Name qualified as Name
|
||||
import Unison.NameSegment (NameSegment (..))
|
||||
import Unison.NameSegment qualified as NameSegment
|
||||
import Unison.NameSegment (NameSegment)
|
||||
import Unison.NameSegment.Internal qualified as NameSegment
|
||||
import Unison.Parser.Ann (Ann)
|
||||
import Unison.Prelude
|
||||
import Unison.PrettyPrintEnv qualified as PPE
|
||||
|
@ -14,7 +14,6 @@ import Unison.Codebase.Path qualified as Path
|
||||
import Unison.Codebase.UniqueTypeGuidLookup qualified as Codebase
|
||||
import Unison.Name (Name)
|
||||
import Unison.NameSegment (NameSegment)
|
||||
import Unison.NameSegment qualified as NameSegment
|
||||
import Unison.Prelude
|
||||
import Unison.Sqlite qualified as Sqlite
|
||||
|
||||
@ -37,7 +36,6 @@ loadUniqueTypeGuid currentPath name0 = do
|
||||
-- This ought to probably lean somewhat on a cache (so long as the caller is aware of the cache, and discrads it at
|
||||
-- an appropriate time, such as after the current unison file finishes parsing).
|
||||
let loadBranchAtPath :: [NameSegment] -> Sqlite.Transaction (Maybe (Codebase.Branch.Branch Sqlite.Transaction))
|
||||
loadBranchAtPath segments =
|
||||
Operations.loadBranchAtPath Nothing (map NameSegment.toUnescapedText segments)
|
||||
loadBranchAtPath = Operations.loadBranchAtPath Nothing
|
||||
|
||||
Codebase.loadUniqueTypeGuid loadBranchAtPath (Foldable.toList @Seq branchPath) name
|
||||
|
@ -132,8 +132,7 @@ import Unison.LabeledDependency qualified as LD
|
||||
import Unison.LabeledDependency qualified as LabeledDependency
|
||||
import Unison.Name (Name)
|
||||
import Unison.Name qualified as Name
|
||||
import Unison.NameSegment (NameSegment (..))
|
||||
import Unison.NameSegment qualified as NameSegment
|
||||
import Unison.NameSegment (NameSegment)
|
||||
import Unison.Names (Names (Names))
|
||||
import Unison.Names qualified as Names
|
||||
import Unison.NamesWithHistory qualified as Names
|
||||
@ -170,7 +169,7 @@ import Unison.Syntax.HashQualified qualified as HQ (parseTextWith, toText)
|
||||
import Unison.Syntax.Lexer qualified as L
|
||||
import Unison.Syntax.Lexer qualified as Lexer
|
||||
import Unison.Syntax.Name qualified as Name (toText, toVar, unsafeParseVar)
|
||||
import Unison.Syntax.NameSegment qualified as NameSegment (toEscapedText)
|
||||
import Unison.Syntax.NameSegment qualified as NameSegment
|
||||
import Unison.Syntax.Parser qualified as Parser
|
||||
import Unison.Term (Term)
|
||||
import Unison.Term qualified as Term
|
||||
@ -697,8 +696,8 @@ loop e = do
|
||||
-- add the new definitions to the codebase and to the namespace
|
||||
Cli.runTransaction (traverse_ (uncurry3 (Codebase.putTerm codebase)) [guid, author, copyrightHolder])
|
||||
authorPath <- Cli.resolveSplit' authorPath'
|
||||
copyrightHolderPath <- Cli.resolveSplit' (base |> "copyrightHolders" |> authorNameSegment)
|
||||
guidPath <- Cli.resolveSplit' (authorPath' |> "guid")
|
||||
copyrightHolderPath <- Cli.resolveSplit' (base |> NameSegment.copyrightHoldersSegment |> authorNameSegment)
|
||||
guidPath <- Cli.resolveSplit' (authorPath' |> NameSegment.guidSegment)
|
||||
Cli.stepManyAt
|
||||
description
|
||||
[ BranchUtil.makeAddTermName (Path.convert authorPath) (d authorRef),
|
||||
@ -718,8 +717,8 @@ loop e = do
|
||||
where
|
||||
d :: Reference.Id -> Referent
|
||||
d = Referent.Ref . Reference.DerivedId
|
||||
base :: Path.Split' = (Path.relativeEmpty', "metadata")
|
||||
authorPath' = base |> "authors" |> authorNameSegment
|
||||
base :: Path.Split' = (Path.relativeEmpty', NameSegment.metadataSegment)
|
||||
authorPath' = base |> NameSegment.authorsSegment |> authorNameSegment
|
||||
MoveTermI src' dest' -> doMoveTerm src' dest' =<< inputDescription input
|
||||
MoveTypeI src' dest' -> doMoveType src' dest' =<< inputDescription input
|
||||
MoveAllI src' dest' -> do
|
||||
@ -988,7 +987,7 @@ loop e = do
|
||||
currentPath <- Cli.getCurrentPath
|
||||
let destPath = case opath of
|
||||
Just path -> Path.resolve currentPath (Path.Relative path)
|
||||
Nothing -> currentPath `snoc` "builtin"
|
||||
Nothing -> currentPath `snoc` NameSegment.builtinSegment
|
||||
_ <- Cli.updateAtM description destPath \destb ->
|
||||
liftIO (Branch.merge'' (Codebase.lca codebase) Branch.RegularMerge srcb destb)
|
||||
Cli.respond Success
|
||||
@ -1015,7 +1014,7 @@ loop e = do
|
||||
currentPath <- Cli.getCurrentPath
|
||||
let destPath = case opath of
|
||||
Just path -> Path.resolve currentPath (Path.Relative path)
|
||||
Nothing -> currentPath `snoc` "builtin"
|
||||
Nothing -> currentPath `snoc` NameSegment.builtinSegment
|
||||
_ <- Cli.updateAtM description destPath \destb ->
|
||||
liftIO (Branch.merge'' (Codebase.lca codebase) Branch.RegularMerge srcb destb)
|
||||
Cli.respond Success
|
||||
@ -2120,7 +2119,7 @@ docsI src = do
|
||||
in Name.convert hq'
|
||||
|
||||
dotDoc :: HQ.HashQualified Name
|
||||
dotDoc = hq <&> \n -> Name.joinDot n (Name.fromSegment "doc")
|
||||
dotDoc = hq <&> \n -> Name.joinDot n (Name.fromSegment NameSegment.docSegment)
|
||||
|
||||
findInScratchfileByName :: Cli ()
|
||||
findInScratchfileByName = do
|
||||
|
@ -24,7 +24,7 @@ import Unison.Codebase.Editor.Output qualified as Output
|
||||
import Unison.Codebase.Path qualified as Path
|
||||
import Unison.Core.Project (ProjectBranchName)
|
||||
import Unison.NameSegment (NameSegment)
|
||||
import Unison.NameSegment qualified as NameSegment
|
||||
import Unison.NameSegment.Internal qualified as NameSegment
|
||||
import Unison.Prelude
|
||||
import Unison.Project
|
||||
( ProjectAndBranch (..),
|
||||
@ -35,7 +35,7 @@ import Unison.Project
|
||||
classifyProjectBranchName,
|
||||
projectNameToUserProjectSlugs,
|
||||
)
|
||||
import Unison.Syntax.NameSegment qualified as NameSegment (unsafeParseText)
|
||||
import Unison.Syntax.NameSegment qualified as NameSegment (libSegment, unsafeParseText)
|
||||
|
||||
handleInstallLib :: ProjectAndBranch ProjectName (Maybe ProjectBranchNameOrLatestRelease) -> Cli ()
|
||||
handleInstallLib (ProjectAndBranch libdepProjectName unresolvedLibdepBranchName) = do
|
||||
@ -96,7 +96,7 @@ handleInstallLib (ProjectAndBranch libdepProjectName unresolvedLibdepBranchName)
|
||||
|
||||
Cli.respond (Output.InstalledLibdep libdepProjectAndBranchNames libdepNameSegment)
|
||||
|
||||
fresh :: Ord a => (Int -> a -> a) -> Set a -> a -> a
|
||||
fresh :: (Ord a) => (Int -> a -> a) -> Set a -> a -> a
|
||||
fresh bump taken x =
|
||||
fromJust (List.find (\y -> not (Set.member y taken)) (x : map (\i -> bump i x) [2 ..]))
|
||||
|
||||
|
@ -85,8 +85,8 @@ import Unison.Merge.Unconflicts qualified as Unconflicts
|
||||
import Unison.Merge.Updated (Updated (..))
|
||||
import Unison.Name (Name)
|
||||
import Unison.Name qualified as Name
|
||||
import Unison.NameSegment (NameSegment (..))
|
||||
import Unison.NameSegment qualified as NameSegment
|
||||
import Unison.NameSegment.Internal (NameSegment (NameSegment))
|
||||
import Unison.NameSegment.Internal qualified as NameSegment
|
||||
import Unison.Names (Names)
|
||||
import Unison.Names qualified as Names
|
||||
import Unison.Prelude
|
||||
@ -104,6 +104,7 @@ import Unison.Sqlite qualified as Sqlite
|
||||
import Unison.Syntax.DeclPrinter (AccessorName)
|
||||
import Unison.Syntax.DeclPrinter qualified as DeclPrinter
|
||||
import Unison.Syntax.Name qualified as Name
|
||||
import Unison.Syntax.NameSegment qualified as NameSegment
|
||||
import Unison.Syntax.TermPrinter qualified as TermPrinter
|
||||
import Unison.Term (Term)
|
||||
import Unison.Type (Type)
|
||||
@ -446,7 +447,7 @@ renderTermBinding ppe (HQ.NameOnly -> name) term typ =
|
||||
else TermPrinter.prettyBinding ppe name term
|
||||
|
||||
renderTypeBinding ::
|
||||
Var v =>
|
||||
(Var v) =>
|
||||
PrettyPrintEnvDecl ->
|
||||
Name ->
|
||||
TypeReferenceId ->
|
||||
@ -601,7 +602,7 @@ defnsAndLibdepsToBranch0 codebase defns libdeps =
|
||||
branch2 = Branch.transform0 (Codebase.runTransaction codebase) branch1
|
||||
in branch2
|
||||
where
|
||||
go :: Ord v => Map Name v -> Nametree (Map NameSegment v)
|
||||
go :: (Ord v) => Map Name v -> Nametree (Map NameSegment v)
|
||||
go =
|
||||
unflattenNametree . BiMultimap.fromRange
|
||||
|
||||
@ -676,7 +677,7 @@ identifyDependents defns conflicts unconflicts = do
|
||||
-- into the namespace / parsing context for the conflicted merge, because it has an unnamed reference on
|
||||
-- foo#alice. It rather ought to be in the scratchfile alongside the conflicted foo#alice and foo#bob, so
|
||||
-- that when that conflict is resolved, it will propagate to bar.
|
||||
let f :: Foldable t => t Reference.Id -> Set Reference
|
||||
let f :: (Foldable t) => t Reference.Id -> Set Reference
|
||||
f =
|
||||
List.foldl' (\acc ref -> Set.insert (Reference.DerivedId ref) acc) Set.empty . Foldable.toList
|
||||
in bifoldMap f f <$> conflicts
|
||||
@ -797,7 +798,7 @@ loadNamespaceInfo abort db branch = do
|
||||
-- | Load all "namespace definitions" of a branch, which are all terms and type declarations *except* those defined
|
||||
-- in the "lib" namespace.
|
||||
loadNamespaceInfo0 ::
|
||||
Monad m =>
|
||||
(Monad m) =>
|
||||
(V2.Referent -> m Referent) ->
|
||||
V2.Branch m ->
|
||||
m (Nametree (DefnsF2 (Map NameSegment) Set Referent TypeReference))
|
||||
|
@ -23,12 +23,12 @@ import Unison.Codebase qualified as Codebase
|
||||
import Unison.Codebase.Branch qualified as Branch
|
||||
import Unison.Codebase.Editor.Output qualified as Output
|
||||
import Unison.Codebase.Path qualified as Path
|
||||
import Unison.NameSegment qualified as NameSegment
|
||||
import Unison.Prelude
|
||||
import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectName)
|
||||
import Unison.Share.API.Hash qualified as Share.API
|
||||
import Unison.Sqlite qualified as Sqlite
|
||||
import Unison.Sync.Common qualified as Sync.Common
|
||||
import Unison.Syntax.NameSegment qualified as NameSegment
|
||||
import Witch (unsafeFrom)
|
||||
|
||||
-- | Create a new project.
|
||||
@ -136,7 +136,7 @@ projectCreate tryDownloadingBase maybeProjectName = do
|
||||
projectBranchLibBaseObject =
|
||||
over
|
||||
Branch.children
|
||||
(Map.insert "base" baseLatestReleaseBranchObject)
|
||||
(Map.insert NameSegment.baseSegment baseLatestReleaseBranchObject)
|
||||
Branch.empty0
|
||||
projectBranchLibObject = Branch.cons projectBranchLibBaseObject Branch.empty
|
||||
in over
|
||||
|
@ -40,9 +40,9 @@ 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
|
||||
import Unison.Prelude
|
||||
import Unison.Project (ProjectAndBranch (..), ProjectBranchNameOrLatestRelease (..), ProjectName)
|
||||
import Unison.Syntax.NameSegment qualified as NameSegment
|
||||
import Witch (unsafeFrom)
|
||||
|
||||
handlePull :: PullSourceTarget -> PullMode -> Verbosity.Verbosity -> Cli ()
|
||||
|
@ -56,7 +56,6 @@ import Unison.Core.Project (ProjectBranchName (UnsafeProjectBranchName))
|
||||
import Unison.Hash qualified as Hash
|
||||
import Unison.Hash32 (Hash32)
|
||||
import Unison.Hash32 qualified as Hash32
|
||||
import Unison.NameSegment (NameSegment (..))
|
||||
import Unison.Prelude
|
||||
import Unison.Project
|
||||
( ProjectAndBranch (..),
|
||||
@ -730,7 +729,7 @@ loadCausalHashToPush path =
|
||||
Nothing -> Nothing
|
||||
Just (CausalHash hash) -> Just (Hash32.fromHash hash)
|
||||
where
|
||||
segments = coerce @[NameSegment] @[Text] (Path.toList (Path.unabsolute path))
|
||||
segments = Path.toList (Path.unabsolute path)
|
||||
|
||||
-- Were we to try to advance `remoteBranchHead` to `localBranchHead`, would it *not* be a fast-forward?
|
||||
wouldNotBeFastForward :: Hash32 -> Hash32 -> Sqlite.Transaction Bool
|
||||
|
@ -62,8 +62,7 @@ import Unison.Name (Name)
|
||||
import Unison.Name qualified as Name
|
||||
import Unison.Name.Forward (ForwardName (..))
|
||||
import Unison.Name.Forward qualified as ForwardName
|
||||
import Unison.NameSegment (NameSegment (..))
|
||||
import Unison.NameSegment qualified as NameSegment
|
||||
import Unison.NameSegment.Internal (NameSegment (NameSegment))
|
||||
import Unison.Names (Names (Names))
|
||||
import Unison.Names qualified as Names
|
||||
import Unison.Parser.Ann (Ann)
|
||||
@ -82,6 +81,7 @@ import Unison.Result qualified as Result
|
||||
import Unison.Sqlite (Transaction)
|
||||
import Unison.Symbol (Symbol)
|
||||
import Unison.Syntax.Name qualified as Name
|
||||
import Unison.Syntax.NameSegment qualified as NameSegment
|
||||
import Unison.Syntax.Parser qualified as Parser
|
||||
import Unison.Term (Term)
|
||||
import Unison.Type (Type)
|
||||
@ -377,12 +377,12 @@ makeUnisonFile abort codebase doFindCtorNames defns = do
|
||||
overwriteConstructorNames name ed.toDataDecl <&> \ed' ->
|
||||
uf
|
||||
& #effectDeclarationsId
|
||||
%~ Map.insertWith (\_new old -> old) (Name.toVar name) (Reference.Id h i, Decl.EffectDeclaration ed')
|
||||
%~ Map.insertWith (\_new old -> old) (Name.toVar name) (Reference.Id h i, Decl.EffectDeclaration ed')
|
||||
Right dd ->
|
||||
overwriteConstructorNames name dd <&> \dd' ->
|
||||
uf
|
||||
& #dataDeclarationsId
|
||||
%~ Map.insertWith (\_new old -> old) (Name.toVar name) (Reference.Id h i, dd')
|
||||
%~ Map.insertWith (\_new old -> old) (Name.toVar name) (Reference.Id h i, dd')
|
||||
|
||||
-- Constructor names are bogus when pulled from the database, so we set them to what they should be here
|
||||
overwriteConstructorNames :: Name -> DataDeclaration Symbol Ann -> Transaction (DataDeclaration Symbol Ann)
|
||||
|
@ -31,7 +31,7 @@ import Unison.Codebase.Editor.RemoteRepo
|
||||
import Unison.Codebase.Path (Path (..))
|
||||
import Unison.Codebase.Path qualified as Path
|
||||
import Unison.Codebase.ShortCausalHash (ShortCausalHash (..))
|
||||
import Unison.NameSegment (NameSegment (..))
|
||||
import Unison.NameSegment (NameSegment)
|
||||
import Unison.Prelude
|
||||
import Unison.Project (ProjectBranchName, ProjectBranchSpecifier (..), ProjectName, projectAndBranchNamesParser)
|
||||
import Unison.Syntax.Lexer qualified
|
||||
@ -62,9 +62,12 @@ 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 ->
|
||||
@ -92,9 +95,12 @@ writeRemoteNamespace =
|
||||
|
||||
writeRemoteNamespaceWith :: P a -> P (WriteRemoteNamespace a)
|
||||
writeRemoteNamespaceWith projectBranchParser =
|
||||
WriteRemoteNamespaceGit <$> writeGitRemoteNamespace
|
||||
<|> WriteRemoteProjectBranch <$> projectBranchParser
|
||||
<|> WriteRemoteNamespaceShare <$> writeShareRemoteNamespace
|
||||
WriteRemoteNamespaceGit
|
||||
<$> writeGitRemoteNamespace
|
||||
<|> WriteRemoteProjectBranch
|
||||
<$> projectBranchParser
|
||||
<|> WriteRemoteNamespaceShare
|
||||
<$> writeShareRemoteNamespace
|
||||
|
||||
-- >>> P.parseMaybe writeShareRemoteNamespace "unisonweb.base._releases.M4"
|
||||
-- Just (WriteShareRemoteNamespace {server = ShareRepo, repo = "unisonweb", path = base._releases.M4})
|
||||
|
@ -52,7 +52,7 @@ import Unison.Codebase.SqliteCodebase.Conversions qualified as Cv
|
||||
import Unison.CommandLine.InputPattern qualified as IP
|
||||
import Unison.HashQualified' qualified as HQ'
|
||||
import Unison.Name qualified as Name
|
||||
import Unison.NameSegment (NameSegment (..))
|
||||
import Unison.NameSegment.Internal (NameSegment (NameSegment))
|
||||
import Unison.Prelude
|
||||
import Unison.Server.Local.Endpoints.NamespaceListing (NamespaceListing (NamespaceListing))
|
||||
import Unison.Server.Local.Endpoints.NamespaceListing qualified as Server
|
||||
|
@ -94,8 +94,7 @@ import Unison.HashQualified' qualified as HQ'
|
||||
import Unison.LabeledDependency as LD
|
||||
import Unison.Name (Name)
|
||||
import Unison.Name qualified as Name
|
||||
import Unison.NameSegment (NameSegment (..))
|
||||
import Unison.NameSegment qualified as NameSegment
|
||||
import Unison.NameSegment.Internal (NameSegment (NameSegment))
|
||||
import Unison.Names (Names (..))
|
||||
import Unison.Names qualified as Names
|
||||
import Unison.NamesWithHistory qualified as Names
|
||||
@ -143,7 +142,7 @@ import Unison.Syntax.NamePrinter
|
||||
prettyShortHash,
|
||||
styleHashQualified,
|
||||
)
|
||||
import Unison.Syntax.NameSegment qualified as NameSegment (toEscapedText)
|
||||
import Unison.Syntax.NameSegment qualified as NameSegment
|
||||
import Unison.Syntax.TermPrinter qualified as TermPrinter
|
||||
import Unison.Syntax.TypePrinter qualified as TypePrinter
|
||||
import Unison.Term (Term)
|
||||
@ -306,7 +305,7 @@ notifyNumbered = \case
|
||||
"",
|
||||
tip $
|
||||
"Add"
|
||||
<> prettyName (Name.fromSegment "License")
|
||||
<> prettyName (Name.fromSegment NameSegment.licenseSegment)
|
||||
<> "values for"
|
||||
<> prettyName (Name.fromSegment authorNS)
|
||||
<> "under"
|
||||
@ -3219,7 +3218,7 @@ showDiffNamespace sn ppe oldPath newPath OBD.BranchDiffOutput {..} =
|
||||
[] -> mempty
|
||||
x : ys -> " (" <> P.commas (x <> " updates" : ys) <> ")"
|
||||
pure $ n <> P.bold " patch " <> prettyName name <> message
|
||||
-- 18. patch q
|
||||
-- 18. patch q
|
||||
prettyNamePatch prefix (name, _patchDiff) = do
|
||||
n <- numPatch prefix name
|
||||
pure $ n <> P.bold " patch " <> prettyName name
|
||||
|
@ -32,8 +32,8 @@ import Unison.LabeledDependency (LabeledDependency)
|
||||
import Unison.LabeledDependency qualified as LD
|
||||
import Unison.Name (Name)
|
||||
import Unison.Name qualified as Name
|
||||
import Unison.NameSegment (NameSegment (..))
|
||||
import Unison.NameSegment qualified as NameSegment
|
||||
import Unison.NameSegment.Internal (NameSegment)
|
||||
import Unison.NameSegment.Internal qualified as NameSegment
|
||||
import Unison.Names (Names (..))
|
||||
import Unison.Prelude
|
||||
import Unison.PrettyPrintEnv qualified as PPE
|
||||
@ -44,6 +44,7 @@ import Unison.Runtime.IOSource qualified as IOSource
|
||||
import Unison.Syntax.DeclPrinter qualified as DeclPrinter
|
||||
import Unison.Syntax.HashQualified' qualified as HQ' (toText)
|
||||
import Unison.Syntax.Name qualified as Name (nameP, parseText, toText)
|
||||
import Unison.Syntax.NameSegment qualified as NameSegment
|
||||
import Unison.Syntax.TypePrinter qualified as TypePrinter
|
||||
import Unison.Util.Monoid qualified as Monoid
|
||||
import Unison.Util.Pretty qualified as Pretty
|
||||
@ -194,8 +195,7 @@ namesToCompletionTree Names {terms, types} =
|
||||
-- Special docs like "README" will still appear since they're not named 'doc'
|
||||
isDefinitionDoc name =
|
||||
case Name.reverseSegments name of
|
||||
((NameSegment.toUnescapedText -> "doc") :| _) -> True
|
||||
_ -> False
|
||||
(doc :| _) -> doc == NameSegment.docSegment
|
||||
|
||||
nameToCompletionTree :: Name -> LabeledDependency -> CompletionTree
|
||||
nameToCompletionTree name ref =
|
||||
@ -244,7 +244,7 @@ matchCompletions (CompletionTree tree) txt =
|
||||
in (current <> mkDefMatches subtreeMap)
|
||||
[prefix] ->
|
||||
Map.dropWhileAntitone (< prefix) subtreeMap
|
||||
& Map.takeWhileAntitone (NameSegment.isPrefixOf prefix)
|
||||
& Map.takeWhileAntitone (Text.isPrefixOf (NameSegment.toUnescapedText prefix) . NameSegment.toUnescapedText)
|
||||
& \matchingSubtrees ->
|
||||
let subMatches = ifoldMap (\ns subTree -> matchSegments [] subTree & consPathPrefix ns) matchingSubtrees
|
||||
in subMatches
|
||||
|
@ -6,12 +6,23 @@ import Data.These (These (..))
|
||||
import Data.Void (Void)
|
||||
import EasyTest
|
||||
import Text.Megaparsec qualified as P
|
||||
import Unison.Codebase.Editor.RemoteRepo (ReadGitRepo (..), ReadRemoteNamespace (..), ShareCodeserver (..), ShareUserHandle (..), WriteGitRemoteNamespace (..), WriteGitRepo (..), WriteRemoteNamespace (..), WriteShareRemoteNamespace (..), pattern ReadGitRemoteNamespace, pattern ReadShareLooseCode)
|
||||
import Unison.Codebase.Editor.RemoteRepo
|
||||
( ReadGitRepo (..),
|
||||
ReadRemoteNamespace (..),
|
||||
ShareCodeserver (..),
|
||||
ShareUserHandle (..),
|
||||
WriteGitRemoteNamespace (..),
|
||||
WriteGitRepo (..),
|
||||
WriteRemoteNamespace (..),
|
||||
WriteShareRemoteNamespace (..),
|
||||
pattern ReadGitRemoteNamespace,
|
||||
pattern ReadShareLooseCode,
|
||||
)
|
||||
import Unison.Codebase.Editor.UriParser qualified as UriParser
|
||||
import Unison.Codebase.Path qualified as Path
|
||||
import Unison.Codebase.ShortCausalHash (ShortCausalHash (..))
|
||||
import Unison.Core.Project (ProjectBranchName (..), ProjectName (..))
|
||||
import Unison.NameSegment (NameSegment (..))
|
||||
import Unison.NameSegment.Internal (NameSegment (NameSegment))
|
||||
import Unison.Project (ProjectBranchSpecifier (..))
|
||||
|
||||
test :: Test ()
|
||||
@ -68,19 +79,22 @@ test =
|
||||
]
|
||||
]
|
||||
|
||||
gitR :: Text -> Maybe Text -> Maybe ShortCausalHash -> [NameSegment] -> ReadRemoteNamespace void
|
||||
gitR url ref sch path = ReadRemoteNamespaceGit (ReadGitRemoteNamespace (ReadGitRepo url ref) sch (Path.fromList path))
|
||||
mkPath :: [Text] -> Path.Path
|
||||
mkPath = Path.fromList . fmap NameSegment
|
||||
|
||||
gitW :: Text -> Maybe Text -> [NameSegment] -> WriteRemoteNamespace void
|
||||
gitW url branch path = WriteRemoteNamespaceGit (WriteGitRemoteNamespace (WriteGitRepo url branch) (Path.fromList path))
|
||||
gitR :: Text -> Maybe Text -> Maybe ShortCausalHash -> [Text] -> ReadRemoteNamespace void
|
||||
gitR url ref sch path = ReadRemoteNamespaceGit (ReadGitRemoteNamespace (ReadGitRepo url ref) sch (mkPath path))
|
||||
|
||||
looseR :: Text -> [NameSegment] -> ReadRemoteNamespace void
|
||||
gitW :: Text -> Maybe Text -> [Text] -> WriteRemoteNamespace void
|
||||
gitW url branch path = WriteRemoteNamespaceGit (WriteGitRemoteNamespace (WriteGitRepo url branch) (mkPath path))
|
||||
|
||||
looseR :: Text -> [Text] -> ReadRemoteNamespace void
|
||||
looseR user path =
|
||||
ReadShare'LooseCode (ReadShareLooseCode DefaultCodeserver (ShareUserHandle user) (Path.fromList path))
|
||||
ReadShare'LooseCode (ReadShareLooseCode DefaultCodeserver (ShareUserHandle user) (mkPath path))
|
||||
|
||||
looseW :: Text -> [NameSegment] -> WriteRemoteNamespace void
|
||||
looseW :: Text -> [Text] -> WriteRemoteNamespace void
|
||||
looseW user path =
|
||||
WriteRemoteNamespaceShare (WriteShareRemoteNamespace DefaultCodeserver (ShareUserHandle user) (Path.fromList path))
|
||||
WriteRemoteNamespaceShare (WriteShareRemoteNamespace DefaultCodeserver (ShareUserHandle user) (mkPath path))
|
||||
|
||||
branchR :: These Text Text -> ReadRemoteNamespace (These ProjectName ProjectBranchName)
|
||||
branchR =
|
||||
|
@ -66,7 +66,7 @@ import Data.Monoid (Sum (..))
|
||||
import Data.RFC5051 qualified as RFC5051
|
||||
import Data.Set qualified as Set
|
||||
import Unison.Name.Internal
|
||||
import Unison.NameSegment (NameSegment (..))
|
||||
import Unison.NameSegment (NameSegment)
|
||||
import Unison.NameSegment qualified as NameSegment
|
||||
import Unison.Position (Position (..))
|
||||
import Unison.Prelude
|
||||
@ -349,7 +349,7 @@ searchByRankedSuffix suffix rel =
|
||||
|
||||
-- | precondition: input list is deduped, and so is the Name list in
|
||||
-- the tuple
|
||||
preferShallowLibDepth :: Ord r => [([Name], r)] -> Set r
|
||||
preferShallowLibDepth :: (Ord r) => [([Name], r)] -> Set r
|
||||
preferShallowLibDepth = \case
|
||||
[] -> Set.empty
|
||||
[x] -> Set.singleton (snd x)
|
||||
|
@ -133,8 +133,8 @@ import Unison.Hashing.V2.Convert qualified as Hashing
|
||||
import Unison.LabeledDependency qualified as LD
|
||||
import Unison.Name (Name)
|
||||
import Unison.Name qualified as Name
|
||||
import Unison.NameSegment (NameSegment (..))
|
||||
import Unison.NameSegment qualified as NameSegment
|
||||
import Unison.NameSegment (NameSegment)
|
||||
import Unison.NameSegment.Internal qualified as NameSegment
|
||||
import Unison.Names (Names)
|
||||
import Unison.Names qualified as Names
|
||||
import Unison.NamesWithHistory qualified as Names
|
||||
@ -170,7 +170,7 @@ import Unison.Syntax.DeclPrinter qualified as DeclPrinter
|
||||
import Unison.Syntax.HashQualified' qualified as HQ' (toText)
|
||||
import Unison.Syntax.Name as Name (toText, unsafeParseText)
|
||||
import Unison.Syntax.NamePrinter qualified as NP
|
||||
import Unison.Syntax.NameSegment qualified as NameSegment (toEscapedText)
|
||||
import Unison.Syntax.NameSegment qualified as NameSegment (docSegment, libSegment, toEscapedText)
|
||||
import Unison.Syntax.TermPrinter qualified as TermPrinter
|
||||
import Unison.Syntax.TypePrinter qualified as TypePrinter
|
||||
import Unison.Term (Term)
|
||||
@ -212,10 +212,10 @@ data BackendError
|
||||
= NoSuchNamespace Path.Absolute
|
||||
| -- Failed to parse path
|
||||
BadNamespace
|
||||
-- | error message
|
||||
String
|
||||
-- ^ error message
|
||||
-- | namespace
|
||||
String
|
||||
-- ^ namespace
|
||||
| CouldntExpandBranchHash ShortCausalHash
|
||||
| AmbiguousBranchHash ShortCausalHash (Set ShortCausalHash)
|
||||
| AmbiguousHashForDefinition ShortHash
|
||||
@ -276,7 +276,7 @@ data TermEntry v a = TermEntry
|
||||
}
|
||||
deriving (Eq, Ord, Show, Generic)
|
||||
|
||||
termEntryLabeledDependencies :: Ord v => TermEntry v a -> Set LD.LabeledDependency
|
||||
termEntryLabeledDependencies :: (Ord v) => TermEntry v a -> Set LD.LabeledDependency
|
||||
termEntryLabeledDependencies TermEntry {termEntryType, termEntryReferent, termEntryTag, termEntryName} =
|
||||
foldMap Type.labeledDependencies termEntryType
|
||||
<> Set.singleton (LD.TermReferent (Cv.referent2to1UsingCT ct termEntryReferent))
|
||||
@ -461,11 +461,11 @@ getTermTag codebase r sig = do
|
||||
V2Referent.Con ref _ -> Just <$> Codebase.runTransaction codebase (Codebase.getDeclType codebase ref)
|
||||
pure $
|
||||
if
|
||||
| isDoc -> Doc
|
||||
| isTest -> Test
|
||||
| Just CT.Effect <- constructorType -> Constructor Ability
|
||||
| Just CT.Data <- constructorType -> Constructor Data
|
||||
| otherwise -> Plain
|
||||
| isDoc -> Doc
|
||||
| isTest -> Test
|
||||
| Just CT.Effect <- constructorType -> Constructor Ability
|
||||
| Just CT.Data <- constructorType -> Constructor Data
|
||||
| otherwise -> Plain
|
||||
|
||||
getTypeTag ::
|
||||
(Var v) =>
|
||||
@ -726,7 +726,7 @@ mungeSyntaxText ::
|
||||
mungeSyntaxText = fmap Syntax.convertElement
|
||||
|
||||
mkTypeDefinition ::
|
||||
MonadIO m =>
|
||||
(MonadIO m) =>
|
||||
Codebase IO Symbol Ann ->
|
||||
PPED.PrettyPrintEnvDecl ->
|
||||
Width ->
|
||||
@ -842,7 +842,7 @@ docsForDefinitionName ::
|
||||
Name ->
|
||||
IO [TermReference]
|
||||
docsForDefinitionName codebase (NameSearch {termSearch}) searchType name = do
|
||||
let potentialDocNames = [name, name Cons.:> "doc"]
|
||||
let potentialDocNames = [name, name Cons.:> NameSegment.docSegment]
|
||||
Codebase.runTransaction codebase do
|
||||
refs <-
|
||||
potentialDocNames & foldMapM \name ->
|
||||
@ -1219,7 +1219,7 @@ loadTypeDisplayObject c = \case
|
||||
<$> Codebase.getTypeDeclaration c id
|
||||
|
||||
-- | Get the causal hash a given project branch points to
|
||||
causalHashForProjectBranchName :: MonadIO m => ProjectAndBranch ProjectName ProjectBranchName -> Sqlite.Transaction (Maybe CausalHash)
|
||||
causalHashForProjectBranchName :: (MonadIO m) => ProjectAndBranch ProjectName ProjectBranchName -> Sqlite.Transaction (Maybe CausalHash)
|
||||
causalHashForProjectBranchName (ProjectAndBranch projectName branchName) = do
|
||||
Q.loadProjectBranchByNames projectName branchName >>= \case
|
||||
Nothing -> pure Nothing
|
||||
|
@ -14,11 +14,10 @@ import Unison.Codebase.Path
|
||||
import Unison.Codebase.Path qualified as Path
|
||||
import Unison.HashQualified qualified as HQ
|
||||
import Unison.Name (Name)
|
||||
import Unison.NameSegment (libSegment)
|
||||
import Unison.NameSegment qualified as NameSegment
|
||||
import Unison.Prelude
|
||||
import Unison.Server.Backend
|
||||
import Unison.Sqlite qualified as Sqlite
|
||||
import Unison.Syntax.NameSegment qualified as NameSegment
|
||||
|
||||
-- | Given an arbitrary query and perspective, find the name root the query belongs in,
|
||||
-- then return that root and the query relocated to that root.
|
||||
@ -62,17 +61,15 @@ inferNamesRoot p b
|
||||
where
|
||||
findBaseProject :: Path -> Maybe Path
|
||||
findBaseProject
|
||||
( (NameSegment.toUnescapedText -> "public")
|
||||
Cons.:< (NameSegment.toUnescapedText -> "base")
|
||||
Cons.:< release
|
||||
Cons.:< _rest
|
||||
) =
|
||||
Just (Path.fromList ["public", "base", release])
|
||||
(public Cons.:< base Cons.:< release Cons.:< _rest) =
|
||||
if public == NameSegment.publicLooseCodeSegment && base == NameSegment.baseSegment
|
||||
then Just (Path.fromList [public, base, release])
|
||||
else Nothing
|
||||
findBaseProject _ = Nothing
|
||||
go :: Path -> Branch Sqlite.Transaction -> ReaderT Path (WriterT (Last Path) Sqlite.Transaction) ()
|
||||
go p b = do
|
||||
childMap <- lift . lift $ nonEmptyChildren b
|
||||
when (isJust $ Map.lookup libSegment childMap) $ ask >>= tell . Last . Just
|
||||
when (isJust $ Map.lookup NameSegment.libSegment childMap) $ ask >>= tell . Last . Just
|
||||
case p of
|
||||
Path.Empty -> pure ()
|
||||
(nextChild Cons.:< pathRemainder) ->
|
||||
@ -99,7 +96,7 @@ inferNamesRoot p b
|
||||
-- Nothing
|
||||
findDepRoot :: Path -> Maybe Path
|
||||
findDepRoot (lib Cons.:< depRoot Cons.:< rest)
|
||||
| lib == libSegment =
|
||||
| lib == NameSegment.libSegment =
|
||||
-- Keep looking to see if the full path is actually in a transitive dependency, otherwise
|
||||
-- fallback to this spot
|
||||
((Path.fromList [lib, depRoot] <>) <$> findDepRoot rest)
|
||||
|
@ -35,7 +35,7 @@ import Unison.Codebase.ShortCausalHash (ShortCausalHash)
|
||||
import Unison.Codebase.SqliteCodebase.Conversions qualified as Cv
|
||||
import Unison.HashQualified qualified as HQ
|
||||
import Unison.Name (Name)
|
||||
import Unison.NameSegment (NameSegment (..))
|
||||
import Unison.NameSegment.Internal (NameSegment (NameSegment))
|
||||
import Unison.Parser.Ann (Ann)
|
||||
import Unison.Prelude
|
||||
import Unison.PrettyPrintEnvDecl.Sqlite qualified as PPESqlite
|
||||
|
@ -16,6 +16,7 @@ import Unison.Codebase qualified as Codebase
|
||||
import Unison.Codebase.Path qualified as Path
|
||||
import Unison.Codebase.Runtime qualified as Rt
|
||||
import Unison.Codebase.ShortCausalHash (ShortCausalHash)
|
||||
import Unison.NameSegment.Internal (NameSegment (NameSegment))
|
||||
import Unison.Parser.Ann (Ann)
|
||||
import Unison.Prelude
|
||||
import Unison.Server.Backend
|
||||
@ -73,4 +74,4 @@ namespaceDetails runtime codebase namespacePath mayRoot _mayWidth = do
|
||||
pure $ namespaceDetails
|
||||
where
|
||||
readmeNames =
|
||||
Set.fromList ["README", "Readme", "ReadMe", "readme"]
|
||||
Set.fromList $ NameSegment <$> ["README", "Readme", "ReadMe", "readme"]
|
||||
|
@ -21,7 +21,7 @@ import Unison.HashQualified' qualified as HQ'
|
||||
import Unison.LabeledDependency qualified as LD
|
||||
import Unison.Name (Name)
|
||||
import Unison.Name qualified as Name
|
||||
import Unison.NameSegment (NameSegment (..))
|
||||
import Unison.NameSegment.Internal (NameSegment (NameSegment))
|
||||
import Unison.NamesWithHistory (SearchType (ExactName, IncludeSuffixes))
|
||||
import Unison.Prelude
|
||||
import Unison.Reference (Reference)
|
||||
|
@ -29,7 +29,7 @@ import Unison.HashQualified qualified as HQ
|
||||
import Unison.HashQualified' qualified as HQ'
|
||||
import Unison.Name (Name)
|
||||
import Unison.Name qualified as Name
|
||||
import Unison.NameSegment (NameSegment (..))
|
||||
import Unison.NameSegment.Internal (NameSegment (NameSegment))
|
||||
import Unison.Prelude
|
||||
import Unison.Project
|
||||
import Unison.Reference qualified as Reference
|
||||
|
@ -51,7 +51,7 @@ import Unison.Lexer.Pos (Column, Line, Pos (Pos), column, line)
|
||||
import Unison.Name (Name)
|
||||
import Unison.Name qualified as Name
|
||||
import Unison.NameSegment (NameSegment)
|
||||
import Unison.NameSegment qualified as NameSegment
|
||||
import Unison.NameSegment.Internal qualified as NameSegment
|
||||
import Unison.Prelude
|
||||
import Unison.ShortHash (ShortHash)
|
||||
import Unison.ShortHash qualified as SH
|
||||
@ -59,7 +59,7 @@ import Unison.Syntax.HashQualified' qualified as HQ' (toText)
|
||||
import Unison.Syntax.Lexer.Token (Token (..), posP, tokenP)
|
||||
import Unison.Syntax.Name qualified as Name (isSymboly, nameP, toText, unsafeParseText)
|
||||
import Unison.Syntax.NameSegment (symbolyIdChar, wordyIdChar, wordyIdStartChar)
|
||||
import Unison.Syntax.NameSegment qualified as NameSegment (ParseErr (..), wordyP)
|
||||
import Unison.Syntax.NameSegment qualified as NameSegment (ParseErr (..), docSegment, wordyP)
|
||||
import Unison.Syntax.ReservedWords (delimiters, typeModifiers, typeOrAbility)
|
||||
import Unison.Syntax.ShortHash qualified as ShortHash (shortHashP)
|
||||
import Unison.Util.Bytes qualified as Bytes
|
||||
@ -441,7 +441,7 @@ lexemes' eof =
|
||||
(Just (WordyId tname))
|
||||
| isTopLevel ->
|
||||
beforeStartToks
|
||||
<> [WordyId (HQ'.fromName (Name.snoc (HQ'.toName tname) "doc")) <$ openTok, Open "=" <$ openTok]
|
||||
<> [WordyId (HQ'.fromName (Name.snoc (HQ'.toName tname) NameSegment.docSegment)) <$ openTok, Open "=" <$ openTok]
|
||||
<> [openTok]
|
||||
<> bodyToks0
|
||||
<> [closeTok]
|
||||
|
@ -1,6 +1,25 @@
|
||||
-- | Utilities related to the parsing and printing of name segments using the default syntax.
|
||||
module Unison.Syntax.NameSegment
|
||||
( -- * String conversions
|
||||
( -- * Sentinel name segments
|
||||
defaultPatchSegment,
|
||||
docSegment,
|
||||
libSegment,
|
||||
publicLooseCodeSegment,
|
||||
baseSegment,
|
||||
snocSegment,
|
||||
consSegment,
|
||||
concatSegment,
|
||||
watchSegment,
|
||||
setSegment,
|
||||
modifySegment,
|
||||
licenseSegment,
|
||||
metadataSegment,
|
||||
authorsSegment,
|
||||
copyrightHoldersSegment,
|
||||
guidSegment,
|
||||
builtinSegment,
|
||||
|
||||
-- * String conversions
|
||||
toEscapedText,
|
||||
toEscapedTextBuilder,
|
||||
parseText,
|
||||
@ -33,12 +52,64 @@ import Text.Megaparsec (ParsecT)
|
||||
import Text.Megaparsec qualified as P
|
||||
import Text.Megaparsec.Char qualified as P
|
||||
import Text.Megaparsec.Internal qualified as P (withParsecT)
|
||||
import Unison.NameSegment (NameSegment (..))
|
||||
import Unison.NameSegment qualified as NameSegment
|
||||
import Unison.NameSegment (libSegment)
|
||||
import Unison.NameSegment.Internal (NameSegment (NameSegment))
|
||||
import Unison.NameSegment.Internal qualified as NameSegment
|
||||
import Unison.Prelude
|
||||
import Unison.Syntax.Lexer.Token (Token (..), posP)
|
||||
import Unison.Syntax.ReservedWords (keywords, reservedOperators)
|
||||
|
||||
------------------------------------------------------------------------------------------------------------------------
|
||||
-- special segment names
|
||||
|
||||
defaultPatchSegment :: NameSegment
|
||||
defaultPatchSegment = NameSegment "patch"
|
||||
|
||||
docSegment :: NameSegment
|
||||
docSegment = NameSegment "doc"
|
||||
|
||||
publicLooseCodeSegment :: NameSegment
|
||||
publicLooseCodeSegment = NameSegment "public"
|
||||
|
||||
baseSegment :: NameSegment
|
||||
baseSegment = NameSegment "base"
|
||||
|
||||
snocSegment :: NameSegment
|
||||
snocSegment = NameSegment ":+"
|
||||
|
||||
consSegment :: NameSegment
|
||||
consSegment = NameSegment "+:"
|
||||
|
||||
concatSegment :: NameSegment
|
||||
concatSegment = NameSegment "++"
|
||||
|
||||
watchSegment :: NameSegment
|
||||
watchSegment = NameSegment ">"
|
||||
|
||||
setSegment :: NameSegment
|
||||
setSegment = NameSegment "set"
|
||||
|
||||
modifySegment :: NameSegment
|
||||
modifySegment = NameSegment "modify"
|
||||
|
||||
licenseSegment :: NameSegment
|
||||
licenseSegment = NameSegment "License"
|
||||
|
||||
metadataSegment :: NameSegment
|
||||
metadataSegment = NameSegment "metadata"
|
||||
|
||||
authorsSegment :: NameSegment
|
||||
authorsSegment = NameSegment "authors"
|
||||
|
||||
copyrightHoldersSegment :: NameSegment
|
||||
copyrightHoldersSegment = NameSegment "copyrightHolders"
|
||||
|
||||
guidSegment :: NameSegment
|
||||
guidSegment = NameSegment "guid"
|
||||
|
||||
builtinSegment :: NameSegment
|
||||
builtinSegment = NameSegment "builtin"
|
||||
|
||||
------------------------------------------------------------------------------------------------------------------------
|
||||
-- String conversions
|
||||
|
||||
@ -91,7 +162,7 @@ renderParseErr = \case
|
||||
ReservedOperator s -> "reserved operator: " <> s
|
||||
ReservedWord s -> "reserved word: " <> s
|
||||
|
||||
segmentP :: Monad m => ParsecT (Token ParseErr) [Char] m NameSegment
|
||||
segmentP :: (Monad m) => ParsecT (Token ParseErr) [Char] m NameSegment
|
||||
segmentP =
|
||||
P.withParsecT (fmap ReservedOperator) symbolyP
|
||||
<|> P.withParsecT (fmap ReservedWord) wordyP
|
||||
|
Loading…
Reference in New Issue
Block a user