From 83f5e424e6937ce77fe236953dc47be2c8acd429 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Thu, 31 Aug 2023 12:45:31 -0400 Subject: [PATCH] Make Unison.Reference just re-export the type from U.Codebase.Reference --- codebase2/codebase/U/Codebase/Reference.hs | 71 --------- codebase2/codebase/unison-codebase.cabal | 1 - codebase2/core/U/Codebase/Reference.hs | 150 ++++++++++++++++++ codebase2/core/package.yaml | 7 +- codebase2/core/unison-core.cabal | 4 +- parser-typechecker/src/Unison/Runtime/ANF.hs | 2 +- .../src/Unison/Runtime/ANF/Serialize.hs | 2 +- .../src/Unison/Runtime/MCode.hs | 2 +- .../src/Unison/Runtime/Machine.hs | 2 +- .../src/Unison/Runtime/Pattern.hs | 2 +- .../src/Unison/Runtime/Serialize.hs | 2 +- .../src/Unison/Syntax/DeclPrinter.hs | 6 +- parser-typechecker/tests/Unison/Test/ANF.hs | 2 +- parser-typechecker/tests/Unison/Test/MCode.hs | 2 +- .../src/Unison/Codebase/Editor/HandleInput.hs | 2 +- .../Editor/HandleInput/NamespaceDiffUtils.hs | 2 +- .../Codebase/Editor/HandleInput/Update.hs | 2 +- .../src/Unison/Codebase/Editor/Propagate.hs | 15 +- unison-core/src/Unison/LabeledDependency.hs | 2 +- unison-core/src/Unison/Reference.hs | 127 +++++---------- 20 files changed, 220 insertions(+), 185 deletions(-) delete mode 100644 codebase2/codebase/U/Codebase/Reference.hs create mode 100644 codebase2/core/U/Codebase/Reference.hs diff --git a/codebase2/codebase/U/Codebase/Reference.hs b/codebase2/codebase/U/Codebase/Reference.hs deleted file mode 100644 index 9b466cf3f3..0000000000 --- a/codebase2/codebase/U/Codebase/Reference.hs +++ /dev/null @@ -1,71 +0,0 @@ -module U.Codebase.Reference where - -import Control.Lens (Lens, Prism, Traversal, lens, prism) -import Data.Bifoldable (Bifoldable (..)) -import Data.Bitraversable (Bitraversable (..)) -import Unison.Hash (Hash) -import Unison.Hash qualified as Hash -import Unison.Prelude -import Unison.ShortHash (ShortHash) -import Unison.ShortHash qualified as SH - --- | This is the canonical representation of Reference -type Reference = Reference' Text Hash - -type Id = Id' Hash - -data Reference' t h - = ReferenceBuiltin t - | ReferenceDerived (Id' h) - deriving (Eq, Ord, Show) - -_ReferenceDerived :: Prism (Reference' t h) (Reference' t h') (Id' h) (Id' h') -_ReferenceDerived = prism embed project - where - embed (Id h pos) = ReferenceDerived (Id h pos) - project (ReferenceDerived id') = Right id' - project (ReferenceBuiltin t) = Left (ReferenceBuiltin t) - -pattern Derived :: h -> Pos -> Reference' t h -pattern Derived h i = ReferenceDerived (Id h i) - -{-# COMPLETE ReferenceBuiltin, Derived #-} - -type Pos = Word64 - -data Id' h = Id h Pos - deriving (Eq, Ord, Show, Functor, Foldable, Traversable) - -t_ :: Traversal (Reference' t h) (Reference' t' h) t t' -t_ f = \case - ReferenceBuiltin t -> ReferenceBuiltin <$> f t - ReferenceDerived id -> pure (ReferenceDerived id) - -h_ :: Traversal (Reference' t h) (Reference' t h') h h' -h_ f = \case - ReferenceBuiltin t -> pure (ReferenceBuiltin t) - Derived h i -> Derived <$> f h <*> pure i - -idH :: Lens (Id' h) (Id' h') h h' -idH = lens (\(Id h _w) -> h) (\(Id _h w) h -> Id h w) - -isBuiltin :: Reference -> Bool -isBuiltin (ReferenceBuiltin _) = True -isBuiltin _ = False - -toShortHash :: Reference -> ShortHash -toShortHash (ReferenceBuiltin b) = SH.Builtin b -toShortHash (ReferenceDerived (Id h 0)) = SH.ShortHash (Hash.toBase32HexText h) Nothing Nothing -toShortHash (ReferenceDerived (Id h i)) = SH.ShortHash (Hash.toBase32HexText h) (Just i) Nothing - -instance Bifunctor Reference' where - bimap f _ (ReferenceBuiltin t) = ReferenceBuiltin (f t) - bimap _ g (ReferenceDerived id) = ReferenceDerived (g <$> id) - -instance Bifoldable Reference' where - bifoldMap f _ (ReferenceBuiltin t) = f t - bifoldMap _ g (ReferenceDerived id) = foldMap g id - -instance Bitraversable Reference' where - bitraverse f _ (ReferenceBuiltin t) = ReferenceBuiltin <$> f t - bitraverse _ g (ReferenceDerived id) = ReferenceDerived <$> traverse g id diff --git a/codebase2/codebase/unison-codebase.cabal b/codebase2/codebase/unison-codebase.cabal index 06b2ee6520..efb5bc3499 100644 --- a/codebase2/codebase/unison-codebase.cabal +++ b/codebase2/codebase/unison-codebase.cabal @@ -20,7 +20,6 @@ library U.Codebase.Causal U.Codebase.Decl U.Codebase.Kind - U.Codebase.Reference U.Codebase.Referent U.Codebase.Reflog U.Codebase.Term diff --git a/codebase2/core/U/Codebase/Reference.hs b/codebase2/core/U/Codebase/Reference.hs new file mode 100644 index 0000000000..6db7eb1cc7 --- /dev/null +++ b/codebase2/core/U/Codebase/Reference.hs @@ -0,0 +1,150 @@ +module U.Codebase.Reference + ( Reference, + RReference, + TermReference, + TermRReference, + TermReferenceId, + TypeReference, + TypeRReference, + TypeReferenceId, + Reference' (..), + pattern Derived, + Id, + Id' (..), + Pos, + _ReferenceDerived, + _RReferenceReference, + t_, + h_, + idH, + idToHash, + idToShortHash, + isBuiltin, + toShortHash, + toId, + unsafeId, + ) +where + +import Control.Lens (Lens, Prism, Prism', Traversal, lens, preview, prism) +import Data.Bifoldable (Bifoldable (..)) +import Data.Bitraversable (Bitraversable (..)) +import Data.Text qualified as Text +import Unison.Hash (Hash) +import Unison.Hash qualified as Hash +import Unison.Prelude +import Unison.ShortHash (ShortHash) +import Unison.ShortHash qualified as SH + +-- | This is the canonical representation of Reference +type Reference = Reference' Text Hash + +-- | A possibly-self (R = "recursive") reference. +type RReference = Reference' Text (Maybe Hash) + +-- | A term reference. +type TermReference = Reference + +-- | A possibly-self term reference. +type TermRReference = RReference + +-- | A type declaration reference. +type TypeReference = Reference + +-- | A possibly-self type declaration reference. +type TypeRReference = RReference + +type Id = Id' Hash + +-- | A term reference id. +type TermReferenceId = Id + +-- | A type declaration reference id. +type TypeReferenceId = Id + +-- | Either a builtin or a user defined (hashed) top-level declaration. Used for both terms and types. +data Reference' t h + = ReferenceBuiltin t + | ReferenceDerived (Id' h) + deriving stock (Eq, Generic, Ord, Show) + +_RReferenceReference :: Prism' (Reference' t (Maybe h)) (Reference' t h) +_RReferenceReference = prism embed project + where + embed = \case + ReferenceBuiltin x -> ReferenceBuiltin x + ReferenceDerived (Id h p) -> ReferenceDerived (Id (Just h) p) + + project = \case + ReferenceBuiltin x -> Right (ReferenceBuiltin x) + ReferenceDerived (Id mh p) -> case mh of + Nothing -> Left (ReferenceDerived (Id mh p)) + Just h -> Right (ReferenceDerived (Id h p)) + +_ReferenceDerived :: Prism (Reference' t h) (Reference' t h') (Id' h) (Id' h') +_ReferenceDerived = prism embed project + where + embed (Id h pos) = ReferenceDerived (Id h pos) + project (ReferenceDerived id') = Right id' + project (ReferenceBuiltin t) = Left (ReferenceBuiltin t) + +pattern Derived :: h -> Pos -> Reference' t h +pattern Derived h i = ReferenceDerived (Id h i) + +{-# COMPLETE ReferenceBuiltin, Derived #-} + +type Pos = Word64 + +-- | @Pos@ is a position into a cycle, as cycles are hashed together. +data Id' h = Id h Pos + deriving stock (Eq, Ord, Show, Functor, Foldable, Traversable) + +t_ :: Traversal (Reference' t h) (Reference' t' h) t t' +t_ f = \case + ReferenceBuiltin t -> ReferenceBuiltin <$> f t + ReferenceDerived id -> pure (ReferenceDerived id) + +h_ :: Traversal (Reference' t h) (Reference' t h') h h' +h_ f = \case + ReferenceBuiltin t -> pure (ReferenceBuiltin t) + Derived h i -> Derived <$> f h <*> pure i + +idH :: Lens (Id' h) (Id' h') h h' +idH = lens (\(Id h _w) -> h) (\(Id _h w) h -> Id h w) + +idToHash :: Id -> Hash +idToHash (Id h _) = h + +idToShortHash :: Id -> ShortHash +idToShortHash = toShortHash . ReferenceDerived + +isBuiltin :: Reference -> Bool +isBuiltin (ReferenceBuiltin _) = True +isBuiltin _ = False + +toId :: Reference -> Maybe Id +toId = + preview _ReferenceDerived + +toShortHash :: Reference -> ShortHash +toShortHash = \case + ReferenceBuiltin b -> SH.Builtin b + ReferenceDerived (Id h 0) -> SH.ShortHash (Hash.toBase32HexText h) Nothing Nothing + ReferenceDerived (Id h i) -> SH.ShortHash (Hash.toBase32HexText h) (Just i) Nothing + +unsafeId :: Reference -> Id +unsafeId = \case + ReferenceBuiltin b -> error $ "Tried to get the hash of builtin " <> Text.unpack b <> "." + ReferenceDerived x -> x + +instance Bifunctor Reference' where + bimap f _ (ReferenceBuiltin t) = ReferenceBuiltin (f t) + bimap _ g (ReferenceDerived id) = ReferenceDerived (g <$> id) + +instance Bifoldable Reference' where + bifoldMap f _ (ReferenceBuiltin t) = f t + bifoldMap _ g (ReferenceDerived id) = foldMap g id + +instance Bitraversable Reference' where + bitraverse f _ (ReferenceBuiltin t) = ReferenceBuiltin <$> f t + bitraverse _ g (ReferenceDerived id) = ReferenceDerived <$> traverse g id diff --git a/codebase2/core/package.yaml b/codebase2/core/package.yaml index e9d4311b06..694c6e0466 100644 --- a/codebase2/core/package.yaml +++ b/codebase2/core/package.yaml @@ -10,13 +10,14 @@ library: dependencies: - base - containers + - lens + - recover-rtti - rfc5051 - text - - vector - - recover-rtti - unison-hash - unison-prelude - unison-util-base32hex + - vector default-extensions: - ApplicativeDo @@ -37,8 +38,8 @@ default-extensions: - MultiParamTypeClasses - NamedFieldPuns - OverloadedStrings - - QuantifiedConstraints - PatternSynonyms + - QuantifiedConstraints - RankNTypes - ScopedTypeVariables - StandaloneDeriving diff --git a/codebase2/core/unison-core.cabal b/codebase2/core/unison-core.cabal index c748bc9e57..fca570ab4e 100644 --- a/codebase2/core/unison-core.cabal +++ b/codebase2/core/unison-core.cabal @@ -17,6 +17,7 @@ source-repository head library exposed-modules: U.Codebase.HashTags + U.Codebase.Reference U.Core.ABT U.Core.ABT.Var Unison.Core.Project @@ -44,8 +45,8 @@ library MultiParamTypeClasses NamedFieldPuns OverloadedStrings - QuantifiedConstraints PatternSynonyms + QuantifiedConstraints RankNTypes ScopedTypeVariables StandaloneDeriving @@ -55,6 +56,7 @@ library build-depends: base , containers + , lens , recover-rtti , rfc5051 , text diff --git a/parser-typechecker/src/Unison/Runtime/ANF.hs b/parser-typechecker/src/Unison/Runtime/ANF.hs index 5330db6225..135a8fa6b1 100644 --- a/parser-typechecker/src/Unison/Runtime/ANF.hs +++ b/parser-typechecker/src/Unison/Runtime/ANF.hs @@ -100,7 +100,7 @@ import Unison.Hashing.V2.Convert (hashTermComponentsWithoutTypes) import Unison.Pattern (SeqOp (..)) import Unison.Pattern qualified as P import Unison.Prelude hiding (Text) -import Unison.Reference (Id, Reference (..)) +import Unison.Reference (Id, Reference, Reference' (Builtin, DerivedId)) import Unison.Referent (Referent, pattern Con, pattern Ref) import Unison.Symbol (Symbol) import Unison.Term hiding (List, Ref, Text, float, fresh, resolve) diff --git a/parser-typechecker/src/Unison/Runtime/ANF/Serialize.hs b/parser-typechecker/src/Unison/Runtime/ANF/Serialize.hs index 63936031b3..2c09e07df0 100644 --- a/parser-typechecker/src/Unison/Runtime/ANF/Serialize.hs +++ b/parser-typechecker/src/Unison/Runtime/ANF/Serialize.hs @@ -21,7 +21,7 @@ import Data.Text (Text) import Data.Word (Word16, Word32, Word64) import GHC.Stack import Unison.ABT.Normalized (Term (..)) -import Unison.Reference (Reference (Builtin), pattern Derived) +import Unison.Reference (Reference, Reference' (Builtin), pattern Derived) import Unison.Runtime.ANF as ANF hiding (Tag) import Unison.Runtime.Exception import Unison.Runtime.Serialize diff --git a/parser-typechecker/src/Unison/Runtime/MCode.hs b/parser-typechecker/src/Unison/Runtime/MCode.hs index 7264da3b01..9e6cef5196 100644 --- a/parser-typechecker/src/Unison/Runtime/MCode.hs +++ b/parser-typechecker/src/Unison/Runtime/MCode.hs @@ -46,7 +46,7 @@ import Data.Primitive.PrimArray import Data.Word (Word16, Word64) import GHC.Stack (HasCallStack) import Unison.ABT.Normalized (pattern TAbss) -import Unison.Reference (Reference (..)) +import Unison.Reference (Reference) import Unison.Referent (Referent) import Unison.Runtime.ANF ( ANormal, diff --git a/parser-typechecker/src/Unison/Runtime/Machine.hs b/parser-typechecker/src/Unison/Runtime/Machine.hs index fb28d0e961..f276c5fcd4 100644 --- a/parser-typechecker/src/Unison/Runtime/Machine.hs +++ b/parser-typechecker/src/Unison/Runtime/Machine.hs @@ -27,7 +27,7 @@ import Unison.Builtin.Decls (exceptionRef, ioFailureRef) import Unison.Builtin.Decls qualified as Rf import Unison.ConstructorReference qualified as CR import Unison.Prelude hiding (Text) -import Unison.Reference (Reference (Builtin), toShortHash) +import Unison.Reference (Reference, Reference' (Builtin), toShortHash) import Unison.Referent (pattern Con, pattern Ref) import Unison.Runtime.ANF as ANF ( CompileExn (..), diff --git a/parser-typechecker/src/Unison/Runtime/Pattern.hs b/parser-typechecker/src/Unison/Runtime/Pattern.hs index 904de8ef3c..977aa0f6a0 100644 --- a/parser-typechecker/src/Unison/Runtime/Pattern.hs +++ b/parser-typechecker/src/Unison/Runtime/Pattern.hs @@ -38,7 +38,7 @@ import Unison.ConstructorReference qualified as ConstructorReference import Unison.DataDeclaration (declFields) import Unison.Pattern import Unison.Pattern qualified as P -import Unison.Reference (Reference (..)) +import Unison.Reference (Reference, Reference' (Builtin, DerivedId)) import Unison.Runtime.ANF (internalBug) import Unison.Term hiding (Term, matchPattern) import Unison.Term qualified as Tm diff --git a/parser-typechecker/src/Unison/Runtime/Serialize.hs b/parser-typechecker/src/Unison/Runtime/Serialize.hs index 729475dac2..2e43eff276 100644 --- a/parser-typechecker/src/Unison/Runtime/Serialize.hs +++ b/parser-typechecker/src/Unison/Runtime/Serialize.hs @@ -25,7 +25,7 @@ import Unison.ConstructorReference (ConstructorReference, GConstructorReference import Unison.ConstructorType qualified as CT import Unison.Hash (Hash) import Unison.Hash qualified as Hash -import Unison.Reference (Id (..), Reference (..), pattern Derived) +import Unison.Reference (Id' (..), Reference, Reference' (Builtin, DerivedId), pattern Derived) import Unison.Referent (Referent, pattern Con, pattern Ref) import Unison.Runtime.Exception import Unison.Runtime.MCode diff --git a/parser-typechecker/src/Unison/Syntax/DeclPrinter.hs b/parser-typechecker/src/Unison/Syntax/DeclPrinter.hs index f20c82d17a..46f63ddd8c 100644 --- a/parser-typechecker/src/Unison/Syntax/DeclPrinter.hs +++ b/parser-typechecker/src/Unison/Syntax/DeclPrinter.hs @@ -18,7 +18,7 @@ import Unison.PrettyPrintEnv (PrettyPrintEnv) import Unison.PrettyPrintEnv qualified as PPE import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl (..)) import Unison.PrettyPrintEnvDecl qualified as PPED -import Unison.Reference (Reference (DerivedId)) +import Unison.Reference (Reference, Reference' (DerivedId)) import Unison.Referent qualified as Referent import Unison.Result qualified as Result import Unison.Syntax.HashQualified qualified as HQ (toString, toVar, unsafeFromString) @@ -76,7 +76,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 :: @@ -130,7 +130,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 diff --git a/parser-typechecker/tests/Unison/Test/ANF.hs b/parser-typechecker/tests/Unison/Test/ANF.hs index 24ae2e6d0e..c3340f123c 100644 --- a/parser-typechecker/tests/Unison/Test/ANF.hs +++ b/parser-typechecker/tests/Unison/Test/ANF.hs @@ -13,7 +13,7 @@ import Unison.ABT qualified as ABT import Unison.ABT.Normalized (Term (TAbs)) import Unison.ConstructorReference (GConstructorReference (..)) import Unison.Pattern qualified as P -import Unison.Reference (Reference (Builtin)) +import Unison.Reference (Reference, Reference' (Builtin)) import Unison.Runtime.ANF as ANF import Unison.Runtime.MCode (RefNums (..), emitCombs) import Unison.Term qualified as Term diff --git a/parser-typechecker/tests/Unison/Test/MCode.hs b/parser-typechecker/tests/Unison/Test/MCode.hs index 8ec499d15f..8d28b0765a 100644 --- a/parser-typechecker/tests/Unison/Test/MCode.hs +++ b/parser-typechecker/tests/Unison/Test/MCode.hs @@ -8,7 +8,7 @@ module Unison.Test.MCode where import Control.Concurrent.STM import Data.Map.Strict qualified as Map import EasyTest -import Unison.Reference (Reference (Builtin)) +import Unison.Reference (Reference, Reference' (Builtin)) import Unison.Runtime.ANF ( SuperGroup (..), lamLift, diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 64d666367a..56a7efe78d 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -151,7 +151,7 @@ import Unison.PrettyPrintEnvDecl qualified as PPE hiding (biasTo, empty) import Unison.PrettyPrintEnvDecl qualified as PPED import Unison.PrettyPrintEnvDecl.Names qualified as PPED import Unison.Project (ProjectBranchNameOrLatestRelease (..)) -import Unison.Reference (Reference (..), TermReference) +import Unison.Reference (Reference, TermReference) import Unison.Reference qualified as Reference import Unison.Referent (Referent) import Unison.Referent qualified as Referent diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDiffUtils.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDiffUtils.hs index 26e681619b..45574bc608 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDiffUtils.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDiffUtils.hs @@ -24,7 +24,7 @@ import Unison.Parser.Ann (Ann (..)) import Unison.Prelude import Unison.PrettyPrintEnv qualified as PPE import Unison.PrettyPrintEnvDecl qualified as PPE hiding (biasTo) -import Unison.Reference (Reference (..)) +import Unison.Reference (Reference) import Unison.Reference qualified as Reference import Unison.Server.Backend qualified as Backend import Unison.Sqlite qualified as Sqlite diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update.hs index d9fabd9bc5..95d18c4689 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update.hs @@ -49,7 +49,7 @@ import Unison.Names qualified as Names import Unison.Parser.Ann (Ann (..)) import Unison.Prelude import Unison.PrettyPrintEnvDecl qualified as PPE hiding (biasTo) -import Unison.Reference (Reference (..), TermReference, TermReferenceId, TypeReference, TypeReferenceId) +import Unison.Reference (Reference, TermReference, TermReferenceId, TypeReference, TypeReferenceId) import Unison.Reference qualified as Reference import Unison.Referent (Referent) import Unison.Referent qualified as Referent diff --git a/unison-cli/src/Unison/Codebase/Editor/Propagate.hs b/unison-cli/src/Unison/Codebase/Editor/Propagate.hs index f13f4b2095..ea8344c784 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Propagate.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Propagate.hs @@ -10,6 +10,7 @@ import Control.Monad.Reader (ask) import Data.Graph qualified as Graph import Data.Map qualified as Map import Data.Set qualified as Set +import U.Codebase.Reference qualified as Reference import U.Codebase.Sqlite.Queries qualified as Queries import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli @@ -42,7 +43,7 @@ import Unison.Names (Names) import Unison.Names qualified as Names import Unison.Parser.Ann (Ann (..)) import Unison.Prelude -import Unison.Reference (Reference (..), TermReference, TypeReference) +import Unison.Reference (Reference, Reference' (..), TermReference, TypeReference) import Unison.Reference qualified as Reference import Unison.Referent (Referent) import Unison.Referent qualified as Referent @@ -295,8 +296,8 @@ propagate patch b = case validatePatch patch of collectEdits es@Edits {..} seen todo = case Map.minView todo of Nothing -> pure es Just (r, todo) -> case r of - Reference.Builtin _ -> collectEdits es seen todo - Reference.DerivedId _ -> go r todo + ReferenceBuiltin _ -> collectEdits es seen todo + ReferenceDerived _ -> go r todo where debugCtors = unlines @@ -323,7 +324,7 @@ propagate patch b = case validatePatch patch of (Just edits', seen') -> do -- plan to update the dependents of this component too dependents <- case r of - Reference.Builtin {} -> Codebase.dependents Queries.ExcludeOwnComponent r + ReferenceBuiltin {} -> Codebase.dependents Queries.ExcludeOwnComponent r Reference.Derived h _i -> Codebase.dependentsOfComponent h let todo' = todo <> getOrdered dependents collectEdits edits' seen' todo' @@ -372,7 +373,7 @@ propagate patch b = case validatePatch patch of ) seen' = seen <> Set.fromList (view _1 . view _2 <$> joinedStuff) writeTypes = traverse_ $ \case - (Reference.DerivedId id, tp) -> Codebase.putTypeDeclaration codebase id tp + (ReferenceDerived id, tp) -> Codebase.putTypeDeclaration codebase id tp _ -> error "propagate: Expected DerivedId" !newCtorMappings = let r = propagateCtorMapping componentMap hashedComponents' @@ -432,7 +433,7 @@ propagate patch b = case validatePatch patch of toNewTerm (_, r', tm, _, tp) = (r', (tm, tp)) writeTerms = traverse_ \case - (Reference.DerivedId id, (tm, tp)) -> Codebase.putTerm codebase id tm tp + (ReferenceDerived id, (tm, tp)) -> Codebase.putTerm codebase id tm tp _ -> error "propagate: Expected DerivedId" writeTerms [(r, (tm, ty)) | (_old, r, tm, _oldTy, ty) <- joinedStuff] @@ -501,7 +502,7 @@ propagate patch b = case validatePatch patch of Nothing -> pure mempty Just r -> do unhashed <- unhashTermComponent' codebase (Reference.idToHash r) - pure $ fmap (over _1 Reference.DerivedId) unhashed + pure $ fmap (over _1 ReferenceDerived) unhashed unhashTermComponent' :: Codebase m Symbol Ann -> diff --git a/unison-core/src/Unison/LabeledDependency.hs b/unison-core/src/Unison/LabeledDependency.hs index e976b14ae1..0f17f18387 100644 --- a/unison-core/src/Unison/LabeledDependency.hs +++ b/unison-core/src/Unison/LabeledDependency.hs @@ -21,7 +21,7 @@ import Data.Set qualified as Set import Unison.ConstructorReference (ConstructorReference) import Unison.ConstructorType (ConstructorType (Data, Effect)) import Unison.Prelude hiding (fold) -import Unison.Reference (Id, Reference (DerivedId)) +import Unison.Reference (Id, Reference, Reference' (DerivedId)) import Unison.Referent (Referent) import Unison.Referent qualified as Referent diff --git a/unison-core/src/Unison/Reference.hs b/unison-core/src/Unison/Reference.hs index c7643000ff..d66eea09cd 100644 --- a/unison-core/src/Unison/Reference.hs +++ b/unison-core/src/Unison/Reference.hs @@ -2,11 +2,16 @@ module Unison.Reference ( Reference, - pattern Builtin, - pattern Derived, - pattern DerivedId, + Reference' + ( ReferenceBuiltin, + ReferenceDerived, + Builtin, + DerivedId, + Derived + ), _DerivedId, - Id (..), + Id, + Id' (..), Pos, CycleSize, Size, @@ -21,9 +26,7 @@ module Unison.Reference componentFor, componentFromLength, unsafeFromText, - idFromText, isPrefixOf, - fromShortHash, fromText, readSuffix, showShort, @@ -47,80 +50,44 @@ import Data.Generics.Sum (_Ctor) import Data.Map qualified as Map import Data.Set qualified as Set import Data.Text qualified as Text +import U.Codebase.Reference + ( Id, + Id' (..), + Reference, + Reference' (..), + TermReference, + TermReferenceId, + TypeReference, + TypeReferenceId, + idToHash, + idToShortHash, + isBuiltin, + toId, + toShortHash, + unsafeId, + pattern Derived, + ) import Unison.Hash qualified as H import Unison.Prelude import Unison.ShortHash (ShortHash) import Unison.ShortHash qualified as SH --- | Either a builtin or a user defined (hashed) top-level declaration. --- --- Used for both terms and types. Doesn't distinguish between them. --- --- Other used defined things like local variables don't get @Reference@s. -data Reference - = -- A builtin, e.g. (Builtin "Nat") - Builtin Text.Text - | -- `Derived` can be part of a strongly connected component. - -- The `Pos` refers to a particular element of the component - -- and the `Size` is the number of elements in the component. - -- Using an ugly name so no one tempted to use this - DerivedId Id - deriving (Eq, Ord, Generic) - -pattern Derived :: H.Hash -> Pos -> Reference -pattern Derived h i = DerivedId (Id h i) - -{-# COMPLETE Builtin, Derived #-} - -_DerivedId :: Prism' Reference Id -_DerivedId = _Ctor @"DerivedId" - -isBuiltin :: Reference -> Bool -isBuiltin (Builtin _) = True -isBuiltin _ = False - --- | @Pos@ is a position into a cycle, as cycles are hashed together. -data Id = Id H.Hash Pos deriving (Eq, Ord) - --- | A term reference. -type TermReference = Reference - -type TermReferenceId = Id +pattern Builtin :: t -> Reference' t h +pattern Builtin x = ReferenceBuiltin x --- | A type declaration reference. -type TypeReference = Reference +pattern DerivedId :: Id' h -> Reference' t h +pattern DerivedId x = ReferenceDerived x -type TypeReferenceId = Id +{-# COMPLETE Builtin, DerivedId #-} -unsafeId :: Reference -> Id -unsafeId (Builtin b) = - error $ "Tried to get the hash of builtin " <> Text.unpack b <> "." -unsafeId (DerivedId x) = x - -idToHash :: Id -> H.Hash -idToHash (Id h _) = h +{-# COMPLETE Builtin, Derived #-} -idToShortHash :: Id -> ShortHash -idToShortHash = toShortHash . DerivedId +{-# COMPLETE Builtin, ReferenceDerived #-} --- but Show Reference currently depends on SH -toShortHash :: Reference -> ShortHash -toShortHash (Builtin b) = SH.Builtin b -toShortHash (Derived h 0) = SH.ShortHash (H.toBase32HexText h) Nothing Nothing -toShortHash (Derived h i) = SH.ShortHash (H.toBase32HexText h) (Just i) Nothing +{-# COMPLETE ReferenceBuiltin, DerivedId #-} --- toShortHash . fromJust . fromShortHash == id and --- fromJust . fromShortHash . toShortHash == id --- but for arbitrary ShortHashes which may be broken at the wrong boundary, it --- may not be possible to base32Hex decode them. These will return Nothing. --- Also, ShortHashes that include constructor ids will return Nothing; --- try Referent.fromShortHash -fromShortHash :: ShortHash -> Maybe Reference -fromShortHash (SH.Builtin b) = Just (Builtin b) -fromShortHash (SH.ShortHash prefix cycle Nothing) = do - h <- H.fromBase32HexText prefix - Just (Derived h (fromMaybe 0 cycle)) -fromShortHash (SH.ShortHash _prefix _cycle (Just _cid)) = Nothing +_DerivedId :: Prism' Reference Id +_DerivedId = _Ctor @"ReferenceDerived" showSuffix :: Pos -> Text showSuffix = Text.pack . show @@ -140,7 +107,7 @@ toText :: Reference -> Text toText = SH.toText . toShortHash idToText :: Id -> Text -idToText = toText . DerivedId +idToText = toText . ReferenceDerived showShort :: Int -> Reference -> Text showShort numHashChars = SH.toText . SH.shortenTo numHashChars . toShortHash @@ -159,25 +126,15 @@ componentFromLength :: H.Hash -> CycleSize -> Set Id componentFromLength h size = Set.fromList [Id h i | i <- [0 .. size - 1]] derivedBase32Hex :: Text -> Pos -> Maybe Reference -derivedBase32Hex b32Hex i = mayH <&> \h -> DerivedId (Id h i) +derivedBase32Hex b32Hex i = mayH <&> \h -> Derived h i where mayH = H.fromBase32HexText b32Hex unsafeFromText :: Text -> Reference unsafeFromText = either error id . fromText -idFromText :: Text -> Maybe Id -idFromText s = case fromText s of - Left _ -> Nothing - Right (Builtin _) -> Nothing - Right (DerivedId id) -> pure id - -toId :: Reference -> Maybe Id -toId (DerivedId id) = Just id -toId Builtin {} = Nothing - fromId :: Id -> Reference -fromId = DerivedId +fromId = ReferenceDerived toHash :: Reference -> Maybe H.Hash toHash r = idToHash <$> toId r @@ -203,7 +160,7 @@ toHash r = idToHash <$> toId r -- Left "Invalid hash: \"invalid_hash\"" fromText :: Text -> Either String Reference fromText t = case Text.split (== '#') t of - [_, "", b] -> Right (Builtin b) + [_, "", b] -> Right (ReferenceBuiltin b) [_, h] -> case Text.split (== '.') h of [hash] -> case derivedBase32Hex hash 0 of @@ -233,7 +190,3 @@ groupByComponent refs = done $ foldl' insert Map.empty refs insert m (k, r) = Map.unionWith (<>) m (Map.fromList [(Left r, [(k, r)])]) done m = sortOn snd <$> toList m - -instance Show Id where show = Text.unpack . SH.toText . SH.shortenTo 5 . toShortHash . DerivedId - -instance Show Reference where show = Text.unpack . SH.toText . SH.shortenTo 5 . toShortHash