mirror of
https://github.com/unisonweb/unison.git
synced 2024-09-11 10:35:57 +03:00
sytax work
This commit is contained in:
parent
0504bca1b3
commit
3044255060
@ -34,7 +34,7 @@ verifyDeclFormatHash (ComponentHash hash) (DeclFormat.Decl (DeclFormat.LocallyIn
|
||||
& Map.toList
|
||||
& fmap (\(_refId, (v, decl, ())) -> (v, either H2.toDataDecl id $ H2.v2ToH2Decl decl))
|
||||
& Map.fromList
|
||||
& H2.hashDecls Name.unsafeFromVar
|
||||
& H2.hashDecls Name.unsafeParseVar
|
||||
& \case
|
||||
Left _err -> Just HH.DeclHashResolutionFailure
|
||||
Right m ->
|
||||
|
@ -1,9 +1,7 @@
|
||||
module Unison.NameSegment
|
||||
( NameSegment (..),
|
||||
toUnescapedText,
|
||||
isEmpty,
|
||||
isPrefixOf,
|
||||
toTextBuilder,
|
||||
|
||||
-- * Sentinel name segments
|
||||
defaultPatchSegment,
|
||||
@ -13,8 +11,6 @@ module Unison.NameSegment
|
||||
where
|
||||
|
||||
import Data.Text qualified as Text
|
||||
import Data.Text.Lazy.Builder qualified as Text (Builder)
|
||||
import Data.Text.Lazy.Builder qualified as Text.Builder
|
||||
import Unison.Prelude
|
||||
import Unison.Util.Alphabetical (Alphabetical)
|
||||
|
||||
@ -29,7 +25,8 @@ instance IsString NameSegment where
|
||||
NameSegment . Text.pack
|
||||
|
||||
instance Show NameSegment where
|
||||
show = show . toUnescapedText
|
||||
show =
|
||||
Text.unpack . toUnescapedText
|
||||
|
||||
-- | Convert a name segment to unescaped text.
|
||||
--
|
||||
@ -38,18 +35,10 @@ toUnescapedText :: NameSegment -> Text
|
||||
toUnescapedText =
|
||||
coerce
|
||||
|
||||
isEmpty :: NameSegment -> Bool
|
||||
isEmpty =
|
||||
coerce Text.null
|
||||
|
||||
isPrefixOf :: NameSegment -> NameSegment -> Bool
|
||||
isPrefixOf =
|
||||
coerce Text.isPrefixOf
|
||||
|
||||
toTextBuilder :: NameSegment -> Text.Builder
|
||||
toTextBuilder =
|
||||
coerce Text.Builder.fromText
|
||||
|
||||
defaultPatchSegment :: NameSegment
|
||||
defaultPatchSegment =
|
||||
"patch"
|
||||
|
@ -38,7 +38,7 @@ import Unison.Prelude
|
||||
import Unison.Reference qualified as R
|
||||
import Unison.Referent qualified as Referent
|
||||
import Unison.Symbol (Symbol)
|
||||
import Unison.Syntax.Name qualified as Name (unsafeFromText, unsafeFromVar)
|
||||
import Unison.Syntax.Name qualified as Name (unsafeParseText, unsafeParseVar)
|
||||
import Unison.Type qualified as Type
|
||||
import Unison.Typechecker.TypeLookup qualified as TL
|
||||
import Unison.Util.Relation qualified as Rel
|
||||
@ -56,24 +56,24 @@ names = Names terms types
|
||||
terms =
|
||||
Rel.mapRan Referent.Ref (Rel.fromMap termNameRefs)
|
||||
<> Rel.fromList
|
||||
[ (Name.unsafeFromVar vc, Referent.Con (ConstructorReference (R.DerivedId r) cid) ct)
|
||||
[ (Name.unsafeParseVar vc, Referent.Con (ConstructorReference (R.DerivedId r) cid) ct)
|
||||
| (ct, (_, (r, decl))) <-
|
||||
((CT.Data,) <$> builtinDataDecls)
|
||||
<> ((CT.Effect,) . (second . second) DD.toDataDecl <$> builtinEffectDecls),
|
||||
((_, vc, _), cid) <- DD.constructors' decl `zip` [0 ..]
|
||||
]
|
||||
<> Rel.fromList
|
||||
[ (Name.unsafeFromVar v, Referent.Ref (R.DerivedId i))
|
||||
[ (Name.unsafeParseVar v, Referent.Ref (R.DerivedId i))
|
||||
| (v, i) <- Map.toList TD.builtinTermsRef
|
||||
]
|
||||
types =
|
||||
Rel.fromList builtinTypes
|
||||
<> Rel.fromList
|
||||
[ (Name.unsafeFromVar v, R.DerivedId r)
|
||||
[ (Name.unsafeParseVar v, R.DerivedId r)
|
||||
| (v, (r, _)) <- builtinDataDecls
|
||||
]
|
||||
<> Rel.fromList
|
||||
[ (Name.unsafeFromVar v, R.DerivedId r)
|
||||
[ (Name.unsafeParseVar v, R.DerivedId r)
|
||||
| (v, (r, _)) <- builtinEffectDecls
|
||||
]
|
||||
|
||||
@ -147,7 +147,7 @@ builtinTypeDependentsOfComponent h0 = Rel.searchRan ord builtinDependencies
|
||||
-- if we decide to change their names.
|
||||
builtinTypes :: [(Name, R.Reference)]
|
||||
builtinTypes =
|
||||
Map.toList . Map.mapKeys Name.unsafeFromText $
|
||||
Map.toList . Map.mapKeys Name.unsafeParseText $
|
||||
foldl' go mempty builtinTypesSrc
|
||||
where
|
||||
go m = \case
|
||||
@ -286,7 +286,7 @@ instance Show BuiltinDSL where
|
||||
show _ = ""
|
||||
|
||||
termNameRefs :: Map Name R.Reference
|
||||
termNameRefs = Map.mapKeys Name.unsafeFromText $ foldl' go mempty (stripVersion builtinsSrc)
|
||||
termNameRefs = Map.mapKeys Name.unsafeParseText $ foldl' go mempty (stripVersion builtinsSrc)
|
||||
where
|
||||
go m = \case
|
||||
B r _tp -> Map.insert r (R.Builtin r) m
|
||||
|
@ -1,7 +1,3 @@
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE PartialTypeSignatures #-}
|
||||
|
||||
-- | Execute a computation of type '{IO} () that has been previously added to
|
||||
-- the codebase, without setting up an interactive environment.
|
||||
--
|
||||
@ -20,6 +16,7 @@ import Unison.Codebase.Runtime (Runtime)
|
||||
import Unison.Codebase.Runtime qualified as Runtime
|
||||
import Unison.Names qualified as Names
|
||||
import Unison.Parser.Ann (Ann)
|
||||
import Unison.Prelude
|
||||
import Unison.PrettyPrintEnv qualified as PPE
|
||||
import Unison.Symbol (Symbol)
|
||||
import Unison.Util.Pretty qualified as P
|
||||
@ -27,7 +24,7 @@ import Unison.Util.Pretty qualified as P
|
||||
execute ::
|
||||
Codebase.Codebase IO Symbol Ann ->
|
||||
Runtime Symbol ->
|
||||
String ->
|
||||
Text ->
|
||||
IO (Either Runtime.Error ())
|
||||
execute codebase runtime mainName =
|
||||
(`finally` Runtime.terminate runtime) . runExceptT $ do
|
||||
@ -37,9 +34,9 @@ execute codebase runtime mainName =
|
||||
let mainType = Runtime.mainType runtime
|
||||
mt <- liftIO $ Codebase.runTransaction codebase $ getMainTerm loadTypeOfTerm parseNames mainName mainType
|
||||
case mt of
|
||||
MainTerm.NotAFunctionName s -> throwError ("Not a function name: " <> P.string s)
|
||||
MainTerm.NotFound s -> throwError ("Not found: " <> P.string s)
|
||||
MainTerm.BadType s _ -> throwError (P.string s <> " is not of type '{IO} ()")
|
||||
MainTerm.NotAFunctionName s -> throwError ("Not a function name: " <> P.text s)
|
||||
MainTerm.NotFound s -> throwError ("Not found: " <> P.text s)
|
||||
MainTerm.BadType s _ -> throwError (P.text s <> " is not of type '{IO} ()")
|
||||
MainTerm.Success _ tm _ -> do
|
||||
let codeLookup = Codebase.toCodeLookup codebase
|
||||
ppe = PPE.empty
|
||||
|
@ -16,7 +16,7 @@ import Unison.Parser.Ann qualified as Parser.Ann
|
||||
import Unison.Prelude
|
||||
import Unison.Reference (Reference)
|
||||
import Unison.Referent qualified as Referent
|
||||
import Unison.Syntax.HashQualified qualified as HQ (fromString)
|
||||
import Unison.Syntax.HashQualified qualified as HQ (parseText)
|
||||
import Unison.Term (Term)
|
||||
import Unison.Term qualified as Term
|
||||
import Unison.Type (Type)
|
||||
@ -26,20 +26,20 @@ import Unison.Var (Var)
|
||||
import Unison.Var qualified as Var
|
||||
|
||||
data MainTerm v
|
||||
= NotAFunctionName String
|
||||
| NotFound String
|
||||
| BadType String (Maybe (Type v Ann))
|
||||
= NotAFunctionName Text
|
||||
| NotFound Text
|
||||
| BadType Text (Maybe (Type v Ann))
|
||||
| Success (HQ.HashQualified Name) (Term v Ann) (Type v Ann)
|
||||
|
||||
getMainTerm ::
|
||||
(Monad m, Var v) =>
|
||||
(Reference -> m (Maybe (Type v Ann))) ->
|
||||
Names.Names ->
|
||||
String ->
|
||||
Text ->
|
||||
Type.Type v Ann ->
|
||||
m (MainTerm v)
|
||||
getMainTerm loadTypeOfTerm parseNames mainName mainType =
|
||||
case HQ.fromString mainName of
|
||||
case HQ.parseText mainName of
|
||||
Nothing -> pure (NotAFunctionName mainName)
|
||||
Just hq -> do
|
||||
let refs = Names.lookupHQTerm Names.IncludeSuffixes hq parseNames
|
||||
|
@ -45,8 +45,8 @@ module Unison.Codebase.Path
|
||||
fromName,
|
||||
fromName',
|
||||
fromPath',
|
||||
fromText,
|
||||
fromText',
|
||||
unsafeParseText,
|
||||
unsafeParseText',
|
||||
toAbsoluteSplit,
|
||||
toSplit',
|
||||
toList,
|
||||
@ -93,7 +93,7 @@ import Unison.Name (Convert (..), Name, Parse)
|
||||
import Unison.Name qualified as Name
|
||||
import Unison.NameSegment (NameSegment)
|
||||
import Unison.Prelude hiding (empty, toList)
|
||||
import Unison.Syntax.Name qualified as Name (toText, unsafeFromText)
|
||||
import Unison.Syntax.Name qualified as Name (toText, unsafeParseText)
|
||||
import Unison.Util.List qualified as List
|
||||
|
||||
-- `Foo.Bar.baz` becomes ["Foo", "Bar", "baz"]
|
||||
@ -311,11 +311,13 @@ fromName' n
|
||||
path = fromName n
|
||||
|
||||
unsafeToName :: Path -> Name
|
||||
unsafeToName = Name.unsafeFromText . toText
|
||||
unsafeToName =
|
||||
fromMaybe (error "empty path") . toName
|
||||
|
||||
-- | Convert a Path' to a Name
|
||||
unsafeToName' :: Path' -> Name
|
||||
unsafeToName' = Name.unsafeFromText . toText'
|
||||
unsafeToName' =
|
||||
fromMaybe (error "empty path") . toName'
|
||||
|
||||
toName :: Path -> Maybe Name
|
||||
toName = \case
|
||||
@ -353,10 +355,10 @@ toText path =
|
||||
Nothing -> "."
|
||||
Just name -> Name.toText name
|
||||
|
||||
fromText :: Text -> Path
|
||||
fromText = \case
|
||||
unsafeParseText :: Text -> Path
|
||||
unsafeParseText = \case
|
||||
"" -> empty
|
||||
text -> fromName (Name.unsafeFromText text)
|
||||
text -> fromName (Name.unsafeParseText text)
|
||||
|
||||
-- | Construct a Path' from a text
|
||||
--
|
||||
@ -368,11 +370,11 @@ fromText = \case
|
||||
--
|
||||
-- >>> show $ fromText' ""
|
||||
-- ""
|
||||
fromText' :: Text -> Path'
|
||||
fromText' = \case
|
||||
unsafeParseText' :: Text -> Path'
|
||||
unsafeParseText' = \case
|
||||
"" -> RelativePath' (Relative mempty)
|
||||
"." -> AbsolutePath' (Absolute mempty)
|
||||
text -> fromName' (Name.unsafeFromText text)
|
||||
text -> fromName' (Name.unsafeParseText text)
|
||||
|
||||
toText' :: Path' -> Text
|
||||
toText' path =
|
||||
|
@ -26,7 +26,7 @@ import Unison.Reference (Reference)
|
||||
import Unison.Referent qualified as Referent
|
||||
import Unison.Result (CompilerBug (..), Note (..), ResultT, pattern Result)
|
||||
import Unison.Result qualified as Result
|
||||
import Unison.Syntax.Name qualified as Name (toText, unsafeFromVar)
|
||||
import Unison.Syntax.Name qualified as Name (toText, unsafeParseVar)
|
||||
import Unison.Syntax.Parser qualified as Parser
|
||||
import Unison.Term qualified as Term
|
||||
import Unison.Type qualified as Type
|
||||
@ -96,7 +96,7 @@ computeTypecheckingEnvironment shouldUseTndr ambientAbilities typeLookupf uf =
|
||||
[ (Name.toText name, Var.name v, r)
|
||||
| (name, r) <- Rel.toList (Names.terms preexistingNames),
|
||||
v <- Set.toList (Term.freeVars tm),
|
||||
name `Name.endsWithReverseSegments` List.NonEmpty.toList (Name.reverseSegments (Name.unsafeFromVar v))
|
||||
name `Name.endsWithReverseSegments` List.NonEmpty.toList (Name.reverseSegments (Name.unsafeParseVar v))
|
||||
]
|
||||
possibleRefs = Referent.toReference . view _3 <$> possibleDeps
|
||||
tl <- fmap (UF.declsToTypeLookup uf <>) (typeLookupf (UF.dependencies uf <> Set.fromList possibleRefs))
|
||||
@ -122,7 +122,7 @@ computeTypecheckingEnvironment shouldUseTndr ambientAbilities typeLookupf uf =
|
||||
[ (Var.name v, nr)
|
||||
| (name, r) <- Rel.toList (Names.terms $ UF.toNames uf),
|
||||
v <- Set.toList (Term.freeVars tm),
|
||||
name `Name.endsWithReverseSegments` List.NonEmpty.toList (Name.reverseSegments (Name.unsafeFromVar v)),
|
||||
name `Name.endsWithReverseSegments` List.NonEmpty.toList (Name.reverseSegments (Name.unsafeParseVar v)),
|
||||
typ <- toList $ TL.typeOfReferent tl r,
|
||||
let nr = Typechecker.NamedReference (Name.toText name) typ (Right r)
|
||||
]
|
||||
|
@ -45,7 +45,7 @@ import Unison.Names.ResolutionResult (ResolutionResult)
|
||||
import Unison.Pattern qualified as Memory.Pattern
|
||||
import Unison.Reference qualified as Memory.Reference
|
||||
import Unison.Referent qualified as Memory.Referent
|
||||
import Unison.Syntax.Name qualified as Name (unsafeFromVar)
|
||||
import Unison.Syntax.Name qualified as Name (unsafeParseVar)
|
||||
import Unison.Term qualified as Memory.Term
|
||||
import Unison.Type qualified as Memory.Type
|
||||
import Unison.Util.Map qualified as Map
|
||||
@ -230,7 +230,7 @@ hashDataDecls ::
|
||||
ResolutionResult v a [(v, Memory.Reference.Id, Memory.DD.DataDeclaration v a)]
|
||||
hashDataDecls memDecls = do
|
||||
let hashingDecls = fmap m2hDecl memDecls
|
||||
hashingResult <- Hashing.hashDecls Name.unsafeFromVar hashingDecls
|
||||
hashingResult <- Hashing.hashDecls Name.unsafeParseVar hashingDecls
|
||||
pure $ map h2mDeclResult hashingResult
|
||||
where
|
||||
h2mDeclResult :: (Ord v) => (v, Hashing.ReferenceId, Hashing.DataDeclaration v a) -> (v, Memory.Reference.Id, Memory.DD.DataDeclaration v a)
|
||||
|
@ -4,7 +4,7 @@ import Data.Map qualified as Map
|
||||
import Unison.HashQualified qualified as HQ
|
||||
import Unison.Name (Name)
|
||||
import Unison.Prelude
|
||||
import Unison.Syntax.Name qualified as Name (unsafeFromText)
|
||||
import Unison.Syntax.Name qualified as Name (unsafeParseText)
|
||||
|
||||
-- Type aliases relating to Fully-Qualified Names, e.g. 'Acme.API.foo'
|
||||
-- Used primarily by the FQN elision code - see TermPrinter.PrintAnnotation.
|
||||
@ -25,7 +25,7 @@ elideFQN imports hq =
|
||||
let hash = HQ.toHash hq
|
||||
name' = do
|
||||
name <- HQ.toName hq
|
||||
let hit = fmap Name.unsafeFromText (Map.lookup name imports)
|
||||
let hit = fmap Name.unsafeParseText (Map.lookup name imports)
|
||||
-- Cut out the "const id $" to get tracing of FQN elision attempts.
|
||||
let t = const id $ trace ("hit: " ++ show hit ++ " finding: " ++ show hq ++ " in imports: " ++ show imports)
|
||||
t (pure $ fromMaybe name hit)
|
||||
|
@ -41,7 +41,7 @@ import Unison.Result (Note (..))
|
||||
import Unison.Result qualified as Result
|
||||
import Unison.Settings qualified as Settings
|
||||
import Unison.Symbol (Symbol)
|
||||
import Unison.Syntax.HashQualified qualified as HQ (toString)
|
||||
import Unison.Syntax.HashQualified qualified as HQ (toText)
|
||||
import Unison.Syntax.Lexer qualified as L
|
||||
import Unison.Syntax.Name qualified as Name (toText)
|
||||
import Unison.Syntax.NamePrinter (prettyHashQualified0)
|
||||
@ -1232,15 +1232,15 @@ renderKind Kind.Star = "*"
|
||||
renderKind (Kind.Arrow k1 k2) = renderKind k1 <> " -> " <> renderKind k2
|
||||
|
||||
showTermRef :: (IsString s) => Env -> Referent -> s
|
||||
showTermRef env r = fromString . HQ.toString $ PPE.termName env r
|
||||
showTermRef env r = fromString . Text.unpack . HQ.toText $ PPE.termName env r
|
||||
|
||||
showTypeRef :: (IsString s) => Env -> R.Reference -> s
|
||||
showTypeRef env r = fromString . HQ.toString $ PPE.typeName env r
|
||||
showTypeRef env r = fromString . Text.unpack . HQ.toText $ PPE.typeName env r
|
||||
|
||||
-- todo: do something different/better if cid not found
|
||||
showConstructor :: (IsString s) => Env -> ConstructorReference -> s
|
||||
showConstructor env r =
|
||||
fromString . HQ.toString $
|
||||
fromString . Text.unpack . HQ.toText $
|
||||
PPE.patternName env r
|
||||
|
||||
styleInOverallType ::
|
||||
@ -1803,10 +1803,10 @@ renderParseErrors s = \case
|
||||
let msg =
|
||||
Pr.lines
|
||||
[ if missing
|
||||
then "I couldn't resolve the reference " <> style ErrorSite (HQ.toString (L.payload tok)) <> "."
|
||||
else "The reference " <> style ErrorSite (HQ.toString (L.payload tok)) <> " was ambiguous.",
|
||||
then "I couldn't resolve the reference " <> style ErrorSite (Text.unpack (HQ.toText (L.payload tok))) <> "."
|
||||
else "The reference " <> style ErrorSite (Text.unpack (HQ.toText (L.payload tok))) <> " was ambiguous.",
|
||||
"",
|
||||
tokenAsErrorSite s $ HQ.toString <$> tok,
|
||||
tokenAsErrorSite s $ HQ.toText <$> tok,
|
||||
if missing
|
||||
then "Make sure it's spelled correctly."
|
||||
else "Try hash-qualifying the term you meant to reference."
|
||||
@ -1818,10 +1818,10 @@ renderParseErrors s = \case
|
||||
let msg =
|
||||
Pr.lines
|
||||
[ if Set.null referents
|
||||
then "I couldn't find a term for " <> style ErrorSite (HQ.toString (L.payload tok)) <> "."
|
||||
else "The term reference " <> style ErrorSite (HQ.toString (L.payload tok)) <> " was ambiguous.",
|
||||
then "I couldn't find a term for " <> style ErrorSite (Text.unpack (HQ.toText (L.payload tok))) <> "."
|
||||
else "The term reference " <> style ErrorSite (Text.unpack (HQ.toText (L.payload tok))) <> " was ambiguous.",
|
||||
"",
|
||||
tokenAsErrorSite s $ HQ.toString <$> tok,
|
||||
tokenAsErrorSite s $ HQ.toText <$> tok,
|
||||
if missing
|
||||
then "Make sure it's spelled correctly."
|
||||
else "Try hash-qualifying the term you meant to reference."
|
||||
@ -1833,10 +1833,10 @@ renderParseErrors s = \case
|
||||
let msg =
|
||||
Pr.lines
|
||||
[ if Set.null referents
|
||||
then "I couldn't find a type for " <> style ErrorSite (HQ.toString (L.payload tok)) <> "."
|
||||
else "The type reference " <> style ErrorSite (HQ.toString (L.payload tok)) <> " was ambiguous.",
|
||||
then "I couldn't find a type for " <> style ErrorSite (Text.unpack (HQ.toText (L.payload tok))) <> "."
|
||||
else "The type reference " <> style ErrorSite (Text.unpack (HQ.toText (L.payload tok))) <> " was ambiguous.",
|
||||
"",
|
||||
tokenAsErrorSite s $ HQ.toString <$> tok,
|
||||
tokenAsErrorSite s $ HQ.toText <$> tok,
|
||||
if missing
|
||||
then "Make sure it's spelled correctly."
|
||||
else "Try hash-qualifying the type you meant to reference."
|
||||
|
@ -101,7 +101,7 @@ import Unison.ConstructorReference (ConstructorReference, GConstructorReference
|
||||
import Unison.Hashing.V2.Convert (hashTermComponentsWithoutTypes)
|
||||
import Unison.Pattern (SeqOp (..))
|
||||
import Unison.Pattern qualified as P
|
||||
import Unison.Prelude hiding (Text)
|
||||
import Unison.Prelude
|
||||
import Unison.Reference (Id, Reference, Reference' (Builtin, DerivedId))
|
||||
import Unison.Referent (Referent, pattern Con, pattern Ref)
|
||||
import Unison.Symbol (Symbol)
|
||||
@ -621,11 +621,11 @@ saturate dat = ABT.visitPure $ \case
|
||||
fvs = foldMap freeVars args
|
||||
args' = saturate dat <$> args
|
||||
|
||||
addDefaultCases :: (Var v) => (Monoid a) => String -> Term v a -> Term v a
|
||||
addDefaultCases :: (Var v) => (Monoid a) => Text -> Term v a -> Term v a
|
||||
addDefaultCases = ABT.visitPure . defaultCaseVisitor
|
||||
|
||||
defaultCaseVisitor ::
|
||||
(Var v) => (Monoid a) => String -> Term v a -> Maybe (Term v a)
|
||||
(Var v) => (Monoid a) => Text -> Term v a -> Maybe (Term v a)
|
||||
defaultCaseVisitor func m@(Match' scrut cases)
|
||||
| scrut <- addDefaultCases func scrut,
|
||||
cases <- fmap (addDefaultCases func) <$> cases =
|
||||
@ -634,7 +634,7 @@ defaultCaseVisitor func m@(Match' scrut cases)
|
||||
a = ABT.annotation m
|
||||
v = Var.freshIn mempty $ typed Var.Blank
|
||||
txt = "pattern match failure in function `" <> func <> "`"
|
||||
msg = text a $ Data.Text.pack txt
|
||||
msg = text a txt
|
||||
bu = ref a (Builtin "bug")
|
||||
dflt =
|
||||
MatchCase (P.Var a) Nothing
|
||||
|
@ -109,7 +109,7 @@ import Unison.Runtime.Pattern
|
||||
import Unison.Runtime.Serialize as SER
|
||||
import Unison.Runtime.Stack
|
||||
import Unison.Symbol (Symbol)
|
||||
import Unison.Syntax.HashQualified qualified as HQ (toString)
|
||||
import Unison.Syntax.HashQualified qualified as HQ (toText)
|
||||
import Unison.Syntax.NamePrinter (prettyHashQualified)
|
||||
import Unison.Syntax.TermPrinter
|
||||
import Unison.Term qualified as Tm
|
||||
@ -529,7 +529,7 @@ intermediateTerms ppe ctx rtms =
|
||||
. splitPatterns (dspec ctx)
|
||||
. addDefaultCases tmName
|
||||
where
|
||||
tmName = HQ.toString . termName ppe $ RF.Ref ref
|
||||
tmName = HQ.toText . termName ppe $ RF.Ref ref
|
||||
where
|
||||
orig =
|
||||
Map.fromList
|
||||
@ -597,7 +597,7 @@ intermediateTerm ppe ctx tm =
|
||||
case normalizeTerm ctx tm of
|
||||
(ref, frem, cmbs, dcmp) -> (ref, frem, fmap f cmbs, dcmp)
|
||||
where
|
||||
tmName = HQ.toString . termName ppe $ RF.Ref ref
|
||||
tmName = HQ.toText . termName ppe $ RF.Ref ref
|
||||
f =
|
||||
superNormalize
|
||||
. splitPatterns (dspec ctx)
|
||||
|
@ -15,7 +15,7 @@ import Unison.Name qualified as Name
|
||||
import Unison.Parser.Ann (Ann)
|
||||
import Unison.Prelude
|
||||
import Unison.Syntax.Lexer qualified as L
|
||||
import Unison.Syntax.Name qualified as Name (toText, unsafeFromVar)
|
||||
import Unison.Syntax.Name qualified as Name (toText, unsafeParseVar)
|
||||
import Unison.Syntax.Parser
|
||||
import Unison.Syntax.TermParser qualified as TermParser
|
||||
import Unison.Syntax.TypeParser qualified as TypeParser
|
||||
@ -99,7 +99,7 @@ resolveUnresolvedModifier unresolvedModifier var =
|
||||
resolveUniqueModifier :: (Monad m, Var v) => v -> Text -> P v m DD.Modifier
|
||||
resolveUniqueModifier var guid0 = do
|
||||
ParsingEnv {uniqueTypeGuid} <- ask
|
||||
guid <- fromMaybe guid0 <$> lift (lift (uniqueTypeGuid (Name.unsafeFromVar var)))
|
||||
guid <- fromMaybe guid0 <$> lift (lift (uniqueTypeGuid (Name.unsafeParseVar var)))
|
||||
pure $ DD.Unique guid
|
||||
|
||||
defaultUniqueModifier :: (Monad m, Var v) => v -> P v m DD.Modifier
|
||||
@ -182,7 +182,7 @@ dataDeclaration maybeUnresolvedModifier = do
|
||||
)
|
||||
fields <- field
|
||||
closingToken <- closeBlock
|
||||
let lastSegment = name <&> (\v -> Var.named (Name.toText $ Name.unqualified (Name.unsafeFromVar v)))
|
||||
let lastSegment = name <&> (\v -> Var.named (Name.toText $ Name.unqualified (Name.unsafeParseVar v)))
|
||||
pure ([go lastSegment (snd <$> fields)], [(name, fields)], ann closingToken)
|
||||
(constructors, accessors, closingAnn) <-
|
||||
msum [Left <$> record, Right <$> sepBy (reserved "|") dataConstructor] <&> \case
|
||||
|
@ -1,8 +1,8 @@
|
||||
module Unison.Syntax.DeclPrinter (prettyDecl, prettyDeclW, prettyDeclHeader, prettyDeclOrBuiltinHeader, AccessorName) where
|
||||
|
||||
import Control.Monad.Writer (Writer, runWriter, tell)
|
||||
import Data.List (isPrefixOf)
|
||||
import Data.Map qualified as Map
|
||||
import Data.Text qualified as Text
|
||||
import Unison.ConstructorReference (ConstructorReference, GConstructorReference (..))
|
||||
import Unison.ConstructorType qualified as CT
|
||||
import Unison.DataDeclaration
|
||||
@ -21,7 +21,7 @@ import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl (..))
|
||||
import Unison.PrettyPrintEnvDecl qualified as PPED
|
||||
import Unison.Reference (Reference, Reference' (DerivedId))
|
||||
import Unison.Referent qualified as Referent
|
||||
import Unison.Syntax.HashQualified qualified as HQ (toString, toVar, unsafeFromString)
|
||||
import Unison.Syntax.HashQualified qualified as HQ (toText, toVar, unsafeParseText)
|
||||
import Unison.Syntax.NamePrinter (styleHashQualified'')
|
||||
import Unison.Syntax.TypePrinter (runPretty)
|
||||
import Unison.Syntax.TypePrinter qualified as TypePrinter
|
||||
@ -83,7 +83,7 @@ prettyGADT env ctorType r name dd =
|
||||
constructor (n, (_, _, t)) =
|
||||
prettyPattern (PPED.unsuffixifiedPPE env) ctorType name (ConstructorReference r n)
|
||||
<> fmt S.TypeAscriptionColon " :"
|
||||
`P.hang` TypePrinter.prettySyntax (PPED.suffixifiedPPE env) t
|
||||
`P.hang` TypePrinter.prettySyntax (PPED.suffixifiedPPE env) t
|
||||
header = prettyEffectHeader name (DD.EffectDeclaration dd) <> fmt S.ControlKeyword " where"
|
||||
|
||||
prettyPattern ::
|
||||
@ -115,9 +115,9 @@ prettyDataDecl (PrettyPrintEnvDecl unsuffixifiedPPE suffixifiedPPE) r name dd =
|
||||
(header <>)
|
||||
. P.sep (fmt S.DelimiterChar (" | " `P.orElse` "\n | "))
|
||||
<$> constructor
|
||||
`traverse` zip
|
||||
[0 ..]
|
||||
(DD.constructors' dd)
|
||||
`traverse` zip
|
||||
[0 ..]
|
||||
(DD.constructors' dd)
|
||||
where
|
||||
constructor (n, (_, _, Type.ForallsNamed' _ t)) = constructor' n t
|
||||
constructor (n, (_, _, t)) = constructor' n t
|
||||
@ -136,7 +136,7 @@ prettyDataDecl (PrettyPrintEnvDecl unsuffixifiedPPE suffixifiedPPE) r name dd =
|
||||
Just accessor -> HQ.NameOnly $ declName `Name.joinDot` fieldName `Name.joinDot` accessor
|
||||
| HQ.NameOnly declName <- [name],
|
||||
HQ.NameOnly fieldName <- fs,
|
||||
accessor <- [Nothing, Just "set", Just "modify"]
|
||||
accessor <- [Nothing, Just (Name.fromSegment "set"), Just (Name.fromSegment "modify")]
|
||||
]
|
||||
pure . P.group $
|
||||
fmt S.DelimiterChar "{ "
|
||||
@ -148,7 +148,7 @@ prettyDataDecl (PrettyPrintEnvDecl unsuffixifiedPPE suffixifiedPPE) r name dd =
|
||||
P.group $
|
||||
styleHashQualified'' (fmt (S.TypeReference r)) fname
|
||||
<> fmt S.TypeAscriptionColon " :"
|
||||
`P.hang` runPretty suffixifiedPPE (TypePrinter.prettyRaw Map.empty (-1) typ)
|
||||
`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
|
||||
@ -180,18 +180,24 @@ fieldNames env r name dd = do
|
||||
vars = [Var.freshenId (fromIntegral n) (Var.named "_") | n <- [0 .. Type.arity typ - 1]]
|
||||
hashes <- DD.hashFieldAccessors env (HQ.toVar name) vars r dd
|
||||
let names =
|
||||
[ (r, HQ.toString . PPE.termName env . Referent.Ref $ DerivedId r)
|
||||
[ (r, HQ.toText . PPE.termName env . Referent.Ref $ DerivedId r)
|
||||
| r <- (\(refId, _trm, _typ) -> refId) <$> Map.elems hashes
|
||||
]
|
||||
let fieldNames =
|
||||
Map.fromList
|
||||
[ (r, f) | (r, n) <- names, typename <- pure (HQ.toString name), typename `isPrefixOf` n, rest <- pure $ drop (length typename + 1) n, (f, rest) <- pure $ span (/= '.') rest, rest `elem` ["", ".set", ".modify"]
|
||||
[ (r, f)
|
||||
| (r, n) <- names,
|
||||
typename <- pure (HQ.toText name),
|
||||
typename `Text.isPrefixOf` n,
|
||||
rest <- pure $ Text.drop (Text.length typename + 1) n,
|
||||
(f, rest) <- pure $ Text.span (/= '.') rest,
|
||||
rest `elem` ["", ".set", ".modify"]
|
||||
]
|
||||
|
||||
if Map.size fieldNames == length names
|
||||
then
|
||||
Just
|
||||
[ HQ.unsafeFromString name
|
||||
[ HQ.unsafeParseText name
|
||||
| v <- vars,
|
||||
Just (ref, _, _) <- [Map.lookup (Var.namespaced [HQ.toVar name, v]) hashes],
|
||||
Just name <- [Map.lookup ref fieldNames]
|
||||
|
@ -4,6 +4,7 @@ import Control.Lens
|
||||
import Control.Monad.Reader (asks, local)
|
||||
import Data.Map qualified as Map
|
||||
import Data.Set qualified as Set
|
||||
import Data.Text qualified as Text
|
||||
import Text.Megaparsec qualified as P
|
||||
import Unison.ABT qualified as ABT
|
||||
import Unison.DataDeclaration (DataDeclaration)
|
||||
@ -17,7 +18,7 @@ import Unison.Parser.Ann qualified as Ann
|
||||
import Unison.Prelude
|
||||
import Unison.Syntax.DeclParser (declarations)
|
||||
import Unison.Syntax.Lexer qualified as L
|
||||
import Unison.Syntax.Name qualified as Name (toString, unsafeFromVar)
|
||||
import Unison.Syntax.Name qualified as Name (toText, unsafeParseVar)
|
||||
import Unison.Syntax.Parser
|
||||
import Unison.Syntax.TermParser qualified as TermParser
|
||||
import Unison.Term (Term)
|
||||
@ -53,7 +54,7 @@ file = do
|
||||
Just (r, _) <- [Map.lookup (L.payload typ) (UF.datas env)]
|
||||
]
|
||||
toPair (tok, typ) = (L.payload tok, ann tok <> ann typ)
|
||||
let importNames = [(Name.unsafeFromVar v, Name.unsafeFromVar v2) | (v, v2) <- imports]
|
||||
let importNames = [(Name.unsafeParseVar v, Name.unsafeParseVar v2) | (v, v2) <- imports]
|
||||
let locals = Names.importing importNames (UF.names env)
|
||||
-- At this stage of the file parser, we've parsed all the type and ability
|
||||
-- declarations. The `push locals` here has the effect
|
||||
@ -94,13 +95,13 @@ file = do
|
||||
-- All unique local term name suffixes - these we want to
|
||||
-- avoid resolving to a term that's in the codebase
|
||||
locals :: [Name.Name]
|
||||
locals = (Name.unsafeFromVar <$> Map.keys canonicalVars)
|
||||
locals = (Name.unsafeParseVar <$> Map.keys canonicalVars)
|
||||
|
||||
-- A function to replace unique local term suffixes with their
|
||||
-- fully qualified name
|
||||
replacements = [(v, Term.var () v2) | (v, v2) <- Map.toList canonicalVars, v /= v2]
|
||||
resolveLocals = ABT.substsInheritAnnotation replacements
|
||||
let bindNames = Term.bindSomeNames Name.unsafeFromVar (Set.fromList fqLocalTerms) curNames . resolveLocals
|
||||
let bindNames = Term.bindSomeNames Name.unsafeParseVar (Set.fromList fqLocalTerms) curNames . resolveLocals
|
||||
terms <- case List.validate (traverseOf _3 bindNames) terms of
|
||||
Left es -> resolutionFailures (toList es)
|
||||
Right terms -> pure terms
|
||||
@ -218,7 +219,7 @@ stanza = watchExpression <|> unexpectedAction <|> binding
|
||||
|
||||
watched :: (Monad m, Var v) => P v m (UF.WatchKind, Text, Ann)
|
||||
watched = P.try do
|
||||
kind <- (fmap . fmap . fmap) Name.toString (optional importWordyId)
|
||||
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 ">"))
|
||||
|
@ -44,7 +44,7 @@ import Unison.Prelude
|
||||
import Unison.Reference (Reference)
|
||||
import Unison.Referent (Referent)
|
||||
import Unison.Syntax.Lexer qualified as L
|
||||
import Unison.Syntax.Name qualified as Name (toText, toVar, unsafeFromVar)
|
||||
import Unison.Syntax.Name qualified as Name (toText, toVar, unsafeParseVar)
|
||||
import Unison.Syntax.NameSegment qualified as NameSegment (toEscapedText)
|
||||
import Unison.Syntax.Parser hiding (seq)
|
||||
import Unison.Syntax.Parser qualified as Parser (seq, uniqueName)
|
||||
@ -1026,7 +1026,7 @@ typedecl =
|
||||
verifyRelativeVarName :: (Var v) => P v m (L.Token v) -> P v m (L.Token v)
|
||||
verifyRelativeVarName p = do
|
||||
v <- p
|
||||
verifyRelativeName' (Name.unsafeFromVar <$> v)
|
||||
verifyRelativeName' (Name.unsafeParseVar <$> v)
|
||||
pure v
|
||||
|
||||
verifyRelativeName' :: (Ord v) => L.Token Name -> P v m ()
|
||||
@ -1097,7 +1097,7 @@ binding = label "binding" do
|
||||
-- we haven't seen a type annotation, so lookahead to '=' before commit
|
||||
(lhsLoc, name, args) <- P.try (lhs <* P.lookAhead (openBlockWith "="))
|
||||
(_bodySpanAnn, body) <- block "="
|
||||
verifyRelativeName' (fmap Name.unsafeFromVar name)
|
||||
verifyRelativeName' (fmap Name.unsafeParseVar name)
|
||||
let binding = mkBinding lhsLoc args body
|
||||
-- We don't actually use the span annotation from the block (yet) because it
|
||||
-- may contain a bunch of white-space and comments following a top-level-definition.
|
||||
@ -1105,7 +1105,7 @@ binding = label "binding" do
|
||||
pure $ ((spanAnn, (L.payload name)), binding)
|
||||
Just (nameT, typ) -> do
|
||||
(lhsLoc, name, args) <- lhs
|
||||
verifyRelativeName' (fmap Name.unsafeFromVar name)
|
||||
verifyRelativeName' (fmap Name.unsafeParseVar name)
|
||||
when (L.payload name /= L.payload nameT) $
|
||||
customFailure $
|
||||
SignatureNeedsAccompanyingBody nameT
|
||||
@ -1191,7 +1191,7 @@ substImports ns imports =
|
||||
-- not in Names, but in a later term binding
|
||||
[ (suffix, Type.var () full)
|
||||
| (suffix, full) <- imports,
|
||||
Names.hasTypeNamed Names.IncludeSuffixes (Name.unsafeFromVar full) ns
|
||||
Names.hasTypeNamed Names.IncludeSuffixes (Name.unsafeParseVar full) ns
|
||||
]
|
||||
|
||||
block' ::
|
||||
|
@ -52,7 +52,7 @@ import Unison.Referent (Referent)
|
||||
import Unison.Referent qualified as Referent
|
||||
import Unison.Syntax.HashQualified qualified as HQ (unsafeFromVar)
|
||||
import Unison.Syntax.Lexer (showEscapeChar)
|
||||
import Unison.Syntax.Name qualified as Name (fromText, fromTextEither, isSymboly, toText, unsafeFromText)
|
||||
import Unison.Syntax.Name qualified as Name (isSymboly, parseText, parseTextEither, toText, unsafeParseText)
|
||||
import Unison.Syntax.NamePrinter (styleHashQualified'')
|
||||
import Unison.Syntax.NameSegment qualified as NameSegment (toEscapedText)
|
||||
import Unison.Syntax.TypePrinter qualified as TypePrinter
|
||||
@ -1265,7 +1265,7 @@ printAnnotate n tm =
|
||||
Set.fromList [n | v <- ABT.allVars tm, n <- varToName v]
|
||||
usedTypeNames =
|
||||
Set.fromList [n | Ann' _ ty <- ABT.subterms tm, v <- ABT.allVars ty, n <- varToName v]
|
||||
varToName v = toList (Name.fromText (Var.name v))
|
||||
varToName v = toList (Name.parseText (Var.name v))
|
||||
go :: (Ord v) => Term2 v at ap v b -> Term2 v () () v b
|
||||
go = extraMap' id (const ()) (const ())
|
||||
|
||||
@ -1312,7 +1312,7 @@ countName n =
|
||||
}
|
||||
|
||||
joinName :: Prefix -> Suffix -> Name
|
||||
joinName p s = Name.unsafeFromText $ dotConcat $ p ++ [s]
|
||||
joinName p s = Name.unsafeParseText $ dotConcat $ p ++ [s]
|
||||
|
||||
dotConcat :: [Text] -> Text
|
||||
dotConcat = Text.concat . intersperse "."
|
||||
@ -1389,7 +1389,7 @@ calcImports im tm = (im', render $ getUses result)
|
||||
|> filter
|
||||
( \s ->
|
||||
let (p, i) = lookupOrDie s m
|
||||
in (i > 1 || isRight (Name.fromTextEither s)) && not (null p)
|
||||
in (i > 1 || isRight (Name.parseTextEither s)) && not (null p)
|
||||
)
|
||||
|> map (\s -> (s, lookupOrDie s m))
|
||||
|> Map.fromList
|
||||
@ -2155,7 +2155,8 @@ avoidShadowing tm (PrettyPrintEnv terms types) =
|
||||
& maybe fullName HQ'.NameOnly
|
||||
in (fullName, minimallySuffixed)
|
||||
tweak _ p = p
|
||||
varToName v = toList (Name.fromText (Var.name v))
|
||||
varToName :: Var v => v -> [Name]
|
||||
varToName = toList . Name.parseText . Var.name
|
||||
|
||||
isLeaf :: Term2 vt at ap v a -> Bool
|
||||
isLeaf (Var' {}) = True
|
||||
|
@ -51,7 +51,7 @@ import Unison.Result
|
||||
pattern Result,
|
||||
)
|
||||
import Unison.Result qualified as Result
|
||||
import Unison.Syntax.Name qualified as Name (toText, unsafeFromText)
|
||||
import Unison.Syntax.Name qualified as Name (toText, unsafeParseText)
|
||||
import Unison.Term (Term)
|
||||
import Unison.Term qualified as Term
|
||||
import Unison.Type (Type)
|
||||
@ -242,7 +242,7 @@ typeDirectedNameResolution ppe oldNotes oldType env = do
|
||||
addTypedComponent :: Context.InfoNote v loc -> State (Env v loc) ()
|
||||
addTypedComponent (Context.TopLevelComponent vtts) =
|
||||
for_ vtts $ \(v, typ, _) ->
|
||||
for_ (Name.suffixes . Name.unsafeFromText . Var.name $ Var.reset v) $ \suffix ->
|
||||
for_ (Name.suffixes . Name.unsafeParseText . Var.name $ Var.reset v) $ \suffix ->
|
||||
termsByShortname
|
||||
%= Map.insertWith
|
||||
(<>)
|
||||
@ -278,7 +278,7 @@ typeDirectedNameResolution ppe oldNotes oldType env = do
|
||||
Map.insertWith
|
||||
Set.union
|
||||
suggestionReplacement
|
||||
(Set.singleton (Name.unsafeFromText suggestionName))
|
||||
(Set.singleton (Name.unsafeParseText suggestionName))
|
||||
b
|
||||
)
|
||||
Map.empty
|
||||
|
@ -31,8 +31,8 @@ import Unison.WatchKind qualified as WK
|
||||
toNames :: (Var v) => UnisonFile v a -> Names
|
||||
toNames uf = datas <> effects
|
||||
where
|
||||
datas = foldMap (DD.Names.dataDeclToNames' Name.unsafeFromVar) (Map.toList (UF.dataDeclarationsId uf))
|
||||
effects = foldMap (DD.Names.effectDeclToNames' Name.unsafeFromVar) (Map.toList (UF.effectDeclarationsId uf))
|
||||
datas = foldMap (DD.Names.dataDeclToNames' Name.unsafeParseVar) (Map.toList (UF.dataDeclarationsId uf))
|
||||
effects = foldMap (DD.Names.effectDeclToNames' Name.unsafeParseVar) (Map.toList (UF.effectDeclarationsId uf))
|
||||
|
||||
addNamesFromUnisonFile :: (Var v) => UnisonFile v a -> Names -> Names
|
||||
addNamesFromUnisonFile unisonFile names = Names.shadowing (toNames unisonFile) names
|
||||
@ -42,13 +42,13 @@ typecheckedToNames uf = Names (terms <> ctors) types
|
||||
where
|
||||
terms =
|
||||
Relation.fromList
|
||||
[ (Name.unsafeFromVar v, Referent.Ref r)
|
||||
[ (Name.unsafeParseVar v, Referent.Ref r)
|
||||
| (v, (_a, r, wk, _, _)) <- Map.toList $ UF.hashTerms uf,
|
||||
wk == Nothing || wk == Just WK.TestWatch
|
||||
]
|
||||
types =
|
||||
Relation.fromList
|
||||
[ (Name.unsafeFromVar v, r)
|
||||
[ (Name.unsafeParseVar v, r)
|
||||
| (v, r) <-
|
||||
Map.toList $
|
||||
fmap fst (UF.dataDeclarations' uf)
|
||||
@ -56,7 +56,7 @@ typecheckedToNames uf = Names (terms <> ctors) types
|
||||
]
|
||||
ctors =
|
||||
Relation.fromMap
|
||||
. Map.mapKeys Name.unsafeFromVar
|
||||
. Map.mapKeys Name.unsafeParseVar
|
||||
. fmap (fmap Reference.DerivedId)
|
||||
. UF.hashConstructors
|
||||
$ uf
|
||||
@ -87,8 +87,8 @@ bindNames names (UnisonFileId d e ts ws) = do
|
||||
let termVars = (view _1 <$> ts) ++ (Map.elems ws >>= map (view _1))
|
||||
termVarsSet = Set.fromList termVars
|
||||
-- todo: can we clean up this lambda using something like `second`
|
||||
ts' <- traverse (\(v, a, t) -> (v,a,) <$> Term.bindNames Name.unsafeFromVar termVarsSet names t) ts
|
||||
ws' <- traverse (traverse (\(v, a, t) -> (v,a,) <$> Term.bindNames Name.unsafeFromVar termVarsSet names t)) ws
|
||||
ts' <- traverse (\(v, a, t) -> (v,a,) <$> Term.bindNames Name.unsafeParseVar termVarsSet names t) ts
|
||||
ws' <- traverse (traverse (\(v, a, t) -> (v,a,) <$> Term.bindNames Name.unsafeParseVar termVarsSet names t)) ws
|
||||
pure $ UnisonFileId d e ts' ws'
|
||||
|
||||
-- | Given the set of fully-qualified variable names, this computes
|
||||
@ -111,7 +111,7 @@ variableCanonicalizer :: forall v. Var v => [v] -> Map v v
|
||||
variableCanonicalizer vs =
|
||||
done $ List.multimap do
|
||||
v <- vs
|
||||
let n = Name.unsafeFromVar v
|
||||
let n = Name.unsafeParseVar v
|
||||
suffix <- Name.suffixes n
|
||||
pure (Var.named (Name.toText suffix), v)
|
||||
where
|
||||
@ -134,9 +134,9 @@ environmentFor names dataDecls0 effectDecls0 = do
|
||||
let locallyBoundTypes = variableCanonicalizer (Map.keys dataDecls0 <> Map.keys effectDecls0)
|
||||
-- data decls and hash decls may reference each other, and thus must be hashed together
|
||||
dataDecls :: Map v (DataDeclaration v a) <-
|
||||
traverse (DD.Names.bindNames Name.unsafeFromVar locallyBoundTypes names) dataDecls0
|
||||
traverse (DD.Names.bindNames Name.unsafeParseVar locallyBoundTypes names) dataDecls0
|
||||
effectDecls :: Map v (EffectDeclaration v a) <-
|
||||
traverse (DD.withEffectDeclM (DD.Names.bindNames Name.unsafeFromVar locallyBoundTypes names)) effectDecls0
|
||||
traverse (DD.withEffectDeclM (DD.Names.bindNames Name.unsafeParseVar locallyBoundTypes names)) effectDecls0
|
||||
let allDecls0 :: Map v (DataDeclaration v a)
|
||||
allDecls0 = Map.union dataDecls (toDataDecl <$> effectDecls)
|
||||
hashDecls' :: [(v, Reference.Id, DataDeclaration v a)] <- Hashing.hashDataDecls allDecls0
|
||||
@ -145,8 +145,8 @@ environmentFor names dataDecls0 effectDecls0 = do
|
||||
dataDecls' = Map.difference allDecls effectDecls
|
||||
effectDecls' = second EffectDeclaration <$> Map.difference allDecls dataDecls
|
||||
-- ctor and effect terms
|
||||
ctors = foldMap (DD.Names.dataDeclToNames' Name.unsafeFromVar) (Map.toList dataDecls')
|
||||
effects = foldMap (DD.Names.effectDeclToNames' Name.unsafeFromVar) (Map.toList effectDecls')
|
||||
ctors = foldMap (DD.Names.dataDeclToNames' Name.unsafeParseVar) (Map.toList dataDecls')
|
||||
effects = foldMap (DD.Names.effectDeclToNames' Name.unsafeParseVar) (Map.toList effectDecls')
|
||||
names' = ctors <> effects
|
||||
overlaps =
|
||||
let w v dd (toDataDecl -> ed) = DupDataAndAbility v (DD.annotation dd) (DD.annotation ed)
|
||||
|
@ -5,7 +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.Syntax.Name qualified as Name (unsafeFromText)
|
||||
import Unison.Syntax.Name qualified as Name (unsafeParseText)
|
||||
import Unison.Util.Relation qualified as R
|
||||
|
||||
test :: Test ()
|
||||
@ -24,33 +24,33 @@ test =
|
||||
|
||||
testCompareSuffix :: [Test ()]
|
||||
testCompareSuffix =
|
||||
[ scope "[b.c a.b.c]" (expectEqual (compareSuffix "b.c" "a.b.c") EQ),
|
||||
scope "[a.b.c a.b.c]" (expectEqual (compareSuffix "a.b.c" "a.b.c") EQ),
|
||||
scope "[b.c a.b.b]" (expectEqual (compareSuffix "b.c" "a.b.b") LT),
|
||||
scope "[a.b.c b.c]" (expectEqual (compareSuffix "a.b.c" "b.c") LT),
|
||||
scope "[b.b a.b.c]" (expectEqual (compareSuffix "b.b" "a.b.c") GT)
|
||||
[ scope "[b.c a.b.c]" (expectEqual (compareSuffix (Name.unsafeParseText "b.c") (Name.unsafeParseText "a.b.c")) EQ),
|
||||
scope "[a.b.c a.b.c]" (expectEqual (compareSuffix (Name.unsafeParseText "a.b.c") (Name.unsafeParseText "a.b.c")) EQ),
|
||||
scope "[b.c a.b.b]" (expectEqual (compareSuffix (Name.unsafeParseText "b.c") (Name.unsafeParseText "a.b.b")) LT),
|
||||
scope "[a.b.c b.c]" (expectEqual (compareSuffix (Name.unsafeParseText "a.b.c") (Name.unsafeParseText "b.c")) LT),
|
||||
scope "[b.b a.b.c]" (expectEqual (compareSuffix (Name.unsafeParseText "b.b") (Name.unsafeParseText "a.b.c")) GT)
|
||||
]
|
||||
|
||||
testEndsWithReverseSegments :: [Test ()]
|
||||
testEndsWithReverseSegments =
|
||||
[ scope "a.b.c ends with []" (expectEqual True (endsWithReverseSegments "a.b.c" [])),
|
||||
[ 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 "a.b.c" ["c", "b"])),
|
||||
(expectEqual True (endsWithReverseSegments (Name.unsafeParseText "a.b.c") ["c", "b"])),
|
||||
scope
|
||||
"a.b.c doesn't end with [d]"
|
||||
(expectEqual False (endsWithReverseSegments "a.b.c" ["d"]))
|
||||
(expectEqual False (endsWithReverseSegments (Name.unsafeParseText "a.b.c") ["d"]))
|
||||
]
|
||||
|
||||
testEndsWithSegments :: [Test ()]
|
||||
testEndsWithSegments =
|
||||
[ scope "a.b.c ends with []" (expectEqual True (endsWithSegments "a.b.c" [])),
|
||||
[ 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 "a.b.c" ["b", "c"])),
|
||||
(expectEqual True (endsWithSegments (Name.unsafeParseText "a.b.c") ["b", "c"])),
|
||||
scope
|
||||
"a.b.c doesn't end with [d]"
|
||||
(expectEqual False (endsWithSegments "a.b.c" ["d"]))
|
||||
(expectEqual False (endsWithSegments (Name.unsafeParseText "a.b.c") ["d"]))
|
||||
]
|
||||
|
||||
testSegments :: [Test ()]
|
||||
@ -63,25 +63,25 @@ testSegments =
|
||||
|
||||
testSplitName :: [Test ()]
|
||||
testSplitName =
|
||||
[ scope "x" (expectEqual (splits "x") [([], "x")]),
|
||||
scope "A.x" (expectEqual (splits "A.x") [([], "A.x"), (["A"], "x")]),
|
||||
[ 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.B.x"
|
||||
( expectEqual
|
||||
(splits "A.B.x")
|
||||
[ ([], "A.B.x"),
|
||||
(["A"], "B.x"),
|
||||
(["A", "B"], "x")
|
||||
(splits (Name.unsafeParseText "A.B.x"))
|
||||
[ ([], Name.unsafeParseText "A.B.x"),
|
||||
(["A"], Name.unsafeParseText "B.x"),
|
||||
(["A", "B"], Name.unsafeParseText "x")
|
||||
]
|
||||
)
|
||||
]
|
||||
|
||||
testSuffixes :: [Test ()]
|
||||
testSuffixes =
|
||||
[ scope "one namespace" $ expectEqual (suffixes "bar") ["bar"],
|
||||
scope "two namespaces" $ expectEqual (suffixes "foo.bar") ["foo.bar", "bar"],
|
||||
scope "multiple namespaces" $ expectEqual (suffixes "foo.bar.baz") ["foo.bar.baz", "bar.baz", "baz"],
|
||||
scope "terms named `.`" $ expectEqual (suffixes "base.`.`") ["base.`.`", "`.`"]
|
||||
[ scope "one namespace" $ expectEqual (suffixes (Name.unsafeParseText "bar")) [Name.unsafeParseText "bar"],
|
||||
scope "two namespaces" $ expectEqual (suffixes (Name.unsafeParseText "foo.bar")) [Name.unsafeParseText "foo.bar", Name.unsafeParseText "bar"],
|
||||
scope "multiple namespaces" $ expectEqual (suffixes (Name.unsafeParseText "foo.bar.baz")) [Name.unsafeParseText "foo.bar.baz", Name.unsafeParseText "bar.baz", Name.unsafeParseText "baz"],
|
||||
scope "terms named `.`" $ expectEqual (suffixes (Name.unsafeParseText "base.`.`")) [Name.unsafeParseText "base.`.`", Name.unsafeParseText "`.`"]
|
||||
]
|
||||
|
||||
testSuffixSearch :: [Test ()]
|
||||
@ -97,7 +97,7 @@ testSuffixSearch =
|
||||
(n "a1.b.c", 5),
|
||||
(n ".`.`", 6)
|
||||
]
|
||||
n = Name.unsafeFromText
|
||||
n = Name.unsafeParseText
|
||||
expectEqual' ("." :| []) (Name.reverseSegments (n ".`.`"))
|
||||
expectEqual' ("." :| []) (Name.reverseSegments (n ".`.`"))
|
||||
|
||||
@ -119,23 +119,23 @@ testSuffixSearch =
|
||||
testUnsafeFromString :: [Test ()]
|
||||
testUnsafeFromString =
|
||||
[ scope "." do
|
||||
expectEqual' (isAbsolute "`.`") False
|
||||
expectEqual' (segments "`.`") ("." :| [])
|
||||
expectEqual' (isAbsolute (Name.unsafeParseText "`.`")) False
|
||||
expectEqual' (segments (Name.unsafeParseText "`.`")) ("." :| [])
|
||||
ok,
|
||||
scope ".`.`" do
|
||||
expectEqual' (isAbsolute ".`.`") True
|
||||
expectEqual' (segments ".`.`") ("." :| [])
|
||||
expectEqual' (isAbsolute (Name.unsafeParseText ".`.`")) True
|
||||
expectEqual' (segments (Name.unsafeParseText ".`.`")) ("." :| [])
|
||||
ok,
|
||||
scope "foo.bar" do
|
||||
expectEqual' (isAbsolute "foo.bar") False
|
||||
expectEqual' (segments "foo.bar") ("foo" :| ["bar"])
|
||||
expectEqual' (isAbsolute (Name.unsafeParseText "foo.bar")) False
|
||||
expectEqual' (segments (Name.unsafeParseText "foo.bar")) ("foo" :| ["bar"])
|
||||
ok,
|
||||
scope ".foo.bar" do
|
||||
expectEqual' (isAbsolute ".foo.bar") True
|
||||
expectEqual' (segments ".foo.bar") ("foo" :| ["bar"])
|
||||
expectEqual' (isAbsolute (Name.unsafeParseText ".foo.bar")) True
|
||||
expectEqual' (segments (Name.unsafeParseText ".foo.bar")) ("foo" :| ["bar"])
|
||||
ok,
|
||||
scope "foo.`.`" do
|
||||
expectEqual' (isAbsolute "foo.`.`") False
|
||||
expectEqual' (segments "foo.`.`") ("foo" :| ["."])
|
||||
expectEqual' (isAbsolute (Name.unsafeParseText "foo.`.`")) False
|
||||
expectEqual' (segments (Name.unsafeParseText "foo.`.`")) ("foo" :| ["."])
|
||||
ok
|
||||
]
|
||||
|
@ -176,9 +176,9 @@ import Unison.Share.Codeserver qualified as Codeserver
|
||||
import Unison.ShortHash qualified as SH
|
||||
import Unison.Sqlite qualified as Sqlite
|
||||
import Unison.Symbol (Symbol)
|
||||
import Unison.Syntax.HashQualified qualified as HQ (fromString, toString, toText, unsafeFromString)
|
||||
import Unison.Syntax.HashQualified qualified as HQ (toText, unsafeParseText, parseText)
|
||||
import Unison.Syntax.Lexer qualified as L
|
||||
import Unison.Syntax.Name qualified as Name (toString, toText, toVar, unsafeFromVar)
|
||||
import Unison.Syntax.Name qualified as Name (toText, toVar, unsafeParseVar)
|
||||
import Unison.Syntax.NameSegment qualified as NameSegment (toEscapedText)
|
||||
import Unison.Syntax.Parser qualified as Parser
|
||||
import Unison.Syntax.TermPrinter qualified as TP
|
||||
@ -800,7 +800,7 @@ loop e = do
|
||||
(seg, _) <- Map.toList (Branch._edits b)
|
||||
]
|
||||
Cli.respond $ ListOfPatches $ Set.fromList patches
|
||||
Cli.setNumberedArgs $ fmap Name.toString patches
|
||||
Cli.setNumberedArgs $ fmap (Text.unpack . Name.toText) patches
|
||||
FindShallowI pathArg -> do
|
||||
Cli.Env {codebase} <- ask
|
||||
|
||||
@ -903,8 +903,8 @@ loop e = do
|
||||
ambiguous t rs =
|
||||
Cli.returnEarly case t of
|
||||
HQ.HashOnly h -> HashAmbiguous h rs'
|
||||
(Path.parseHQSplit' . HQ.toString -> Right n) -> DeleteNameAmbiguous hqLength n rs' Set.empty
|
||||
_ -> BadName (HQ.toString t)
|
||||
(Path.parseHQSplit' . Text.unpack . HQ.toText -> Right n) -> DeleteNameAmbiguous hqLength n rs' Set.empty
|
||||
_ -> BadName (HQ.toText t)
|
||||
where
|
||||
rs' = Set.map Referent.Ref $ Set.fromList rs
|
||||
|
||||
@ -1044,9 +1044,9 @@ loop e = do
|
||||
hqLength <- Cli.runTransaction Codebase.hashLength
|
||||
uf <- Cli.expectLatestTypecheckedFile
|
||||
let datas, effects, terms :: [(Name, Reference.Id)]
|
||||
datas = [(Name.unsafeFromVar v, r) | (v, (r, _d)) <- Map.toList $ UF.dataDeclarationsId' uf]
|
||||
effects = [(Name.unsafeFromVar v, r) | (v, (r, _e)) <- Map.toList $ UF.effectDeclarationsId' uf]
|
||||
terms = [(Name.unsafeFromVar v, r) | (v, (_, r, _wk, _tm, _tp)) <- Map.toList $ UF.hashTermsId uf]
|
||||
datas = [(Name.unsafeParseVar v, r) | (v, (r, _d)) <- Map.toList $ UF.dataDeclarationsId' uf]
|
||||
effects = [(Name.unsafeParseVar v, r) | (v, (r, _e)) <- Map.toList $ UF.effectDeclarationsId' uf]
|
||||
terms = [(Name.unsafeParseVar v, r) | (v, (_, r, _wk, _tm, _tp)) <- Map.toList $ UF.hashTermsId uf]
|
||||
Cli.respond $ DumpUnisonFileHashes hqLength datas effects terms
|
||||
DebugTabCompletionI inputs -> do
|
||||
Cli.Env {authHTTPClient, codebase} <- ask
|
||||
@ -1314,7 +1314,7 @@ inputDescription input =
|
||||
scope <- p' scope0
|
||||
pure ("patch " <> p <> " " <> scope)
|
||||
UndoI {} -> pure "undo"
|
||||
ExecuteI s args -> pure ("execute " <> Text.unwords (fmap Text.pack (s : args)))
|
||||
ExecuteI s args -> pure ("execute " <> Text.unwords (s : fmap Text.pack args))
|
||||
IOTestI hq -> pure ("io.test " <> HQ.toText hq)
|
||||
IOTestAllI -> pure "io.test.all"
|
||||
UpdateBuiltinsI -> pure "builtins.update"
|
||||
@ -1322,8 +1322,8 @@ inputDescription input =
|
||||
MergeIOBuiltinsI -> pure "builtins.mergeio"
|
||||
MakeStandaloneI out nm -> pure ("compile " <> Text.pack out <> " " <> HQ.toText nm)
|
||||
ExecuteSchemeI nm args ->
|
||||
pure $ "run.native " <> Text.unwords (fmap Text.pack (nm : args))
|
||||
CompileSchemeI fi nm -> pure ("compile.native " <> HQ.toText nm <> " " <> Text.pack fi)
|
||||
pure $ "run.native " <> Text.unwords (nm : fmap Text.pack args)
|
||||
CompileSchemeI fi nm -> pure ("compile.native " <> HQ.toText nm <> " " <> fi)
|
||||
GenSchemeLibsI mdir ->
|
||||
pure $
|
||||
"compile.native.genlibs" <> Text.pack (maybe "" (" " ++) mdir)
|
||||
@ -1483,8 +1483,8 @@ handleFindI isVerbose fscope ws input = do
|
||||
searchResultsFor names (Set.toList matches) []
|
||||
|
||||
-- name query
|
||||
(map HQ.unsafeFromString -> qs) -> do
|
||||
let srs = searchBranchScored names fuzzyNameDistance qs
|
||||
qs -> do
|
||||
let srs = searchBranchScored names fuzzyNameDistance (map (HQ.unsafeParseText . Text.pack) qs)
|
||||
pure $ uniqueBy SR.toReferent srs
|
||||
let respondResults results = do
|
||||
Cli.setNumberedArgs $ fmap searchResultToHQString results
|
||||
@ -1812,13 +1812,13 @@ confirmedCommand i = do
|
||||
-- | restores the full hash to these search results, for _numberedArgs purposes
|
||||
searchResultToHQString :: SearchResult -> String
|
||||
searchResultToHQString = \case
|
||||
SR.Tm' n r _ -> HQ.toString $ HQ.requalify n r
|
||||
SR.Tp' n r _ -> HQ.toString $ HQ.requalify n (Referent.Ref r)
|
||||
SR.Tm' n r _ -> Text.unpack $ HQ.toText $ HQ.requalify n r
|
||||
SR.Tp' n r _ -> Text.unpack $ HQ.toText $ HQ.requalify n (Referent.Ref r)
|
||||
_ -> error "impossible match failure"
|
||||
|
||||
-- Return a list of definitions whose names fuzzy match the given queries.
|
||||
fuzzyNameDistance :: Name -> Name -> Maybe Int
|
||||
fuzzyNameDistance (Name.toString -> q) (Name.toString -> n) =
|
||||
fuzzyNameDistance (Name.toText -> q) (Name.toText -> n) =
|
||||
Find.simpleFuzzyScore q n
|
||||
|
||||
-- return `name` and `name.<everything>...`
|
||||
@ -1969,20 +1969,17 @@ doGenerateSchemeBoot force mppe mdir = do
|
||||
gen ppe saveWrap cwrapf dirTm compoundWrapName
|
||||
where
|
||||
a = External
|
||||
hq nm
|
||||
| Just hqn <- HQ.fromString nm = hqn
|
||||
| otherwise = error $ "internal error: cannot hash qualify: " ++ nm
|
||||
|
||||
sbName = hq ".unison.internal.compiler.scheme.saveBaseFile"
|
||||
swName = hq ".unison.internal.compiler.scheme.saveWrapperFile"
|
||||
sdName = hq ".unison.internal.compiler.scheme.saveDataInfoFile"
|
||||
dinfoName = hq ".unison.internal.compiler.scheme.dataInfos"
|
||||
bootName = hq ".unison.internal.compiler.scheme.bootSpec"
|
||||
builtinName = hq ".unison.internal.compiler.scheme.builtinSpec"
|
||||
sbName = HQ.unsafeParseText ".unison.internal.compiler.scheme.saveBaseFile"
|
||||
swName = HQ.unsafeParseText ".unison.internal.compiler.scheme.saveWrapperFile"
|
||||
sdName = HQ.unsafeParseText ".unison.internal.compiler.scheme.saveDataInfoFile"
|
||||
dinfoName = HQ.unsafeParseText ".unison.internal.compiler.scheme.dataInfos"
|
||||
bootName = HQ.unsafeParseText ".unison.internal.compiler.scheme.bootSpec"
|
||||
builtinName = HQ.unsafeParseText ".unison.internal.compiler.scheme.builtinSpec"
|
||||
simpleWrapName =
|
||||
hq ".unison.internal.compiler.scheme.simpleWrapperSpec"
|
||||
HQ.unsafeParseText ".unison.internal.compiler.scheme.simpleWrapperSpec"
|
||||
compoundWrapName =
|
||||
hq ".unison.internal.compiler.scheme.compoundWrapperSpec"
|
||||
HQ.unsafeParseText ".unison.internal.compiler.scheme.compoundWrapperSpec"
|
||||
|
||||
gen ppe save file dir nm =
|
||||
liftIO (doesFileExist file) >>= \b -> when (not b || force) do
|
||||
@ -2004,10 +2001,10 @@ typecheckAndEval ppe tm = do
|
||||
Result.Result notes Nothing -> do
|
||||
currentPath <- Cli.getCurrentPath
|
||||
let tes = [err | Result.TypeError err <- toList notes]
|
||||
Cli.returnEarly (TypeErrors currentPath (Text.pack rendered) ppe tes)
|
||||
Cli.returnEarly (TypeErrors currentPath rendered ppe tes)
|
||||
where
|
||||
a = External
|
||||
rendered = P.toPlainUnbroken $ TP.pretty ppe tm
|
||||
rendered = Text.pack (P.toPlainUnbroken $ TP.pretty ppe tm)
|
||||
|
||||
ensureSchemeExists :: Cli ()
|
||||
ensureSchemeExists =
|
||||
@ -2051,16 +2048,16 @@ runScheme file args = do
|
||||
unless success $
|
||||
Cli.returnEarly (PrintMessage "Scheme evaluation failed.")
|
||||
|
||||
buildScheme :: String -> String -> Cli ()
|
||||
buildScheme :: Text -> String -> Cli ()
|
||||
buildScheme main file = do
|
||||
ensureSchemeExists
|
||||
statDir <- getSchemeStaticLibDir
|
||||
genDir <- getSchemeGenLibDir
|
||||
buildRacket genDir statDir main file
|
||||
|
||||
buildRacket :: String -> String -> String -> String -> Cli ()
|
||||
buildRacket :: String -> String -> Text -> String -> Cli ()
|
||||
buildRacket genDir statDir main file =
|
||||
let args = ["-l", "raco", "--", "exe", "-o", main, file]
|
||||
let args = ["-l", "raco", "--", "exe", "-o", Text.unpack main, file]
|
||||
opts = racketOpts genDir statDir args
|
||||
in void . liftIO $
|
||||
catch
|
||||
@ -2084,25 +2081,25 @@ doCompile native output main = do
|
||||
)
|
||||
(Cli.returnEarly . EvaluationFailure)
|
||||
|
||||
doRunAsScheme :: String -> [String] -> Cli ()
|
||||
doRunAsScheme main0 args = case HQ.fromString main0 of
|
||||
doRunAsScheme :: Text -> [String] -> Cli ()
|
||||
doRunAsScheme main0 args = case HQ.parseText main0 of
|
||||
Just main -> do
|
||||
fullpath <- generateSchemeFile True main0 main
|
||||
runScheme fullpath args
|
||||
Nothing -> Cli.respond $ BadName main0
|
||||
|
||||
doCompileScheme :: String -> HQ.HashQualified Name -> Cli ()
|
||||
doCompileScheme :: Text -> HQ.HashQualified Name -> Cli ()
|
||||
doCompileScheme out main =
|
||||
generateSchemeFile True out main >>= buildScheme out
|
||||
|
||||
generateSchemeFile :: Bool -> String -> HQ.HashQualified Name -> Cli String
|
||||
generateSchemeFile :: Bool -> Text -> HQ.HashQualified Name -> Cli String
|
||||
generateSchemeFile exec out main = do
|
||||
(comp, ppe) <- resolveMainRef main
|
||||
ensureCompilerExists
|
||||
doGenerateSchemeBoot False (Just ppe) Nothing
|
||||
cacheDir <- getCacheDir
|
||||
liftIO $ createDirectoryIfMissing True (cacheDir </> "scheme-tmp")
|
||||
let scratch = out ++ ".scm"
|
||||
let scratch = Text.unpack out ++ ".scm"
|
||||
fullpath = cacheDir </> "scheme-tmp" </> scratch
|
||||
output = Text.pack fullpath
|
||||
sscm <- Term.ref a <$> resolveTermRef saveNm
|
||||
@ -2117,12 +2114,9 @@ generateSchemeFile exec out main = do
|
||||
pure fullpath
|
||||
where
|
||||
a = External
|
||||
hq nm
|
||||
| Just hqn <- HQ.fromString nm = hqn
|
||||
| otherwise = error $ "internal error: cannot hash qualify: " ++ nm
|
||||
|
||||
saveNm = hq ".unison.internal.compiler.saveScheme"
|
||||
filePathNm = hq "FilePath.FilePath"
|
||||
saveNm = HQ.unsafeParseText ".unison.internal.compiler.saveScheme"
|
||||
filePathNm = HQ.unsafeParseText "FilePath.FilePath"
|
||||
|
||||
delete ::
|
||||
Input ->
|
||||
@ -2275,7 +2269,7 @@ displayI outputLoc hq = do
|
||||
let suffixifiedPPE = PPE.suffixifiedPPE pped
|
||||
let bias = maybeToList $ HQ.toName hq
|
||||
latestTypecheckedFile <- Cli.getLatestTypecheckedFile
|
||||
case addWatch (HQ.toString hq) latestTypecheckedFile of
|
||||
case addWatch (Text.unpack (HQ.toText hq)) latestTypecheckedFile of
|
||||
Nothing -> do
|
||||
let results = Names.lookupHQTerm Names.IncludeSuffixes hq names
|
||||
ref <-
|
||||
@ -2293,7 +2287,7 @@ displayI outputLoc hq = do
|
||||
let suffixifiedFilePPE = PPE.biasTo bias $ PPE.suffixifiedPPE filePPED
|
||||
(_, watches) <- evalUnisonFile Sandboxed suffixifiedFilePPE unisonFile []
|
||||
(_, _, _, _, tm, _) <-
|
||||
Map.lookup toDisplay watches & onNothing (error $ "Evaluation dropped a watch expression: " <> HQ.toString hq)
|
||||
Map.lookup toDisplay watches & onNothing (error $ "Evaluation dropped a watch expression: " <> Text.unpack (HQ.toText hq))
|
||||
let ns = UF.addNamesFromTypeCheckedUnisonFile unisonFile names
|
||||
doDisplay outputLoc ns tm
|
||||
|
||||
@ -2312,7 +2306,7 @@ docsI src = do
|
||||
in Name.convert hq'
|
||||
|
||||
dotDoc :: HQ.HashQualified Name
|
||||
dotDoc = hq <&> \n -> Name.joinDot n "doc"
|
||||
dotDoc = hq <&> \n -> Name.joinDot n (Name.fromSegment "doc")
|
||||
|
||||
findInScratchfileByName :: Cli ()
|
||||
findInScratchfileByName = do
|
||||
@ -2371,7 +2365,7 @@ parseType input src = do
|
||||
Parsers.parseType (Text.unpack (fst lexed)) parsingEnv & onLeftM \err ->
|
||||
Cli.returnEarly (TypeParseError src err)
|
||||
|
||||
Type.bindNames Name.unsafeFromVar mempty names (Type.generalizeLowercase mempty typ) & onLeft \errs ->
|
||||
Type.bindNames Name.unsafeParseVar mempty names (Type.generalizeLowercase mempty typ) & onLeft \errs ->
|
||||
Cli.returnEarly (ParseResolutionFailures src (toList errs))
|
||||
|
||||
-- Adds a watch expression of the given name to the file, if
|
||||
|
@ -65,7 +65,7 @@ formatFile makePPEDForFile formattingWidth currentPath inputParsedFile inputType
|
||||
)
|
||||
& Map.filter (\(tldAnn, _, _) -> isInFormatRange tldAnn)
|
||||
& itraverse \sym (tldAnn, ref, decl) -> do
|
||||
symName <- hoistMaybe (Name.fromVar sym)
|
||||
symName <- hoistMaybe (Name.parseVar sym)
|
||||
let declNameSegments = NEL.appendr (Path.toList (Path.unabsolute currentPath)) (Name.segments symName)
|
||||
let declName = Name.fromSegments declNameSegments
|
||||
let hqName = HQ.fromName symName
|
||||
@ -84,7 +84,7 @@ formatFile makePPEDForFile formattingWidth currentPath inputParsedFile inputType
|
||||
(FileSummary.termsBySymbol fileSummary)
|
||||
& Map.filter (\(tldAnn, _, trm, _) -> shouldFormatTerm tldAnn trm)
|
||||
& itraverse \sym (tldAnn, mayRefId, trm, _typ) -> do
|
||||
symName <- hoistMaybe (Name.fromVar sym)
|
||||
symName <- hoistMaybe (Name.parseVar sym)
|
||||
let defNameSegments = NEL.appendr (Path.toList (Path.unabsolute currentPath)) (Name.segments symName)
|
||||
let defName = Name.fromSegments defNameSegments
|
||||
let hqName = HQ.NameOnly symName
|
||||
|
@ -40,7 +40,7 @@ import Unison.UnisonFile qualified as UF
|
||||
import Unison.UnisonFile.Names qualified as UF
|
||||
import Unison.Var qualified as Var
|
||||
|
||||
handleRun :: Bool -> String -> [String] -> Cli ()
|
||||
handleRun :: Bool -> Text -> [String] -> Cli ()
|
||||
handleRun native main args = do
|
||||
(unisonFile, mainResType) <- do
|
||||
(sym, term, typ, otyp) <- getTerm main
|
||||
@ -75,7 +75,7 @@ data GetTermResult
|
||||
-- | Look up runnable term with the given name in the codebase or
|
||||
-- latest typechecked unison file. Return its symbol, term, type, and
|
||||
-- the type of the evaluated term.
|
||||
getTerm :: String -> Cli (Symbol, Term Symbol Ann, Type Symbol Ann, Type Symbol Ann)
|
||||
getTerm :: Text -> Cli (Symbol, Term Symbol Ann, Type Symbol Ann, Type Symbol Ann)
|
||||
getTerm main =
|
||||
getTerm' main >>= \case
|
||||
NoTermWithThatName -> do
|
||||
@ -90,7 +90,7 @@ getTerm main =
|
||||
Cli.returnEarly $ Output.BadMainFunction "run" main ty suffixifiedPPE [mainType]
|
||||
GetTermSuccess x -> pure x
|
||||
|
||||
getTerm' :: String -> Cli GetTermResult
|
||||
getTerm' :: Text -> Cli GetTermResult
|
||||
getTerm' mainName =
|
||||
let getFromCodebase = do
|
||||
Cli.Env {codebase, runtime} <- ask
|
||||
@ -108,7 +108,7 @@ getTerm' mainName =
|
||||
pure (GetTermSuccess (v, tm, typ, otyp))
|
||||
getFromFile uf = do
|
||||
let components = join $ UF.topLevelComponents uf
|
||||
let mainComponent = filter ((\v -> Var.nameStr v == mainName) . view _1) components
|
||||
let mainComponent = filter ((\v -> Var.name v == mainName) . view _1) components
|
||||
case mainComponent of
|
||||
[(v, _, tm, ty)] ->
|
||||
checkType ty \otyp ->
|
||||
|
@ -31,7 +31,7 @@ import Unison.PrettyPrintEnvDecl qualified as PPED
|
||||
import Unison.Reference (Reference)
|
||||
import Unison.Referent (Referent, pattern Con, pattern Ref)
|
||||
import Unison.Symbol (Symbol)
|
||||
import Unison.Syntax.HashQualified qualified as HQ (toString)
|
||||
import Unison.Syntax.HashQualified qualified as HQ (toText)
|
||||
import Unison.Type (Type)
|
||||
import Unison.Typechecker qualified as Typechecker
|
||||
|
||||
@ -118,7 +118,7 @@ resolveMainRef main = do
|
||||
pped <- Cli.prettyPrintEnvDeclFromNames names
|
||||
let suffixifiedPPE = PPED.suffixifiedPPE pped
|
||||
let mainType = Runtime.mainType runtime
|
||||
smain = HQ.toString main
|
||||
smain = HQ.toText main
|
||||
lookupTermRefWithType codebase main >>= \case
|
||||
[(rf, ty)]
|
||||
| Typechecker.fitsScheme ty mainType -> pure (rf, suffixifiedPPE)
|
||||
|
@ -134,7 +134,7 @@ handleIOTest main = do
|
||||
(fails, oks) <-
|
||||
refs & foldMapM \(ref, typ) -> do
|
||||
when (not $ isIOTest typ) do
|
||||
Cli.returnEarly (BadMainFunction "io.test" (HQ.toString main) typ suffixifiedPPE (Foldable.toList $ Runtime.ioTestTypes runtime))
|
||||
Cli.returnEarly (BadMainFunction "io.test" (HQ.toText main) typ suffixifiedPPE (Foldable.toList $ Runtime.ioTestTypes runtime))
|
||||
runIOTest suffixifiedPPE ref
|
||||
Cli.respond $ TestResults Output.NewlyComputed suffixifiedPPE True True oks fails
|
||||
|
||||
@ -180,7 +180,7 @@ resolveHQNames parseNames hqNames =
|
||||
getNameFromScratchFile :: HQ.HashQualified Name -> MaybeT Cli (Reference.Id, Type.Type Symbol Ann)
|
||||
getNameFromScratchFile main = do
|
||||
typecheckedFile <- MaybeT Cli.getLatestTypecheckedFile
|
||||
mainName <- hoistMaybe $ Name.fromText (HQ.toText main)
|
||||
mainName <- hoistMaybe $ Name.parseText (HQ.toText main)
|
||||
(_, ref, _wk, _term, typ) <- hoistMaybe $ Map.lookup (Name.toVar mainName) (UF.hashTermsId typecheckedFile)
|
||||
pure (ref, typ)
|
||||
|
||||
|
@ -53,7 +53,7 @@ import Unison.Referent qualified as Referent
|
||||
import Unison.Result qualified as Result
|
||||
import Unison.Sqlite qualified as Sqlite
|
||||
import Unison.Symbol (Symbol)
|
||||
import Unison.Syntax.Name qualified as Name (toVar, unsafeFromVar)
|
||||
import Unison.Syntax.Name qualified as Name (toVar, unsafeParseVar)
|
||||
import Unison.Term (Term)
|
||||
import Unison.Term qualified as Term
|
||||
import Unison.Type (Type)
|
||||
@ -90,7 +90,7 @@ handleUpdate input optionalPatch requestedNames = do
|
||||
typeEdits :: [(Name, Reference, Reference)]
|
||||
typeEdits = do
|
||||
v <- Set.toList (SC.types (updates sr))
|
||||
let n = Name.unsafeFromVar v
|
||||
let n = Name.unsafeParseVar v
|
||||
let oldRefs0 = Names.typesNamed currentCodebaseNames n
|
||||
let newRefs = Names.typesNamed fileNames n
|
||||
case (,) <$> NESet.nonEmptySet oldRefs0 <*> Set.asSingleton newRefs of
|
||||
@ -105,7 +105,7 @@ handleUpdate input optionalPatch requestedNames = do
|
||||
termEdits :: [(Name, Reference, Reference)]
|
||||
termEdits = do
|
||||
v <- Set.toList (SC.terms (updates sr))
|
||||
let n = Name.unsafeFromVar v
|
||||
let n = Name.unsafeParseVar v
|
||||
let oldRefs0 = Names.refTermsNamed currentCodebaseNames n
|
||||
let newRefs = Names.refTermsNamed fileNames n
|
||||
case (,) <$> NESet.nonEmptySet oldRefs0 <*> Set.asSingleton newRefs of
|
||||
@ -215,7 +215,7 @@ getSlurpResultForUpdate requestedNames slurpCheckNames = do
|
||||
Set.map Name.toVar . Names.namesForReferent slurpCheckNames . Referent.fromTermReferenceId
|
||||
|
||||
let nameToTermRefs :: Symbol -> Set TermReference
|
||||
nameToTermRefs = Names.refTermsNamed slurpCheckNames . Name.unsafeFromVar
|
||||
nameToTermRefs = Names.refTermsNamed slurpCheckNames . Name.unsafeParseVar
|
||||
|
||||
slurp1 <- do
|
||||
Cli.Env {codebase} <- ask
|
||||
@ -593,10 +593,10 @@ doSlurpAdds slurp uf = Branch.batchUpdates (typeActions <> termActions)
|
||||
SC.terms slurp <> UF.constructorsForDecls (SC.types slurp) uf
|
||||
names = UF.typecheckedToNames uf
|
||||
doTerm :: Symbol -> (Path, Branch0 m -> Branch0 m)
|
||||
doTerm v = case toList (Names.termsNamed names (Name.unsafeFromVar v)) of
|
||||
doTerm v = case toList (Names.termsNamed names (Name.unsafeParseVar v)) of
|
||||
[] -> errorMissingVar v
|
||||
[r] ->
|
||||
let split = Path.splitFromName (Name.unsafeFromVar v)
|
||||
let split = Path.splitFromName (Name.unsafeParseVar v)
|
||||
in BranchUtil.makeAddTermName split r
|
||||
wha ->
|
||||
error $
|
||||
@ -605,10 +605,10 @@ doSlurpAdds slurp uf = Branch.batchUpdates (typeActions <> termActions)
|
||||
<> ": "
|
||||
<> show wha
|
||||
doType :: Symbol -> (Path, Branch0 m -> Branch0 m)
|
||||
doType v = case toList (Names.typesNamed names (Name.unsafeFromVar v)) of
|
||||
doType v = case toList (Names.typesNamed names (Name.unsafeParseVar v)) of
|
||||
[] -> errorMissingVar v
|
||||
[r] ->
|
||||
let split = Path.splitFromName (Name.unsafeFromVar v)
|
||||
let split = Path.splitFromName (Name.unsafeParseVar v)
|
||||
in BranchUtil.makeAddTypeName split r
|
||||
wha ->
|
||||
error $
|
||||
|
@ -225,7 +225,7 @@ typecheckedUnisonFileToBranchUpdates abort getConstructors tuf = do
|
||||
makeDeclUpdates (symbol, (typeRefId, decl)) = do
|
||||
-- some decls will be deleted, we want to delete their
|
||||
-- constructors as well
|
||||
deleteConstructorActions <- case map (BranchUtil.makeAnnihilateTermName . Path.splitFromName) <$> getConstructors (Name.unsafeFromVar symbol) of
|
||||
deleteConstructorActions <- case map (BranchUtil.makeAnnihilateTermName . Path.splitFromName) <$> getConstructors (Name.unsafeParseVar symbol) of
|
||||
Left err -> abort err
|
||||
Right actions -> pure actions
|
||||
let deleteTypeAction = BranchUtil.makeAnnihilateTypeName split
|
||||
@ -258,7 +258,7 @@ typecheckedUnisonFileToBranchUpdates abort getConstructors tuf = do
|
||||
else []
|
||||
|
||||
splitVar :: Symbol -> Path.Split
|
||||
splitVar = Path.splitFromName . Name.unsafeFromVar
|
||||
splitVar = Path.splitFromName . Name.unsafeParseVar
|
||||
|
||||
-- | get references from `names` that have the same names as in `defns`
|
||||
-- For constructors, we get the type reference.
|
||||
@ -411,14 +411,14 @@ getTermAndDeclNames tuf =
|
||||
UF.hashTermsId tuf
|
||||
& Map.foldMapWithKey \var (_, _, wk, _, _) ->
|
||||
if WK.watchKindShouldBeStoredInDatabase wk
|
||||
then Set.singleton (Name.unsafeFromVar var)
|
||||
then Set.singleton (Name.unsafeParseVar var)
|
||||
else Set.empty
|
||||
effects = keysToNames $ UF.effectDeclarationsId' tuf
|
||||
datas = keysToNames $ UF.dataDeclarationsId' tuf
|
||||
effectCtors = foldMap ctorsToNames $ fmap (Decl.toDataDecl . snd) $ UF.effectDeclarationsId' tuf
|
||||
dataCtors = foldMap ctorsToNames $ fmap snd $ UF.dataDeclarationsId' tuf
|
||||
keysToNames = Set.map Name.unsafeFromVar . Map.keysSet
|
||||
ctorsToNames = Set.fromList . map Name.unsafeFromVar . Decl.constructorVars
|
||||
keysToNames = Set.map Name.unsafeParseVar . Map.keysSet
|
||||
ctorsToNames = Set.fromList . map Name.unsafeParseVar . Decl.constructorVars
|
||||
|
||||
-- | Given a namespace and a set of dependencies, return the subset of the namespace that consists of only the
|
||||
-- (transitive) dependents of the dependencies.
|
||||
|
@ -172,7 +172,7 @@ data Input
|
||||
-- Second `Maybe Int` is cap on diff elements shown, if any
|
||||
HistoryI (Maybe Int) (Maybe Int) BranchId
|
||||
| -- execute an IO thunk with args
|
||||
ExecuteI String [String]
|
||||
ExecuteI Text [String]
|
||||
| -- save the result of a previous Execute
|
||||
SaveExecuteResultI Name
|
||||
| -- execute an IO [Result]
|
||||
@ -182,9 +182,9 @@ data Input
|
||||
| -- make a standalone binary file
|
||||
MakeStandaloneI String (HQ.HashQualified Name)
|
||||
| -- execute an IO thunk using scheme
|
||||
ExecuteSchemeI String [String]
|
||||
ExecuteSchemeI Text [String]
|
||||
| -- compile to a scheme file
|
||||
CompileSchemeI String (HQ.HashQualified Name)
|
||||
CompileSchemeI Text (HQ.HashQualified Name)
|
||||
| -- generate scheme libraries, optional target directory
|
||||
GenSchemeLibsI (Maybe String)
|
||||
| -- fetch scheme compiler from a given username and branch
|
||||
|
@ -153,13 +153,13 @@ data Output
|
||||
| InvalidSourceName String
|
||||
| SourceLoadFailed String
|
||||
| -- No main function, the [Type v Ann] are the allowed types
|
||||
NoMainFunction String PPE.PrettyPrintEnv [Type Symbol Ann]
|
||||
NoMainFunction Text PPE.PrettyPrintEnv [Type Symbol Ann]
|
||||
| -- | Function found, but has improper type
|
||||
-- Note: the constructor name is misleading here; we weren't necessarily looking for a "main".
|
||||
BadMainFunction
|
||||
String
|
||||
Text
|
||||
-- ^ what we were trying to do (e.g. "run", "io.test")
|
||||
String
|
||||
Text
|
||||
-- ^ name of function
|
||||
(Type Symbol Ann)
|
||||
-- ^ bad type of function
|
||||
@ -305,7 +305,7 @@ data Output
|
||||
| DumpNumberedArgs NumberedArgs
|
||||
| DumpBitBooster CausalHash (Map CausalHash [CausalHash])
|
||||
| DumpUnisonFileHashes Int [(Name, Reference.Id)] [(Name, Reference.Id)] [(Name, Reference.Id)]
|
||||
| BadName String
|
||||
| BadName Text
|
||||
| CouldntLoadBranch CausalHash
|
||||
| HelpMessage Input.InputPattern
|
||||
| NamespaceEmpty (NonEmpty AbsBranchId)
|
||||
|
@ -23,7 +23,7 @@ import Unison.Referent (Referent)
|
||||
import Unison.Referent qualified as Referent
|
||||
import Unison.Referent' qualified as Referent
|
||||
import Unison.Symbol (Symbol)
|
||||
import Unison.Syntax.Name qualified as Name (toText, unsafeFromVar)
|
||||
import Unison.Syntax.Name qualified as Name (toText, unsafeParseVar)
|
||||
import Unison.UnisonFile qualified as UF
|
||||
import Unison.UnisonFile.Names qualified as UF
|
||||
import Unison.Util.Map qualified as Map
|
||||
@ -159,7 +159,7 @@ computeNamesWithDeprecations uf unalteredCodebaseNames involvedVars = \case
|
||||
& filter (\(typeV, _) -> Set.member (TypeVar typeV) involvedVars)
|
||||
& concatMap (\(_typeV, (_refId, decl)) -> DD.constructors' decl)
|
||||
& fmap
|
||||
( \(_ann, v, _typ) -> Name.unsafeFromVar v
|
||||
( \(_ann, v, _typ) -> Name.unsafeParseVar v
|
||||
)
|
||||
& Set.fromList
|
||||
|
||||
@ -170,7 +170,7 @@ computeNamesWithDeprecations uf unalteredCodebaseNames involvedVars = \case
|
||||
let effectNames = Map.keys (UF.effectDeclarationsId' uf)
|
||||
typeName <- declNames <> effectNames
|
||||
when (not . null $ involvedVars) (guard (TypeVar typeName `Set.member` involvedVars))
|
||||
pure $ Names.typesNamed unalteredCodebaseNames (Name.unsafeFromVar typeName)
|
||||
pure $ Names.typesNamed unalteredCodebaseNames (Name.unsafeParseVar typeName)
|
||||
existingConstructorsFromEditedTypes = Set.fromList $ do
|
||||
-- List Monad
|
||||
ref <- Set.toList oldRefsForEditedTypes
|
||||
@ -194,8 +194,8 @@ computeSelfStatuses vars varReferences codebaseNames =
|
||||
Just r -> r
|
||||
Nothing -> error $ "Expected LabeledDependency in map for var: " <> show tv
|
||||
v = untagged tv
|
||||
existingTypesAtName = Names.typesNamed codebaseNames (Name.unsafeFromVar v)
|
||||
existingTermsOrCtorsAtName = Names.termsNamed codebaseNames (Name.unsafeFromVar v)
|
||||
existingTypesAtName = Names.typesNamed codebaseNames (Name.unsafeParseVar v)
|
||||
existingTermsOrCtorsAtName = Names.termsNamed codebaseNames (Name.unsafeParseVar v)
|
||||
in case ld of
|
||||
LD.TypeReference _typeRef ->
|
||||
case Set.toList existingTypesAtName of
|
||||
|
@ -379,7 +379,7 @@ absolutePath = do
|
||||
|
||||
nameSegment :: P NameSegment
|
||||
nameSegment =
|
||||
NameSegment.unsafeFromText . Text.pack
|
||||
NameSegment.unsafeParseText . Text.pack
|
||||
<$> ( (:)
|
||||
<$> P.satisfy Unison.Syntax.Lexer.wordyIdStartChar
|
||||
<*> P.many (P.satisfy Unison.Syntax.Lexer.wordyIdChar)
|
||||
|
@ -149,7 +149,7 @@ completeWithinNamespace compTypes query currentPath = do
|
||||
currentBranchSuggestions <- do
|
||||
nib <- namesInBranch shortHashLen b
|
||||
nib
|
||||
& fmap (\(isFinished, match) -> (isFinished, Text.unpack . Path.toText' $ queryPathPrefix Lens.:> NameSegment.unsafeFromText match))
|
||||
& fmap (\(isFinished, match) -> (isFinished, Text.unpack . Path.toText' $ queryPathPrefix Lens.:> NameSegment.unsafeParseText match))
|
||||
& filter (\(_isFinished, match) -> List.isPrefixOf query match)
|
||||
& fmap (\(isFinished, match) -> prettyCompletionWithQueryPrefix isFinished query match)
|
||||
& pure
|
||||
@ -169,7 +169,7 @@ completeWithinNamespace compTypes query currentPath = do
|
||||
getChildSuggestions shortHashLen b
|
||||
| Text.null querySuffix = pure []
|
||||
| otherwise =
|
||||
case NameSegment.fromText querySuffix of
|
||||
case NameSegment.parseText querySuffix of
|
||||
Left _ -> pure []
|
||||
Right suffix -> do
|
||||
nonEmptyChildren <- V2Branch.nonEmptyChildren b
|
||||
@ -180,7 +180,7 @@ completeWithinNamespace compTypes query currentPath = do
|
||||
nib <- namesInBranch shortHashLen childBranch
|
||||
nib
|
||||
& fmap
|
||||
( \(isFinished, match) -> (isFinished, Text.unpack . Path.toText' $ queryPathPrefix Lens.:> suffix Lens.:> NameSegment.unsafeFromText match)
|
||||
( \(isFinished, match) -> (isFinished, Text.unpack . Path.toText' $ queryPathPrefix Lens.:> suffix Lens.:> NameSegment.unsafeParseText match)
|
||||
)
|
||||
& filter (\(_isFinished, match) -> List.isPrefixOf query match)
|
||||
& fmap (\(isFinished, match) -> prettyCompletionWithQueryPrefix isFinished query match)
|
||||
@ -382,7 +382,7 @@ shareCompletion completionTypes authHTTPClient str =
|
||||
( \(_, name) ->
|
||||
let queryPath = userHandle : Path.toList path
|
||||
result =
|
||||
(queryPath ++ [NameSegment.unsafeFromText name])
|
||||
(queryPath ++ [NameSegment.unsafeParseText name])
|
||||
& List.NonEmpty.fromList
|
||||
& Name.fromSegments
|
||||
& Name.toText
|
||||
|
@ -59,8 +59,8 @@ import Unison.NameSegment (NameSegment)
|
||||
import Unison.Prelude
|
||||
import Unison.Project (ProjectAndBranch (..), ProjectAndBranchNames (..), ProjectBranchName, ProjectBranchNameOrLatestRelease (..), ProjectBranchSpecifier (..), ProjectName, Semver)
|
||||
import Unison.Project.Util (ProjectContext (..), projectContextFromPath)
|
||||
import Unison.Syntax.HashQualified qualified as HQ (fromString)
|
||||
import Unison.Syntax.Name qualified as Name (fromText, unsafeFromString)
|
||||
import Unison.Syntax.HashQualified qualified as HQ (parseText)
|
||||
import Unison.Syntax.Name qualified as Name (parseText, unsafeParseText)
|
||||
import Unison.Syntax.NameSegment qualified as NameSegment (renderParseErr, segmentP)
|
||||
import Unison.Util.ColorText qualified as CT
|
||||
import Unison.Util.Monoid (intercalateMap)
|
||||
@ -213,7 +213,7 @@ add =
|
||||
( "`add` adds to the codebase all the definitions from the most recently "
|
||||
<> "typechecked file."
|
||||
)
|
||||
$ \ws -> pure $ Input.AddI (Set.fromList $ map Name.unsafeFromString ws)
|
||||
\ws -> pure $ Input.AddI (Set.fromList $ map (Name.unsafeParseText . Text.pack) ws)
|
||||
|
||||
previewAdd :: InputPattern
|
||||
previewAdd =
|
||||
@ -227,7 +227,7 @@ previewAdd =
|
||||
<> "results. Use `load` to reparse & typecheck the file if the context "
|
||||
<> "has changed."
|
||||
)
|
||||
$ \ws -> pure $ Input.PreviewAddI (Set.fromList $ map Name.unsafeFromString ws)
|
||||
\ws -> pure $ Input.PreviewAddI (Set.fromList $ map (Name.unsafeParseText . Text.pack) ws)
|
||||
|
||||
update :: InputPattern
|
||||
update =
|
||||
@ -279,7 +279,7 @@ updateOldNoPatch =
|
||||
pure $
|
||||
Input.UpdateI
|
||||
Input.NoPatch
|
||||
(Set.fromList $ map Name.unsafeFromString ws)
|
||||
(Set.fromList $ map (Name.unsafeParseText . Text.pack) ws)
|
||||
)
|
||||
|
||||
updateOld :: InputPattern
|
||||
@ -320,7 +320,7 @@ updateOld =
|
||||
pure $
|
||||
Input.UpdateI
|
||||
(Input.UsePatch patch)
|
||||
(Set.fromList $ map Name.unsafeFromString ws)
|
||||
(Set.fromList $ map (Name.unsafeParseText . Text.pack) ws)
|
||||
[] -> Right $ Input.UpdateI Input.DefaultPatch mempty
|
||||
|
||||
previewUpdate :: InputPattern
|
||||
@ -335,7 +335,7 @@ previewUpdate =
|
||||
<> "typechecking results. Use `load` to reparse & typecheck the file if "
|
||||
<> "the context has changed."
|
||||
)
|
||||
\ws -> pure $ Input.PreviewUpdateI (Set.fromList $ map Name.unsafeFromString ws)
|
||||
\ws -> pure $ Input.PreviewUpdateI (Set.fromList $ map (Name.unsafeParseText . Text.pack) ws)
|
||||
|
||||
patch :: InputPattern
|
||||
patch =
|
||||
@ -1869,7 +1869,7 @@ editNamespace =
|
||||
[ "`edit.namespace` will load all terms and types contained within the current namespace into your scratch file. This includes definitions in namespaces, but excludes libraries.",
|
||||
"`edit.namespace ns1 ns2 ...` loads the terms and types contained within the provided namespaces."
|
||||
],
|
||||
parse = Right . Input.EditNamespaceI . fmap (Path.fromText . Text.pack)
|
||||
parse = Right . Input.EditNamespaceI . fmap (Path.unsafeParseText . Text.pack)
|
||||
}
|
||||
|
||||
topicNameArg :: ArgumentType
|
||||
@ -2158,7 +2158,7 @@ names isGlobal =
|
||||
[("name or hash", Required, definitionQueryArg)]
|
||||
(P.wrap $ makeExample (names isGlobal) ["foo"] <> " shows the hash and all known names for `foo`.")
|
||||
\case
|
||||
[thing] -> case HQ.fromString thing of
|
||||
[thing] -> case HQ.parseText (Text.pack thing) of
|
||||
Just hq -> Right $ Input.NamesI isGlobal hq
|
||||
Nothing ->
|
||||
Left $
|
||||
@ -2358,7 +2358,7 @@ docToMarkdown =
|
||||
)
|
||||
\case
|
||||
[docNameText] -> first fromString $ do
|
||||
docName <- maybeToEither "Invalid name" . Name.fromText . Text.pack $ docNameText
|
||||
docName <- maybeToEither "Invalid name" . Name.parseText . Text.pack $ docNameText
|
||||
pure $ Input.DocToMarkdownI docName
|
||||
_ -> Left $ showPatternHelp docToMarkdown
|
||||
|
||||
@ -2379,8 +2379,8 @@ execute =
|
||||
]
|
||||
)
|
||||
\case
|
||||
[w] -> pure $ Input.ExecuteI w []
|
||||
(w : ws) -> pure $ Input.ExecuteI w ws
|
||||
[w] -> pure $ Input.ExecuteI (Text.pack w) []
|
||||
w : ws -> pure $ Input.ExecuteI (Text.pack w) ws
|
||||
_ -> Left $ showPatternHelp execute
|
||||
|
||||
saveExecuteResult :: InputPattern
|
||||
@ -2394,7 +2394,7 @@ saveExecuteResult =
|
||||
<> "as `name`."
|
||||
)
|
||||
\case
|
||||
[w] -> pure $ Input.SaveExecuteResultI (Name.unsafeFromString w)
|
||||
[w] -> pure $ Input.SaveExecuteResultI (Name.unsafeParseText (Text.pack w))
|
||||
_ -> Left $ showPatternHelp saveExecuteResult
|
||||
|
||||
ioTest :: InputPattern
|
||||
@ -2467,7 +2467,7 @@ runScheme =
|
||||
]
|
||||
)
|
||||
\case
|
||||
(main : args) -> Right $ Input.ExecuteSchemeI main args
|
||||
main : args -> Right $ Input.ExecuteSchemeI (Text.pack main) args
|
||||
_ -> Left $ showPatternHelp runScheme
|
||||
|
||||
compileScheme :: InputPattern
|
||||
@ -2487,7 +2487,7 @@ compileScheme =
|
||||
)
|
||||
\case
|
||||
[main, file] ->
|
||||
Input.CompileSchemeI file <$> parseHashQualifiedName main
|
||||
Input.CompileSchemeI (Text.pack file) <$> parseHashQualifiedName main
|
||||
_ -> Left $ showPatternHelp compileScheme
|
||||
|
||||
schemeLibgen :: InputPattern
|
||||
@ -2934,7 +2934,7 @@ upgrade =
|
||||
where
|
||||
parseRelativeNameSegment :: String -> Maybe NameSegment
|
||||
parseRelativeNameSegment string = do
|
||||
name <- Name.fromText (Text.pack string)
|
||||
name <- Name.parseText (Text.pack string)
|
||||
guard (Name.isRelative name)
|
||||
segment NE.:| [] <- Just (Name.reverseSegments name)
|
||||
Just segment
|
||||
@ -3713,7 +3713,7 @@ parseHashQualifiedName s =
|
||||
<> "I expected something like `foo`, `#abc123`, or `foo#abc123`."
|
||||
)
|
||||
Right
|
||||
$ HQ.fromString s
|
||||
$ HQ.parseText (Text.pack s)
|
||||
|
||||
parseWriteGitRepo :: String -> String -> Either (P.Pretty P.ColorText) WriteGitRepo
|
||||
parseWriteGitRepo label input = do
|
||||
|
@ -127,8 +127,8 @@ import Unison.Share.Sync.Types (CodeserverTransportError (..))
|
||||
import Unison.ShortHash qualified as ShortHash
|
||||
import Unison.Sync.Types qualified as Share
|
||||
import Unison.Syntax.DeclPrinter qualified as DeclPrinter
|
||||
import Unison.Syntax.HashQualified qualified as HQ (toString, toText, unsafeFromVar)
|
||||
import Unison.Syntax.Name qualified as Name (toString, toText)
|
||||
import Unison.Syntax.HashQualified qualified as HQ (toText, unsafeFromVar)
|
||||
import Unison.Syntax.Name qualified as Name (toText)
|
||||
import Unison.Syntax.NamePrinter
|
||||
( prettyHashQualified,
|
||||
prettyHashQualified',
|
||||
@ -300,7 +300,7 @@ notifyNumbered = \case
|
||||
"",
|
||||
tip $
|
||||
"Add"
|
||||
<> prettyName "License"
|
||||
<> prettyName (Name.fromSegment "License")
|
||||
<> "values for"
|
||||
<> prettyName (Name.fromSegment authorNS)
|
||||
<> "under"
|
||||
@ -509,12 +509,13 @@ notifyNumbered = \case
|
||||
newNextNum = nextNum + length unnumberedNames
|
||||
in ( newNextNum,
|
||||
( nameToNum <> (Map.fromList (zip unnumberedNames [nextNum ..])),
|
||||
args <> fmap Name.toString unnumberedNames
|
||||
args <> fmap Name.toText unnumberedNames
|
||||
)
|
||||
)
|
||||
)
|
||||
(1, (mempty, mempty))
|
||||
& snd
|
||||
& over (_2 . mapped) Text.unpack
|
||||
externalDepsTable :: Map LabeledDependency (Set Name) -> [(P.Pretty P.ColorText, P.Pretty P.ColorText)]
|
||||
externalDepsTable = ifoldMap $ \ld dependents ->
|
||||
[(prettyLD ld, prettyDependents dependents)]
|
||||
@ -605,7 +606,7 @@ showListEdits patch ppe =
|
||||
TermEdit.Replace rhsRef _typing -> do
|
||||
n2 <- gets snd <* modify (second succ)
|
||||
let rhsTermName = PPE.termName ppe (Referent.Ref rhsRef)
|
||||
lift $ tell ([lhsHash], [HQ.toString rhsTermName])
|
||||
lift $ tell ([lhsHash], [Text.unpack (HQ.toText rhsTermName)])
|
||||
pure
|
||||
( showNum n1 <> (P.syntaxToColor . prettyHashQualified $ lhsTermName),
|
||||
"-> " <> showNum n2 <> (P.syntaxToColor . prettyHashQualified $ rhsTermName)
|
||||
@ -630,7 +631,7 @@ showListEdits patch ppe =
|
||||
TypeEdit.Replace rhsRef -> do
|
||||
n2 <- gets snd <* modify (second succ)
|
||||
let rhsTypeName = PPE.typeName ppe rhsRef
|
||||
lift $ tell ([lhsHash], [HQ.toString rhsTypeName])
|
||||
lift $ tell ([lhsHash], [Text.unpack (HQ.toText rhsTypeName)])
|
||||
pure
|
||||
( showNum n1 <> (P.syntaxToColor . prettyHashQualified $ lhsTypeName),
|
||||
"-> " <> showNum n2 <> (P.syntaxToColor . prettyHashQualified $ rhsTypeName)
|
||||
@ -643,7 +644,7 @@ notifyUser dir = \case
|
||||
. P.warnCallout
|
||||
. P.wrap
|
||||
$ "Cannot save the last run result into"
|
||||
<> P.backticked (P.string (Name.toString name))
|
||||
<> P.backticked (P.text (Name.toText name))
|
||||
<> "because that name conflicts with a name in the scratch file."
|
||||
NoLastRunResult ->
|
||||
pure
|
||||
@ -881,21 +882,21 @@ notifyUser dir = \case
|
||||
P.lines
|
||||
[ P.wrap $
|
||||
"I looked for a function"
|
||||
<> P.backticked (P.string main)
|
||||
<> P.backticked (P.text main)
|
||||
<> "in the most recently typechecked file and codebase but couldn't find one. It has to have the type:",
|
||||
"",
|
||||
P.indentN 2 $ P.lines [P.string main <> " : " <> TypePrinter.pretty ppe t | t <- ts]
|
||||
P.indentN 2 $ P.lines [P.text main <> " : " <> TypePrinter.pretty ppe t | t <- ts]
|
||||
]
|
||||
BadMainFunction what main ty ppe ts ->
|
||||
pure . P.callout "😶" $
|
||||
P.lines
|
||||
[ P.string "I found this function:",
|
||||
"",
|
||||
P.indentN 2 $ P.string main <> " : " <> TypePrinter.pretty ppe ty,
|
||||
P.indentN 2 $ P.text main <> " : " <> TypePrinter.pretty ppe ty,
|
||||
"",
|
||||
P.wrap $ P.string "but in order for me to" <> P.backticked (P.string what) <> "it needs to be a subtype of:",
|
||||
P.wrap $ P.string "but in order for me to" <> P.backticked (P.text what) <> "it needs to be a subtype of:",
|
||||
"",
|
||||
P.indentN 2 $ P.lines [P.string main <> " : " <> TypePrinter.pretty ppe t | t <- ts]
|
||||
P.indentN 2 $ P.lines [P.text main <> " : " <> TypePrinter.pretty ppe t | t <- ts]
|
||||
]
|
||||
NoUnisonFile -> do
|
||||
dir' <- canonicalizePath dir
|
||||
@ -1544,8 +1545,7 @@ notifyUser dir = \case
|
||||
"",
|
||||
P.wrap "Try again with a few more hash characters to disambiguate."
|
||||
]
|
||||
BadName n ->
|
||||
pure . P.wrap $ P.string n <> " is not a kind of name I understand."
|
||||
BadName n -> pure . P.wrap $ P.text n <> " is not a kind of name I understand."
|
||||
TermNotFound' sh ->
|
||||
pure $
|
||||
"I could't find a term with hash "
|
||||
@ -2699,7 +2699,7 @@ renderNameConflicts ppe conflictedNames = do
|
||||
P.lines <$> do
|
||||
for (Map.toList conflictedNames) $ \(name, hashes) -> do
|
||||
prettyConflicts <- for hashes \hash -> do
|
||||
n <- addNumberedArg (HQ.toString hash)
|
||||
n <- addNumberedArg (Text.unpack (HQ.toText hash))
|
||||
pure $ formatNum n <> (P.blue . P.syntaxToColor . prettyHashQualified $ hash)
|
||||
pure . P.wrap $
|
||||
( "The "
|
||||
@ -2731,7 +2731,7 @@ renderEditConflicts ppe Patch {..} = do
|
||||
<> (fmap Right . Map.toList . R.toMultimap . R.filterManyDom $ _termEdits)
|
||||
numberedHQName :: HQ.HashQualified Name -> Numbered Pretty
|
||||
numberedHQName hqName = do
|
||||
n <- addNumberedArg (HQ.toString hqName)
|
||||
n <- addNumberedArg (Text.unpack (HQ.toText hqName))
|
||||
pure $ formatNum n <> styleHashQualified P.bold hqName
|
||||
formatTypeEdits ::
|
||||
(Reference, Set TypeEdit.TypeEdit) ->
|
||||
@ -2844,11 +2844,11 @@ todoOutput ppe todo = runNumbered do
|
||||
todoEdits :: Numbered Pretty
|
||||
todoEdits = do
|
||||
numberedTypes <- for (unscore <$> dirtyTypes) \(ref, displayObj) -> do
|
||||
n <- addNumberedArg (HQ.toString $ PPE.typeName ppeu ref)
|
||||
n <- addNumberedArg (Text.unpack (HQ.toText $ PPE.typeName ppeu ref))
|
||||
pure $ formatNum n <> prettyDeclPair ppeu (ref, displayObj)
|
||||
let filteredTerms = goodTerms (unscore <$> dirtyTerms)
|
||||
termNumbers <- for filteredTerms \(ref, _, _) -> do
|
||||
n <- addNumberedArg (HQ.toString $ PPE.termName ppeu ref)
|
||||
n <- addNumberedArg (Text.unpack (HQ.toText $ PPE.termName ppeu ref))
|
||||
pure $ formatNum n
|
||||
let formattedTerms = TypePrinter.prettySignaturesCT ppes filteredTerms
|
||||
numberedTerms = zipWith (<>) termNumbers formattedTerms
|
||||
@ -3264,8 +3264,8 @@ showDiffNamespace sn ppe oldPath newPath OBD.BranchDiffOutput {..} =
|
||||
-- prefixBranchId ".base" "List.map" -> ".base.List.map"
|
||||
prefixBranchId :: Input.AbsBranchId -> Name -> String
|
||||
prefixBranchId branchId name = case branchId of
|
||||
Left sch -> "#" <> SCH.toString sch <> ":" <> Name.toString (Name.makeAbsolute name)
|
||||
Right pathPrefix -> Name.toString (Name.makeAbsolute . Path.prefixName pathPrefix $ name)
|
||||
Left sch -> "#" <> SCH.toString sch <> ":" <> Text.unpack (Name.toText (Name.makeAbsolute name))
|
||||
Right pathPrefix -> Text.unpack (Name.toText (Name.makeAbsolute . Path.prefixName pathPrefix $ name))
|
||||
|
||||
addNumberedArg' :: String -> Numbered Pretty
|
||||
addNumberedArg' s = case sn of
|
||||
@ -3522,7 +3522,7 @@ numberedArgsForEndangerments (PPED.unsuffixifiedPPE -> ppe) m =
|
||||
m
|
||||
& Map.elems
|
||||
& concatMap toList
|
||||
& fmap (HQ.toString . PPE.labeledRefName ppe)
|
||||
& fmap (Text.unpack . HQ.toText . PPE.labeledRefName ppe)
|
||||
|
||||
-- | Format and render all dependents which are endangered by references going extinct.
|
||||
endangeredDependentsTable ::
|
||||
|
@ -43,7 +43,7 @@ import Unison.Referent qualified as Referent
|
||||
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 (fromText, nameP, toText)
|
||||
import Unison.Syntax.Name qualified as Name (parseText, nameP, toText)
|
||||
import Unison.Syntax.TypePrinter qualified as TypePrinter
|
||||
import Unison.Util.Monoid qualified as Monoid
|
||||
import Unison.Util.Pretty qualified as Pretty
|
||||
@ -340,8 +340,8 @@ instance Aeson.ToJSON CompletionItemDetails where
|
||||
instance Aeson.FromJSON CompletionItemDetails where
|
||||
parseJSON = Aeson.withObject "CompletionItemDetails" \obj -> do
|
||||
dep <- ((obj Aeson..: "dep") >>= ldParser)
|
||||
relativeName <- (obj Aeson..: "relativeName" >>= maybe (fail "Invalid name in CompletionItemDetails") pure . Name.fromText)
|
||||
fullyQualifiedName <- (obj Aeson..: "fullyQualifiedName" >>= maybe (fail "Invalid name in CompletionItemDetails") pure . Name.fromText)
|
||||
relativeName <- (obj Aeson..: "relativeName" >>= maybe (fail "Invalid name in CompletionItemDetails") pure . Name.parseText)
|
||||
fullyQualifiedName <- (obj Aeson..: "fullyQualifiedName" >>= maybe (fail "Invalid name in CompletionItemDetails") pure . Name.parseText)
|
||||
fileUri <- obj Aeson..: "fileUri"
|
||||
pure $ CompletionItemDetails {..}
|
||||
where
|
||||
|
@ -458,7 +458,7 @@ mkTypeSignatureHints parsedFile typecheckedFile = do
|
||||
& Zip.zip symbolsWithoutTypeSigs
|
||||
& imapMaybe
|
||||
( \v (ann, (_ann, ref, _wk, _trm, typ)) -> do
|
||||
name <- Name.fromText (Var.name v)
|
||||
name <- Name.parseText (Var.name v)
|
||||
range <- annToRange ann
|
||||
let newRangeEnd =
|
||||
range ^. LSPTypes.start
|
||||
|
@ -94,7 +94,7 @@ hoverInfo uri pos =
|
||||
LD.TypeReference (Reference.Builtin {}) -> do
|
||||
pure (symAtCursor <> " : <builtin>")
|
||||
LD.TypeReference ref@(Reference.DerivedId refId) -> do
|
||||
nameAtCursor <- MaybeT . pure $ Name.fromText symAtCursor
|
||||
nameAtCursor <- MaybeT . pure $ Name.parseText symAtCursor
|
||||
decl <- LSPQ.getTypeDeclaration uri refId
|
||||
let typ = Text.pack . Pretty.toPlain prettyWidth . Pretty.syntaxToColor $ DeclPrinter.prettyDecl pped ref (HQ.NameOnly nameAtCursor) decl
|
||||
pure typ
|
||||
|
@ -4,9 +4,6 @@
|
||||
-- See the excellent documentation at https://hackage.haskell.org/package/optparse-applicative
|
||||
module ArgParse where
|
||||
|
||||
import Control.Applicative (Alternative (many, (<|>)), Applicative (liftA2), optional)
|
||||
import Data.Foldable (Foldable (fold))
|
||||
import Data.Functor ((<&>))
|
||||
import Data.List qualified as List
|
||||
import Data.List.NonEmpty (NonEmpty)
|
||||
import Data.List.NonEmpty qualified as NE
|
||||
@ -53,17 +50,17 @@ import Options.Applicative.Help (bold, (<+>))
|
||||
import Options.Applicative.Help.Pretty qualified as P
|
||||
import Stats
|
||||
import System.Environment (lookupEnv)
|
||||
import Text.Read (readMaybe)
|
||||
import Unison.Codebase.Path qualified as Path
|
||||
import Unison.Codebase.Path.Parse qualified as Path
|
||||
import Unison.CommandLine.Types (ShouldWatchFiles (..))
|
||||
import Unison.Prelude
|
||||
import Unison.PrettyTerminal qualified as PT
|
||||
import Unison.Server.CodebaseServer (CodebaseServerOpts (..))
|
||||
import Unison.Server.CodebaseServer qualified as Server
|
||||
import Unison.Util.Pretty (Width (..))
|
||||
|
||||
-- The name of a symbol to execute.
|
||||
type SymbolName = String
|
||||
type SymbolName = Text
|
||||
|
||||
-- | Valid ways to provide source code to the run command
|
||||
data RunSource
|
||||
|
@ -1,3 +1,6 @@
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
|
||||
-- | The private Unison.Name innards. Prefer importing Unison.Name instead, unless you need the data constructor of
|
||||
-- Name.
|
||||
module Unison.Name.Internal
|
||||
@ -11,6 +14,8 @@ import Control.Lens as Lens
|
||||
import Data.List.NonEmpty (pattern (:|))
|
||||
import Data.List.NonEmpty qualified as List (NonEmpty)
|
||||
import Data.List.NonEmpty qualified as List.NonEmpty
|
||||
import GHC.TypeLits (TypeError)
|
||||
import GHC.TypeLits qualified as TypeError (ErrorMessage (Text))
|
||||
import Unison.NameSegment (NameSegment)
|
||||
import Unison.Position (Position (..))
|
||||
import Unison.Prelude
|
||||
@ -42,6 +47,15 @@ instance Alphabetical Name where
|
||||
(False, True) -> GT
|
||||
_ -> compareAlphabetical (segments n1) (segments n2)
|
||||
|
||||
instance
|
||||
TypeError
|
||||
( 'TypeError.Text
|
||||
"You cannot make a Name from a string literal because there may (some day) be more than one syntax"
|
||||
) =>
|
||||
IsString Name
|
||||
where
|
||||
fromString = undefined
|
||||
|
||||
instance Ord Name where
|
||||
compare (Name p0 ss0) (Name p1 ss1) =
|
||||
compare ss0 ss1 <> compare p0 p1
|
||||
|
@ -168,9 +168,9 @@ import Unison.Sqlite qualified as Sqlite
|
||||
import Unison.Symbol (Symbol)
|
||||
import Unison.Syntax.DeclPrinter qualified as DeclPrinter
|
||||
import Unison.Syntax.HashQualified' qualified as HQ' (toText)
|
||||
import Unison.Syntax.Name as Name (toText, unsafeFromText)
|
||||
import Unison.Syntax.Name as Name (toText, unsafeParseText)
|
||||
import Unison.Syntax.NamePrinter qualified as NP
|
||||
import Unison.Syntax.NameSegment qualified as NameSegment (toEscapedText, unsafeFromText)
|
||||
import Unison.Syntax.NameSegment qualified as NameSegment (toEscapedText, unsafeParseText)
|
||||
import Unison.Syntax.TermPrinter qualified as TermPrinter
|
||||
import Unison.Syntax.TypePrinter qualified as TypePrinter
|
||||
import Unison.Term (Term)
|
||||
@ -349,7 +349,7 @@ fuzzyFind printNames query =
|
||||
|
||||
-- Prefer shorter FQNs
|
||||
rank (alignment, name, _) =
|
||||
( Name.countSegments (Name.unsafeFromText name),
|
||||
( Name.countSegments (Name.unsafeParseText name),
|
||||
negate (FZF.score alignment)
|
||||
)
|
||||
|
||||
@ -764,7 +764,7 @@ mkTypeDefinition codebase pped namesRoot rootCausal width r docs tp = do
|
||||
liftIO $ Codebase.runTransaction codebase do
|
||||
causalAtPath <- Codebase.getShallowCausalAtPath namesRoot (Just rootCausal)
|
||||
branchAtPath <- V2Causal.value causalAtPath
|
||||
typeEntryTag <$> typeListEntry codebase (Just branchAtPath) (ExactName (NameSegment.unsafeFromText bn) r)
|
||||
typeEntryTag <$> typeListEntry codebase (Just branchAtPath) (ExactName (NameSegment.unsafeParseText bn) r)
|
||||
pure $
|
||||
TypeDefinition
|
||||
(HQ'.toText <$> PPE.allTypeNames fqnPPE r)
|
||||
@ -798,7 +798,7 @@ mkTermDefinition codebase termPPED namesRoot rootCausal width r docs tm = do
|
||||
tag <-
|
||||
lift
|
||||
( termEntryTag
|
||||
<$> termListEntry codebase (Just branchAtPath) (ExactName (NameSegment.unsafeFromText bn) (Cv.referent1to2 referent))
|
||||
<$> termListEntry codebase (Just branchAtPath) (ExactName (NameSegment.unsafeParseText bn) (Cv.referent1to2 referent))
|
||||
)
|
||||
mk ts bn tag
|
||||
where
|
||||
|
@ -28,7 +28,7 @@ import Unison.Server.Types
|
||||
mungeString,
|
||||
)
|
||||
import Unison.ShortHash qualified as SH
|
||||
import Unison.Syntax.HashQualified qualified as HQ (toString)
|
||||
import Unison.Syntax.HashQualified qualified as HQ (toText)
|
||||
|
||||
badHQN :: HashQualifiedName -> ServerError
|
||||
badHQN hqn =
|
||||
@ -108,7 +108,7 @@ noSuchDefinition :: HQ.HashQualified Name -> ServerError
|
||||
noSuchDefinition hqName =
|
||||
err404
|
||||
{ errBody =
|
||||
"Couldn't find a definition for " <> BSC.pack (HQ.toString hqName)
|
||||
"Couldn't find a definition for " <> LazyByteString.fromStrict (Text.encodeUtf8 (HQ.toText hqName))
|
||||
}
|
||||
|
||||
ambiguousHashForDefinition :: SH.ShortHash -> ServerError
|
||||
|
@ -40,7 +40,7 @@ instance ToSample Current where
|
||||
Current
|
||||
(Just $ UnsafeProjectName "@unison/base")
|
||||
(Just $ UnsafeProjectBranchName "main")
|
||||
(Path.Absolute $ Path.fromText ".__projects._53393e4b_1f61_467c_a488_b6068c727daa.branches._f0aec0e3_249f_4004_b836_572fea3981c1")
|
||||
(Path.Absolute $ Path.unsafeParseText ".__projects._53393e4b_1f61_467c_a488_b6068c727daa.branches._f0aec0e3_249f_4004_b836_572fea3981c1")
|
||||
)
|
||||
]
|
||||
|
||||
|
@ -182,10 +182,10 @@ serveFuzzyFind codebase mayRoot relativeTo limit typeWidth query = do
|
||||
$ Backend.termEntryToNamedTerm ppe typeWidth te
|
||||
)
|
||||
)
|
||||
<$> Backend.termListEntry codebase relativeToBranch (ExactName (NameSegment.unsafeFromText n) (Cv.referent1to2 r))
|
||||
<$> Backend.termListEntry codebase relativeToBranch (ExactName (NameSegment.unsafeParseText n) (Cv.referent1to2 r))
|
||||
Backend.FoundTypeRef r ->
|
||||
Codebase.runTransaction codebase do
|
||||
te <- Backend.typeListEntry codebase relativeToBranch (ExactName (NameSegment.unsafeFromText n) r)
|
||||
te <- Backend.typeListEntry codebase relativeToBranch (ExactName (NameSegment.unsafeParseText n) r)
|
||||
let namedType = Backend.typeEntryToNamedType te
|
||||
let typeName = Backend.bestNameForType @Symbol ppe (mayDefaultWidth typeWidth) r
|
||||
typeHeader <- Backend.typeDeclHeader codebase ppe r
|
||||
|
@ -36,9 +36,9 @@ import Unison.Reference qualified as Reference
|
||||
import Unison.Referent qualified as Referent
|
||||
import Unison.ShortHash (ShortHash)
|
||||
import Unison.ShortHash qualified as SH
|
||||
import Unison.Syntax.HashQualified qualified as HQ (fromText)
|
||||
import Unison.Syntax.HashQualified' qualified as HQ' (fromText)
|
||||
import Unison.Syntax.Name qualified as Name (fromTextEither, toText)
|
||||
import Unison.Syntax.HashQualified qualified as HQ (parseText)
|
||||
import Unison.Syntax.HashQualified' qualified as HQ' (parseText)
|
||||
import Unison.Syntax.Name qualified as Name (parseTextEither, toText)
|
||||
import Unison.Syntax.NameSegment qualified as NameSegment (toEscapedText)
|
||||
import Unison.Util.Pretty (Width (..))
|
||||
|
||||
@ -217,7 +217,7 @@ instance ToParam (QueryParam "name" Name) where
|
||||
Normal
|
||||
|
||||
instance FromHttpApiData Name where
|
||||
parseQueryParam = Name.fromTextEither
|
||||
parseQueryParam = Name.parseTextEither
|
||||
|
||||
deriving via Int instance FromHttpApiData Width
|
||||
|
||||
@ -316,22 +316,22 @@ instance ToJSON (HQ'.HashQualified NameSegment) where
|
||||
|
||||
instance FromJSON (HQ'.HashQualified Name) where
|
||||
parseJSON = Aeson.withText "HashQualified'" \txt ->
|
||||
maybe (fail "Invalid HashQualified' Name") pure $ HQ'.fromText txt
|
||||
maybe (fail "Invalid HashQualified' Name") pure $ HQ'.parseText txt
|
||||
|
||||
instance FromJSON (HQ.HashQualified Name) where
|
||||
parseJSON = Aeson.withText "HashQualified" \txt ->
|
||||
maybe (fail "Invalid HashQualified Name") pure $ HQ.fromText txt
|
||||
maybe (fail "Invalid HashQualified Name") pure $ HQ.parseText txt
|
||||
|
||||
instance FromJSON (HQ'.HashQualified NameSegment) where
|
||||
parseJSON = Aeson.withText "HashQualified'" \txt -> do
|
||||
hqName <- maybe (fail "Invalid HashQualified' NameSegment") pure $ HQ'.fromText txt
|
||||
hqName <- maybe (fail "Invalid HashQualified' NameSegment") pure $ HQ'.parseText txt
|
||||
for hqName \name -> case Name.segments name of
|
||||
(ns :| []) -> pure ns
|
||||
_ -> fail $ "Expected a single name segment but received several: " <> Text.unpack txt
|
||||
|
||||
instance FromJSON (HQ.HashQualified NameSegment) where
|
||||
parseJSON = Aeson.withText "HashQualified" \txt -> do
|
||||
hqName <- maybe (fail "Invalid HashQualified' NameSegment") pure $ HQ.fromText txt
|
||||
hqName <- maybe (fail "Invalid HashQualified' NameSegment") pure $ HQ.parseText txt
|
||||
for hqName \name -> case Name.segments name of
|
||||
(ns :| []) -> pure ns
|
||||
_ -> fail $ "Expected a single name segment but received several: " <> Text.unpack txt
|
||||
@ -339,13 +339,13 @@ instance FromJSON (HQ.HashQualified NameSegment) where
|
||||
instance FromHttpApiData (HQ.HashQualified Name) where
|
||||
parseQueryParam txt =
|
||||
Text.replace "@" "#" txt
|
||||
& HQ.fromText
|
||||
& HQ.parseText
|
||||
& maybe (Left "Invalid Hash Qualified Name. Expected one of the following forms: name@hash, name, @hash") Right
|
||||
|
||||
instance FromHttpApiData (HQ'.HashQualified Name) where
|
||||
parseQueryParam txt =
|
||||
Text.replace "@" "#" txt
|
||||
& HQ'.fromText
|
||||
& HQ'.parseText
|
||||
& maybe (Left "Invalid Hash Qualified Name. Expected one of the following forms: name@hash, name") Right
|
||||
|
||||
instance ToParamSchema (HQ.HashQualified n) where
|
||||
|
@ -1,8 +1,3 @@
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE DerivingVia #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE StandaloneDeriving #-}
|
||||
{-# OPTIONS_GHC -Wno-orphans #-}
|
||||
|
||||
-- | Duplicate of the Unison.Util.SyntaxText module, but we expect these to
|
||||
@ -27,7 +22,7 @@ import Unison.Reference (Reference)
|
||||
import Unison.Reference qualified as Reference
|
||||
import Unison.Referent qualified as Referent
|
||||
import Unison.Syntax.HashQualified qualified as HashQualified (toText)
|
||||
import Unison.Syntax.Name qualified as Name (unsafeFromText)
|
||||
import Unison.Syntax.Name qualified as Name (unsafeParseText)
|
||||
import Unison.Syntax.NameSegment qualified as NameSegment (toEscapedText)
|
||||
import Unison.Util.AnnotatedText
|
||||
( AnnotatedText (..),
|
||||
@ -321,7 +316,7 @@ segmentToHtml (Segment segmentText element) =
|
||||
|
||||
content
|
||||
| Text.isInfixOf "->" sText = span_ [class_ "arrow"] $ L.toHtml sText
|
||||
| isFQN = nameToHtml (Name.unsafeFromText sText)
|
||||
| isFQN = nameToHtml (Name.unsafeParseText sText)
|
||||
| otherwise = L.toHtml sText
|
||||
in case ref of
|
||||
Just (r, refType) ->
|
||||
|
@ -49,7 +49,7 @@ import Unison.Server.Doc (Doc)
|
||||
import Unison.Server.Orphans ()
|
||||
import Unison.Server.Syntax (SyntaxText)
|
||||
import Unison.ShortHash (ShortHash)
|
||||
import Unison.Syntax.HashQualified qualified as HQ (fromText)
|
||||
import Unison.Syntax.HashQualified qualified as HQ (parseText)
|
||||
import Unison.Syntax.NameSegment qualified as NameSegment (toEscapedText)
|
||||
import Unison.Util.Pretty (Width (..))
|
||||
|
||||
@ -146,7 +146,7 @@ instance FromHttpApiData (ExactName Name ShortHash) where
|
||||
-- # is special in URLs, so we use @ for hash qualification instead;
|
||||
-- e.g. ".base.List.map@abc"
|
||||
-- e.g. ".base.Nat@@Nat"
|
||||
case HQ.fromText (Text.replace "@" "#" txt) of
|
||||
case HQ.parseText (Text.replace "@" "#" txt) of
|
||||
Nothing -> Left "Invalid absolute name with Hash"
|
||||
Just hq' -> case hq' of
|
||||
HQ.NameOnly _ -> Left "A name and hash are required, but only a name was provided"
|
||||
|
@ -8,7 +8,6 @@ module Unison.Util.Find
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Char qualified as Char
|
||||
import Data.List qualified as List
|
||||
import Data.Text qualified as Text
|
||||
-- http://www.serpentine.com/blog/2007/02/27/a-haskell-regular-expression-tutorial/
|
||||
@ -27,7 +26,7 @@ import Unison.Referent qualified as Referent
|
||||
import Unison.Server.SearchResult (SearchResult)
|
||||
import Unison.Server.SearchResult qualified as SR
|
||||
import Unison.ShortHash qualified as SH
|
||||
import Unison.Syntax.Name qualified as Name (toString)
|
||||
import Unison.Syntax.Name qualified as Name (toText)
|
||||
import Unison.Syntax.NamePrinter (prettyHashQualified)
|
||||
import Unison.Util.Monoid (intercalateMap)
|
||||
import Unison.Util.Pretty qualified as P
|
||||
@ -46,46 +45,46 @@ fuzzyFinder query items render =
|
||||
|
||||
simpleFuzzyFinder ::
|
||||
forall a.
|
||||
String ->
|
||||
Text ->
|
||||
[a] ->
|
||||
(a -> String) ->
|
||||
(a -> Text) ->
|
||||
[(a, P.Pretty P.ColorText)]
|
||||
simpleFuzzyFinder query items render =
|
||||
sortAndCleanup $ do
|
||||
sortAndCleanup do
|
||||
a <- items
|
||||
let s = render a
|
||||
score <- toList (simpleFuzzyScore query s)
|
||||
pure ((a, hi s), score)
|
||||
pure ((a, hi (Text.unpack s)), score)
|
||||
where
|
||||
hi = highlightSimple query
|
||||
sortAndCleanup = List.map fst . List.sortOn snd
|
||||
|
||||
-- highlights `query` if it is a prefix of `s`, or if it
|
||||
-- appears in the final segement of s (after the final `.`)
|
||||
highlightSimple :: String -> String -> P.Pretty P.ColorText
|
||||
highlightSimple "" = P.string
|
||||
highlightSimple query = go
|
||||
highlightSimple :: Text -> String -> P.Pretty P.ColorText
|
||||
highlightSimple query
|
||||
| Text.null query = P.string
|
||||
| otherwise = go
|
||||
where
|
||||
go [] = mempty
|
||||
go s@(h : t)
|
||||
| query `List.isPrefixOf` s = hiQuery <> go (drop len s)
|
||||
| query `Text.isPrefixOf` (Text.pack s) = hiQuery <> go (drop len s)
|
||||
| otherwise = P.string [h] <> go t
|
||||
len = length query
|
||||
hiQuery = P.hiBlack (P.string query)
|
||||
len = Text.length query
|
||||
hiQuery = P.hiBlack (P.text query)
|
||||
|
||||
simpleFuzzyScore :: String -> String -> Maybe Int
|
||||
simpleFuzzyScore :: Text -> Text -> Maybe Int
|
||||
simpleFuzzyScore query s
|
||||
| query `List.isPrefixOf` s = Just (bonus s 2)
|
||||
| query `List.isSuffixOf` s = Just (bonus s 1)
|
||||
| query `List.isInfixOf` s = Just (bonus s 3)
|
||||
| lowerquery `List.isInfixOf` lowers = Just (bonus s 4)
|
||||
| query `Text.isPrefixOf` s = Just (bonus s 2)
|
||||
| query `Text.isSuffixOf` s = Just (bonus s 1)
|
||||
| query `Text.isInfixOf` s = Just (bonus s 3)
|
||||
| lowerquery `Text.isInfixOf` lowers = Just (bonus s 4)
|
||||
| otherwise = Nothing
|
||||
where
|
||||
-- prefer relative names
|
||||
bonus ('.' : _) n = n * 10
|
||||
bonus _ n = n
|
||||
lowerquery = Char.toLower <$> query
|
||||
lowers = Char.toLower <$> s
|
||||
bonus s n = if Text.take 1 s == "." then n * 10 else n
|
||||
lowerquery = Text.toLower query
|
||||
lowers = Text.toLower s
|
||||
|
||||
-- This logic was split out of fuzzyFinder because the `RE.MatchArray` has an
|
||||
-- `Ord` instance that helps us sort the fuzzy matches in a nice way. (see
|
||||
@ -155,13 +154,13 @@ fuzzyFindInBranch ::
|
||||
[(SearchResult, P.Pretty P.ColorText)]
|
||||
fuzzyFindInBranch b hq =
|
||||
simpleFuzzyFinder
|
||||
(Name.toString (HQ'.toName hq))
|
||||
(Name.toText (HQ'.toName hq))
|
||||
(candidates b hq)
|
||||
( \sr ->
|
||||
case HQ.toName (SR.name sr) of
|
||||
-- see invariant on `candidates` below.
|
||||
Nothing -> error "search result without name"
|
||||
Just name -> Name.toString name
|
||||
Just name -> Name.toText name
|
||||
)
|
||||
|
||||
getName :: SearchResult -> (SearchResult, P.Pretty P.ColorText)
|
||||
|
@ -2,47 +2,62 @@
|
||||
|
||||
-- | Syntax-related combinators for HashQualified' (to/from string types).
|
||||
module Unison.Syntax.HashQualified'
|
||||
( fromString,
|
||||
fromText,
|
||||
unsafeFromText,
|
||||
toString,
|
||||
( -- * String conversions
|
||||
parseText,
|
||||
unsafeParseText,
|
||||
toText,
|
||||
|
||||
-- * Parsers
|
||||
hashQualifiedP,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Text qualified as Text
|
||||
import Text.Megaparsec (ParsecT)
|
||||
import Text.Megaparsec qualified as P
|
||||
import Text.Megaparsec.Internal qualified as P (withParsecT)
|
||||
import Unison.HashQualified' qualified as HQ'
|
||||
import Unison.Name (Name, Parse)
|
||||
import Unison.Name qualified as Name
|
||||
import Unison.Prelude hiding (fromString)
|
||||
import Unison.Prelude qualified
|
||||
import Unison.ShortHash qualified as SH
|
||||
import Unison.Syntax.Name qualified as Name (toText, unsafeFromText)
|
||||
|
||||
instance IsString (HQ'.HashQualified Name) where
|
||||
fromString = unsafeFromText . Text.pack
|
||||
import Unison.Syntax.Lexer.Token (Token)
|
||||
import Unison.Syntax.Name qualified as Name (nameP, toText)
|
||||
import Unison.Syntax.NameSegment qualified as NameSegment
|
||||
import Unison.Syntax.ShortHash qualified as ShortHash (shortHashP)
|
||||
|
||||
instance Parse Text (HQ'.HashQualified Name) where
|
||||
parse = fromText
|
||||
parse = parseText
|
||||
|
||||
fromString :: String -> Maybe (HQ'.HashQualified Name)
|
||||
fromString = fromText . Text.pack
|
||||
------------------------------------------------------------------------------------------------------------------------
|
||||
-- String conversions
|
||||
|
||||
-- Parses possibly-hash-qualified into structured type.
|
||||
fromText :: Text -> Maybe (HQ'.HashQualified Name)
|
||||
fromText t = case Text.breakOn "#" t of
|
||||
(name, "") -> Just $ HQ'.NameOnly (Name.unsafeFromText name) -- safe bc breakOn #
|
||||
(name, hash) -> HQ'.HashQualified (Name.unsafeFromText name) <$> SH.fromText hash
|
||||
parseText :: Text -> Maybe (HQ'.HashQualified Name)
|
||||
parseText text =
|
||||
eitherToMaybe (P.runParser parser "" (Text.unpack text))
|
||||
where
|
||||
parser =
|
||||
hashQualifiedP (P.withParsecT (fmap NameSegment.renderParseErr) Name.nameP) <* P.eof
|
||||
|
||||
unsafeFromText :: (HasCallStack) => Text -> HQ'.HashQualified Name
|
||||
unsafeFromText txt = fromMaybe msg (fromText txt)
|
||||
unsafeParseText :: (HasCallStack) => Text -> HQ'.HashQualified Name
|
||||
unsafeParseText txt = fromMaybe msg (parseText txt)
|
||||
where
|
||||
msg = error ("HashQualified.unsafeFromText " <> show txt)
|
||||
|
||||
toString :: HQ'.HashQualified Name -> String
|
||||
toString =
|
||||
Text.unpack . toText
|
||||
|
||||
toText :: HQ'.HashQualified Name -> Text
|
||||
toText =
|
||||
HQ'.toTextWith Name.toText
|
||||
|
||||
------------------------------------------------------------------------------------------------------------------------
|
||||
-- Hash-qualified parsers
|
||||
|
||||
-- | A hash-qualified parser.
|
||||
hashQualifiedP ::
|
||||
Monad m =>
|
||||
ParsecT (Token Text) [Char] m name ->
|
||||
ParsecT (Token Text) [Char] m (HQ'.HashQualified name)
|
||||
hashQualifiedP nameP =
|
||||
P.try do
|
||||
name <- nameP
|
||||
optional ShortHash.shortHashP <&> \case
|
||||
Nothing -> HQ'.NameOnly name
|
||||
Just hash -> HQ'.HashQualified name hash
|
||||
|
@ -2,67 +2,70 @@
|
||||
|
||||
-- | Syntax-related combinators for HashQualified (to/from string types).
|
||||
module Unison.Syntax.HashQualified
|
||||
( fromString,
|
||||
fromText,
|
||||
unsafeFromString,
|
||||
unsafeFromText,
|
||||
unsafeFromVar,
|
||||
toString,
|
||||
( parseText,
|
||||
unsafeParseText,
|
||||
toText,
|
||||
unsafeFromVar,
|
||||
toVar,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Text qualified as Text
|
||||
import Text.Megaparsec (ParsecT)
|
||||
import Text.Megaparsec qualified as P
|
||||
import Text.Megaparsec.Internal qualified as P (withParsecT)
|
||||
import Unison.HashQualified (HashQualified (..))
|
||||
import Unison.HashQualified qualified as HashQualified
|
||||
import Unison.HashQualified' qualified as HQ'
|
||||
import Unison.Name (Name, Parse)
|
||||
import Unison.Name qualified as Name
|
||||
import Unison.Prelude hiding (fromString)
|
||||
import Unison.ShortHash qualified as SH
|
||||
import Unison.Syntax.Name qualified as Name (fromText, toText)
|
||||
import Unison.Syntax.HashQualified' qualified as HQ'
|
||||
import Unison.Syntax.Lexer.Token (Token)
|
||||
import Unison.Syntax.Name qualified as Name (nameP, toText)
|
||||
import Unison.Syntax.NameSegment qualified as NameSegment
|
||||
import Unison.Syntax.ShortHash qualified as ShortHash
|
||||
import Unison.Var (Var)
|
||||
import Unison.Var qualified as Var
|
||||
import Prelude hiding (take)
|
||||
|
||||
instance Parse Text (HashQualified Name) where
|
||||
parse = fromText
|
||||
parse = parseText
|
||||
|
||||
fromString :: String -> Maybe (HashQualified Name)
|
||||
fromString = fromText . Text.pack
|
||||
|
||||
-- Parses possibly-hash-qualified into structured type.
|
||||
-- Doesn't validate against base58 or the codebase.
|
||||
fromText :: Text -> Maybe (HashQualified Name)
|
||||
fromText t = case Text.breakOn "#" t of -- breakOn leaves the '#' on the RHS
|
||||
("", "") -> Nothing
|
||||
(name, "") -> NameOnly <$> Name.fromText name
|
||||
("", hash) -> HashOnly <$> SH.fromText hash
|
||||
(name, hash) -> HashQualified <$> Name.fromText name <*> SH.fromText hash
|
||||
|
||||
unsafeFromString :: String -> HashQualified Name
|
||||
unsafeFromString s = fromMaybe msg . fromString $ s
|
||||
parseText :: Text -> Maybe (HashQualified Name)
|
||||
parseText text =
|
||||
eitherToMaybe (P.runParser parser "" (Text.unpack text))
|
||||
where
|
||||
msg = error $ "HashQualified.unsafeFromString " <> show s
|
||||
parser =
|
||||
hashQualifiedP (P.withParsecT (fmap NameSegment.renderParseErr) Name.nameP) <* P.eof
|
||||
|
||||
-- Won't crash as long as SH.unsafeFromText doesn't crash on any input that
|
||||
-- starts with '#', which is true as of the time of this writing, but not great.
|
||||
unsafeFromText :: Text -> HashQualified Name
|
||||
unsafeFromText txt = fromMaybe msg . fromText $ txt
|
||||
unsafeParseText :: Text -> HashQualified Name
|
||||
unsafeParseText txt = fromMaybe msg . parseText $ txt
|
||||
where
|
||||
msg = error $ "HashQualified.unsafeFromText " <> show txt
|
||||
|
||||
unsafeFromVar :: (Var v) => v -> HashQualified Name
|
||||
unsafeFromVar = unsafeFromText . Var.name
|
||||
|
||||
toString :: HashQualified Name -> String
|
||||
toString =
|
||||
Text.unpack . toText
|
||||
|
||||
toText :: HashQualified Name -> Text
|
||||
toText =
|
||||
HashQualified.toTextWith Name.toText
|
||||
|
||||
unsafeFromVar :: (Var v) => v -> HashQualified Name
|
||||
unsafeFromVar =
|
||||
unsafeParseText . Var.name
|
||||
|
||||
toVar :: (Var v) => HashQualified Name -> v
|
||||
toVar =
|
||||
Var.named . toText
|
||||
|
||||
------------------------------------------------------------------------------------------------------------------------
|
||||
-- Hash-qualified parsers
|
||||
|
||||
-- | A hash-qualified parser.
|
||||
hashQualifiedP ::
|
||||
Monad m =>
|
||||
ParsecT (Token Text) [Char] m name ->
|
||||
ParsecT (Token Text) [Char] m (HashQualified name)
|
||||
hashQualifiedP nameP =
|
||||
P.try do
|
||||
optional ShortHash.shortHashP >>= \case
|
||||
Nothing -> HQ'.toHQ <$> HQ'.hashQualifiedP nameP
|
||||
Just hash -> pure (HashOnly hash)
|
||||
|
@ -8,8 +8,6 @@ module Unison.Syntax.Lexer
|
||||
Pos (..),
|
||||
Lexeme (..),
|
||||
lexer,
|
||||
simpleWordyId,
|
||||
simpleSymbolyId,
|
||||
line,
|
||||
column,
|
||||
escapeChars,
|
||||
@ -49,9 +47,9 @@ import Unison.NameSegment (NameSegment)
|
||||
import Unison.NameSegment qualified as NameSegment
|
||||
import Unison.Prelude
|
||||
import Unison.ShortHash (ShortHash)
|
||||
import Unison.Syntax.HashQualified' qualified as HQ' (toString)
|
||||
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, unsafeFromString)
|
||||
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.ReservedWords (delimiters, typeModifiers, typeOrAbility)
|
||||
@ -290,7 +288,7 @@ lexer0' scope rem =
|
||||
| notLayout t1 && touches t1 t2 && isSigned num =
|
||||
t1
|
||||
: Token
|
||||
(SymbolyId (HQ'.fromName (Name.unsafeFromString (take 1 num))))
|
||||
(SymbolyId (HQ'.fromName (Name.unsafeParseText (Text.pack (take 1 num)))))
|
||||
(start t2)
|
||||
(inc $ start t2)
|
||||
: Token (Numeric (drop 1 num)) (inc $ start t2) (end t2)
|
||||
@ -1129,14 +1127,6 @@ findClose :: [String] -> Layout -> Maybe (String, Int)
|
||||
findClose _ [] = Nothing
|
||||
findClose s ((h, _) : tl) = if h `elem` s then Just (h, 1) else fmap (1 +) <$> findClose s tl
|
||||
|
||||
simpleWordyId :: Name -> Lexeme
|
||||
simpleWordyId name =
|
||||
WordyId (HQ'.fromName name)
|
||||
|
||||
simpleSymbolyId :: Name -> Lexeme
|
||||
simpleSymbolyId name =
|
||||
SymbolyId (HQ'.fromName name)
|
||||
|
||||
notLayout :: Token Lexeme -> Bool
|
||||
notLayout t = case payload t of
|
||||
Close -> False
|
||||
@ -1324,8 +1314,8 @@ instance P.VisualStream [Token Lexeme] where
|
||||
case showEscapeChar c of
|
||||
Just c -> "?\\" ++ [c]
|
||||
Nothing -> '?' : [c]
|
||||
pretty (WordyId n) = HQ'.toString n
|
||||
pretty (SymbolyId n) = HQ'.toString n
|
||||
pretty (WordyId n) = Text.unpack (HQ'.toText n)
|
||||
pretty (SymbolyId n) = Text.unpack (HQ'.toText n)
|
||||
pretty (Blank s) = "_" ++ s
|
||||
pretty (Numeric n) = n
|
||||
pretty (Hash sh) = show sh
|
||||
|
@ -3,15 +3,13 @@
|
||||
-- | Utilities related to the parsing and printing of names using the default syntax.
|
||||
module Unison.Syntax.Name
|
||||
( -- * String conversions
|
||||
unsafeFromString,
|
||||
toString,
|
||||
fromText,
|
||||
fromTextEither,
|
||||
unsafeFromText,
|
||||
parseText,
|
||||
parseTextEither,
|
||||
unsafeParseText,
|
||||
toText,
|
||||
unsafeFromVar,
|
||||
unsafeParseVar,
|
||||
parseVar,
|
||||
toVar,
|
||||
fromVar,
|
||||
|
||||
-- * Name parsers
|
||||
nameP,
|
||||
@ -35,35 +33,50 @@ import Text.Megaparsec.Internal qualified as P (withParsecT)
|
||||
import Unison.Name qualified as Name (fromSegments, lastSegment, makeAbsolute)
|
||||
import Unison.Name.Internal (Name (Name))
|
||||
import Unison.NameSegment (NameSegment)
|
||||
import Unison.NameSegment qualified as NameSegment
|
||||
import Unison.Position (Position (..))
|
||||
import Unison.Prelude
|
||||
import Unison.Syntax.Lexer.Token (Token)
|
||||
import Unison.Syntax.NameSegment (segmentStartChar)
|
||||
import Unison.Syntax.NameSegment qualified as NameSegment (ParseErr, isSymboly, renderParseErr, segmentP)
|
||||
import Unison.Syntax.NameSegment qualified as NameSegment
|
||||
( ParseErr,
|
||||
isSymboly,
|
||||
renderParseErr,
|
||||
segmentP,
|
||||
toEscapedTextBuilder,
|
||||
)
|
||||
import Unison.Var (Var)
|
||||
import Unison.Var qualified as Var
|
||||
|
||||
------------------------------------------------------------------------------------------------------------------------
|
||||
-- String conversions
|
||||
|
||||
instance IsString Name where
|
||||
fromString =
|
||||
unsafeFromString
|
||||
-- | Parse a name from a string literal.
|
||||
parseText :: Text -> Maybe Name
|
||||
parseText =
|
||||
eitherToMaybe . parseTextEither
|
||||
|
||||
-- | Convert a name to a string representation.
|
||||
toString :: Name -> String
|
||||
toString =
|
||||
Text.unpack . toText
|
||||
-- | Parse a name from a string literal.
|
||||
parseTextEither :: Text -> Either Text Name
|
||||
parseTextEither s =
|
||||
P.runParser (P.withParsecT (fmap NameSegment.renderParseErr) nameP <* P.eof) "" (Text.unpack s)
|
||||
& mapLeft (Text.pack . P.errorBundlePretty)
|
||||
|
||||
-- | Unsafely parse a name from a string literal.
|
||||
--
|
||||
-- Performs very minor validation (a name can't be empty, nor contain a '#' character [at least currently?]) but makes
|
||||
-- no attempt at rejecting bogus names like "foo...bar...baz".
|
||||
unsafeParseText :: (HasCallStack) => Text -> Name
|
||||
unsafeParseText =
|
||||
either (error . Text.unpack) id . parseTextEither
|
||||
|
||||
-- | Convert a name to a string representation.
|
||||
toText :: Name -> Text
|
||||
toText (Name pos (x0 :| xs)) =
|
||||
build (buildPos pos <> foldr step mempty xs <> NameSegment.toTextBuilder x0)
|
||||
build (buildPos pos <> foldr step mempty xs <> NameSegment.toEscapedTextBuilder x0)
|
||||
where
|
||||
step :: NameSegment -> Text.Builder -> Text.Builder
|
||||
step x acc =
|
||||
acc <> NameSegment.toTextBuilder x <> "."
|
||||
acc <> NameSegment.toEscapedTextBuilder x <> "."
|
||||
|
||||
build :: Text.Builder -> Text
|
||||
build =
|
||||
@ -74,56 +87,28 @@ toText (Name pos (x0 :| xs)) =
|
||||
Absolute -> "."
|
||||
Relative -> ""
|
||||
|
||||
-- | Parse a name from a var, by first rendering the var as a string.
|
||||
parseVar :: Var v => v -> Maybe Name
|
||||
parseVar =
|
||||
parseText . Var.name
|
||||
|
||||
-- | Unsafely parse a name from a var, by first rendering the var as a string.
|
||||
--
|
||||
-- See 'unsafeFromText'.
|
||||
unsafeParseVar :: (Var v) => v -> Name
|
||||
unsafeParseVar =
|
||||
unsafeParseText . Var.name
|
||||
|
||||
-- | Convert a name to a string representation, then parse that as a var.
|
||||
toVar :: (Var v) => Name -> v
|
||||
toVar =
|
||||
Var.named . toText
|
||||
|
||||
-- | Parse a name from a var, by first rendering the var as a string.
|
||||
fromVar :: Var v => v -> Maybe Name
|
||||
fromVar =
|
||||
fromText . Var.name
|
||||
|
||||
-- | Parse a name from a string literal.
|
||||
--
|
||||
-- Performs very minor validation (a name can't be empty, nor contain a '#' character [at least currently?]) but makes
|
||||
-- no attempt at rejecting bogus names like "foo...bar...baz".
|
||||
fromText :: Text -> Maybe Name
|
||||
fromText =
|
||||
eitherToMaybe . fromTextEither
|
||||
|
||||
-- | Parse a name from a string literal.
|
||||
fromTextEither :: Text -> Either Text Name
|
||||
fromTextEither s =
|
||||
P.runParser (P.withParsecT (fmap NameSegment.renderParseErr) nameP <* P.eof) "" (Text.unpack s)
|
||||
& mapLeft (Text.pack . P.errorBundlePretty)
|
||||
|
||||
-- | Unsafely parse a name from a string literal.
|
||||
-- See 'unsafeFromText'.
|
||||
unsafeFromString :: String -> Name
|
||||
unsafeFromString =
|
||||
unsafeFromText . Text.pack
|
||||
|
||||
-- | Unsafely parse a name from a string literal.
|
||||
--
|
||||
-- Performs very minor validation (a name can't be empty, nor contain a '#' character [at least currently?]) but makes
|
||||
-- no attempt at rejecting bogus names like "foo...bar...baz".
|
||||
unsafeFromText :: (HasCallStack) => Text -> Name
|
||||
unsafeFromText =
|
||||
either (error . Text.unpack) id . fromTextEither
|
||||
|
||||
-- | Unsafely parse a name from a var, by first rendering the var as a string.
|
||||
--
|
||||
-- See 'unsafeFromText'.
|
||||
unsafeFromVar :: (Var v) => v -> Name
|
||||
unsafeFromVar =
|
||||
unsafeFromText . Var.name
|
||||
|
||||
------------------------------------------------------------------------------------------------------------------------
|
||||
-- Name parsers
|
||||
|
||||
-- | A name parser.
|
||||
nameP :: forall m. Monad m => ParsecT (Token NameSegment.ParseErr) [Char] m Name
|
||||
nameP :: Monad m => ParsecT (Token NameSegment.ParseErr) [Char] m Name
|
||||
nameP =
|
||||
P.try do
|
||||
leadingDot <- isJust <$> P.optional (P.char '.')
|
||||
|
@ -2,8 +2,9 @@
|
||||
module Unison.Syntax.NameSegment
|
||||
( -- * String conversions
|
||||
toEscapedText,
|
||||
fromText,
|
||||
unsafeFromText,
|
||||
toEscapedTextBuilder,
|
||||
parseText,
|
||||
unsafeParseText,
|
||||
|
||||
-- * Name segment parsers
|
||||
isSymboly,
|
||||
@ -35,6 +36,8 @@ import Unison.NameSegment qualified as NameSegment
|
||||
import Unison.Prelude
|
||||
import Unison.Syntax.Lexer.Token (Token (..), posP)
|
||||
import Unison.Syntax.ReservedWords (keywords, reservedOperators)
|
||||
import Data.Text.Lazy.Builder qualified as Text.Builder
|
||||
import Data.Text.Lazy.Builder qualified as Text (Builder)
|
||||
|
||||
------------------------------------------------------------------------------------------------------------------------
|
||||
-- String conversions
|
||||
@ -47,21 +50,25 @@ toEscapedText segment@(NameSegment text)
|
||||
| isSymboly segment && not (Text.all symbolyIdChar text) = "`" <> text <> "`"
|
||||
| otherwise = text
|
||||
|
||||
-- | Convert text to a name segment.
|
||||
toEscapedTextBuilder :: NameSegment -> Text.Builder
|
||||
toEscapedTextBuilder =
|
||||
Text.Builder.fromText . toEscapedText
|
||||
|
||||
-- | Parse text as a name segment.
|
||||
--
|
||||
-- > fromText "foo" = Right (NameSegment "foo")
|
||||
-- > fromText ".~" = Left ...
|
||||
-- > fromText "`.~`" = Right (NameSegment ".~")
|
||||
fromText :: Text -> Either Text NameSegment
|
||||
fromText text =
|
||||
-- > parseText "foo" = Right (NameSegment "foo")
|
||||
-- > parseText ".~" = Left ...
|
||||
-- > parseText "`.~`" = Right (NameSegment ".~")
|
||||
parseText :: Text -> Either Text NameSegment
|
||||
parseText text =
|
||||
case P.runParser (P.withParsecT (fmap renderParseErr) (segmentP <* P.eof)) "" (Text.unpack text) of
|
||||
Left err -> Left (Text.pack (P.errorBundlePretty err))
|
||||
Right segment -> Right segment
|
||||
|
||||
-- | Convert text to a name segment.
|
||||
unsafeFromText :: Text -> NameSegment
|
||||
unsafeFromText =
|
||||
either (error . Text.unpack) id . fromText
|
||||
-- | Parse text as a name segment.
|
||||
unsafeParseText :: Text -> NameSegment
|
||||
unsafeParseText =
|
||||
either (error . Text.unpack) id . parseText
|
||||
|
||||
------------------------------------------------------------------------------------------------------------------------
|
||||
-- Name segment parsers
|
||||
|
@ -83,7 +83,7 @@ import Unison.Prelude
|
||||
import Unison.Reference (Reference)
|
||||
import Unison.Referent (Referent)
|
||||
import Unison.Syntax.Lexer qualified as L
|
||||
import Unison.Syntax.Name qualified as Name (toVar, unsafeFromString)
|
||||
import Unison.Syntax.Name qualified as Name (toVar, unsafeParseText)
|
||||
import Unison.Term (MatchCase (..))
|
||||
import Unison.UnisonFile.Error qualified as UF
|
||||
import Unison.Util.Bytes (Bytes)
|
||||
@ -313,7 +313,7 @@ wordyDefinitionName = queryToken $ \case
|
||||
importWordyId :: Ord v => P v m (L.Token Name)
|
||||
importWordyId = queryToken \case
|
||||
L.WordyId (HQ'.NameOnly n) -> Just n
|
||||
L.Blank s | not (null s) -> Just $ Name.unsafeFromString ("_" <> s)
|
||||
L.Blank s | not (null s) -> Just $ Name.unsafeParseText (Text.pack ("_" <> s))
|
||||
_ -> Nothing
|
||||
|
||||
-- The `+` in: use Foo.bar + as a Name
|
||||
@ -340,7 +340,7 @@ hqWordyId_ :: Ord v => P v m (L.Token (HQ.HashQualified Name))
|
||||
hqWordyId_ = queryToken \case
|
||||
L.WordyId n -> Just $ HQ'.toHQ n
|
||||
L.Hash h -> Just $ HQ.HashOnly h
|
||||
L.Blank s | not (null s) -> Just $ HQ.NameOnly (Name.unsafeFromString ("_" <> s))
|
||||
L.Blank s | not (null s) -> Just $ HQ.NameOnly (Name.unsafeParseText (Text.pack ("_" <> s)))
|
||||
_ -> Nothing
|
||||
|
||||
-- Parse a hash-qualified symboly ID like >>=#foo or &&
|
||||
|
@ -10,8 +10,9 @@ import Unison.HashQualified' qualified as HQ'
|
||||
import Unison.Prelude
|
||||
import Unison.ShortHash (ShortHash)
|
||||
import Unison.ShortHash qualified as ShortHash
|
||||
import Unison.Syntax.HashQualified' qualified as HQ' (unsafeParseText)
|
||||
import Unison.Syntax.Lexer
|
||||
import Unison.Syntax.Name qualified as Name (unsafeFromString)
|
||||
import Unison.Syntax.Name qualified as Name (unsafeParseText)
|
||||
|
||||
main :: IO ()
|
||||
main =
|
||||
@ -92,8 +93,8 @@ test =
|
||||
t ".Foo.`++`.+" [simpleSymbolyId ".Foo.`++`.+"],
|
||||
t ".Foo.`+.+`.+" [simpleSymbolyId ".Foo.`+.+`.+"],
|
||||
-- idents with hashes
|
||||
t "foo#bar" [WordyId (HQ'.HashQualified "foo" "#bar")],
|
||||
t "+#bar" [SymbolyId (HQ'.HashQualified "+" "#bar")],
|
||||
t "foo#bar" [simpleWordyId "foo#bar"],
|
||||
t "+#bar" [simpleSymbolyId "+#bar"],
|
||||
-- note - these are all the same, just with different spacing
|
||||
let ex1 = "if x then y else z"
|
||||
ex2 = unlines ["if", " x", "then", " y", "else z"]
|
||||
@ -201,7 +202,7 @@ test =
|
||||
suffix <- ["0", "x", "!", "'"] -- examples of wordyIdChar
|
||||
let i = kw ++ suffix
|
||||
-- a keyword at the front of an identifier should still be an identifier
|
||||
pure $ t i [simpleWordyId (Name.unsafeFromString i)],
|
||||
pure $ t i [simpleWordyId (Text.pack i)],
|
||||
-- Test string literals
|
||||
t
|
||||
"\"simple string without escape characters\""
|
||||
@ -226,5 +227,13 @@ t s expected =
|
||||
note $ "actual : " ++ show actual
|
||||
crash "actual != expected"
|
||||
|
||||
simpleSymbolyId :: Text -> Lexeme
|
||||
simpleSymbolyId =
|
||||
SymbolyId . HQ'.unsafeParseText
|
||||
|
||||
simpleWordyId :: Text -> Lexeme
|
||||
simpleWordyId =
|
||||
WordyId . HQ'.unsafeParseText
|
||||
|
||||
instance IsString ShortHash where
|
||||
fromString = fromJust . ShortHash.fromText . Text.pack
|
||||
|
Loading…
Reference in New Issue
Block a user