Remove a very lawless type class

`Convert` mostly just hides some rather unsavory (but at least not partial) mappings between types.
2024-09-11 10:35:57 +03:00 · 2024-06-21 01:42:26 -04:00 · 2024-06-21 01:42:26 -04:00 · 91dc53d246
commit 91dc53d246
parent 25c4e6ebfc
13 changed files with 36 additions and 81 deletions
--- a/parser-typechecker/src/Unison/Codebase/Path.hs
+++ b/parser-typechecker/src/Unison/Codebase/Path.hs
@ -43,7 +43,7 @@ module Unison.Codebase.Path
    isRoot,
    isRoot',

-    -- * things that could be replaced with `Convert` instances
+    -- * conversions
    absoluteToPath',
    fromList,
    fromName,
@ -76,8 +76,6 @@ module Unison.Codebase.Path
    -- * things that could be replaced with `Snoc` instances
    snoc,
    unsnoc,
-    -- This should be moved to a common util module, or we could use the 'witch' package.
-    Convert (..),
  )
 where

@ -93,7 +91,7 @@ import Data.Sequence qualified as Seq
 import Data.Text qualified as Text
 import GHC.Exts qualified as GHC
 import Unison.HashQualified' qualified as HQ'
-import Unison.Name (Convert (..), Name)
+import Unison.Name (Name)
 import Unison.Name qualified as Name
 import Unison.NameSegment (NameSegment)
 import Unison.Prelude hiding (empty, toList)
@ -534,34 +532,3 @@ instance Resolve Absolute HQSplit HQSplitAbsolute where
 instance Resolve Absolute Path' Absolute where
  resolve _ (AbsolutePath' a) = a
  resolve a (RelativePath' r) = resolve a r
-
-instance Convert Absolute Path where convert = unabsolute
-
-instance Convert Absolute Path' where convert = absoluteToPath'
-
-instance Convert Absolute Text where convert = toText' . absoluteToPath'
-
-instance Convert Relative Text where convert = toText . unrelative
-
-instance Convert Absolute String where convert = Text.unpack . convert
-
-instance Convert Relative String where convert = Text.unpack . convert
-
-instance Convert [NameSegment] Path where convert = fromList
-
-instance Convert Path [NameSegment] where convert = toList
-
-instance Convert HQSplit (HQ'.HashQualified Path) where convert = unsplitHQ
-
-instance Convert HQSplit' (HQ'.HashQualified Path') where convert = unsplitHQ'
-
-instance Convert Name Split where
-  convert = splitFromName
-
-instance Convert (path, NameSegment) (path, HQ'.HQSegment) where
-  convert (path, name) =
-    (path, HQ'.fromName name)
-
-instance (Convert path0 path1) => Convert (path0, name) (path1, name) where
-  convert =
-    over _1 convert
--- a/unison-cli/src/Unison/Cli/MonadUtils.hs
+++ b/unison-cli/src/Unison/Cli/MonadUtils.hs
@ -481,7 +481,7 @@ updateRoot new reason =
 getTermsAt :: (Path.Absolute, HQ'.HQSegment) -> Cli (Set Referent)
 getTermsAt path = do
  rootBranch0 <- getRootBranch0
-  pure (BranchUtil.getTerm (Path.convert path) rootBranch0)
+  pure (BranchUtil.getTerm (first Path.unabsolute path) rootBranch0)

 ------------------------------------------------------------------------------------------------------------------------
 -- Getting types
@ -489,7 +489,7 @@ getTermsAt path = do
 getTypesAt :: (Path.Absolute, HQ'.HQSegment) -> Cli (Set TypeReference)
 getTypesAt path = do
  rootBranch0 <- getRootBranch0
-  pure (BranchUtil.getType (Path.convert path) rootBranch0)
+  pure (BranchUtil.getType (first Path.unabsolute path) rootBranch0)

 ------------------------------------------------------------------------------------------------------------------------
 -- Getting patches
--- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs
+++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs
@ -352,7 +352,7 @@ loop e = do
                  Left hash -> (,WhichBranchEmptyHash hash) <$> Cli.resolveShortCausalHash hash
                  Right path' -> do
                    absPath <- ProjectUtils.branchRelativePathToAbsolute path'
-                    let srcp = Path.convert absPath
+                    let srcp = Path.AbsolutePath' absPath
                    srcb <- Cli.expectBranchAtPath' srcp
                    pure (srcb, WhichBranchEmptyPath srcp)
              description <- inputDescription input
@ -492,11 +492,11 @@ loop e = do
                      hqLength <- Cli.runTransaction Codebase.hashLength
                      pure (DeleteNameAmbiguous hqLength name srcTerms Set.empty)
              dest <- Cli.resolveSplit' dest'
-              destTerms <- Cli.getTermsAt (Path.convert dest)
+              destTerms <- Cli.getTermsAt (HQ'.NameOnly <$> dest)
              when (not (Set.null destTerms)) do
                Cli.returnEarly (TermAlreadyExists dest' destTerms)
              description <- inputDescription input
-              Cli.stepAt description (BranchUtil.makeAddTermName (Path.convert dest) srcTerm)
+              Cli.stepAt description (BranchUtil.makeAddTermName (first Path.unabsolute dest) srcTerm)
              Cli.respond Success
            AliasTypeI src' dest' -> do
              src <- traverseOf _Right Cli.resolveSplit' src'
@ -515,11 +515,11 @@ loop e = do
                      hqLength <- Cli.runTransaction Codebase.hashLength
                      pure (DeleteNameAmbiguous hqLength name Set.empty srcTypes)
              dest <- Cli.resolveSplit' dest'
-              destTypes <- Cli.getTypesAt (Path.convert dest)
+              destTypes <- Cli.getTypesAt (HQ'.NameOnly <$> dest)
              when (not (Set.null destTypes)) do
                Cli.returnEarly (TypeAlreadyExists dest' destTypes)
              description <- inputDescription input
-              Cli.stepAt description (BranchUtil.makeAddTypeName (Path.convert dest) srcType)
+              Cli.stepAt description (BranchUtil.makeAddTypeName (first Path.unabsolute dest) srcType)
              Cli.respond Success

            -- this implementation will happily produce name conflicts,
@ -621,9 +621,9 @@ loop e = do
              guidPath <- Cli.resolveSplit' (authorPath' |> NameSegment.guidSegment)
              Cli.stepManyAt
                description
-                [ BranchUtil.makeAddTermName (Path.convert authorPath) (d authorRef),
-                  BranchUtil.makeAddTermName (Path.convert copyrightHolderPath) (d copyrightHolderRef),
-                  BranchUtil.makeAddTermName (Path.convert guidPath) (d guidRef)
+                [ BranchUtil.makeAddTermName (first Path.unabsolute authorPath) (d authorRef),
+                  BranchUtil.makeAddTermName (first Path.unabsolute copyrightHolderPath) (d copyrightHolderRef),
+                  BranchUtil.makeAddTermName (first Path.unabsolute guidPath) (d guidRef)
                ]
              currentPath <- Cli.getCurrentPath
              finalBranch <- Cli.getCurrentBranch0
@ -1624,7 +1624,7 @@ checkDeletes typesTermsTuples doutput inputs = do
        (Path.HQSplit', Set Reference, Set Referent) ->
        Cli (Path.Split, Name, Set Reference, Set Referent)
      toSplitName hq = do
-        resolvedPath <- Path.convert <$> Cli.resolveSplit' (HQ'.toName <$> hq ^. _1)
+        resolvedPath <- first Path.unabsolute <$> Cli.resolveSplit' (HQ'.toName <$> hq ^. _1)
        return (resolvedPath, Path.unsafeToName (Path.unsplit resolvedPath), hq ^. _2, hq ^. _3)
  -- get the splits and names with terms and types
  splitsNames <- traverse toSplitName typesTermsTuples
@ -1771,7 +1771,7 @@ docsI src = do
       (codebaseByName) Lastly check for `foo.doc` in the codebase and if found do `display foo.doc`
    -}
    dotDoc :: HQ.HashQualified Name
-    dotDoc = Name.convert . Name.joinDot src $ Name.fromSegment NameSegment.docSegment
+    dotDoc = HQ.NameOnly . Name.joinDot src $ Name.fromSegment NameSegment.docSegment

    findInScratchfileByName :: Cli ()
    findInScratchfileByName = do
--- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveTerm.hs
+++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveTerm.hs
@ -26,14 +26,14 @@ moveTermSteps src' dest' = do
      Cli.returnEarly (Output.DeleteNameAmbiguous hqLength src' srcTerms Set.empty)
    [srcTerm] -> do
      dest <- Cli.resolveSplit' dest'
-      destTerms <- Cli.getTermsAt (Path.convert dest)
+      destTerms <- Cli.getTermsAt (HQ'.NameOnly <$> dest)
      when (not (Set.null destTerms)) do
        Cli.returnEarly (Output.TermAlreadyExists dest' destTerms)
-      let p = Path.convert src
+      let p = first Path.unabsolute src
      pure
        [ -- Mitchell: throwing away any hash-qualification here seems wrong!
          BranchUtil.makeDeleteTermName (over _2 HQ'.toName p) srcTerm,
-          BranchUtil.makeAddTermName (Path.convert dest) srcTerm
+          BranchUtil.makeAddTermName (first Path.unabsolute dest) srcTerm
        ]

 doMoveTerm :: (Path', HQ'.HQSegment) -> (Path', NameSegment) -> Text -> Cli ()
--- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveType.hs
+++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveType.hs
@ -26,14 +26,14 @@ moveTypeSteps src' dest' = do
      Cli.returnEarly (Output.DeleteNameAmbiguous hqLength src' Set.empty srcTypes)
    [srcType] -> do
      dest <- Cli.resolveSplit' dest'
-      destTypes <- Cli.getTypesAt (Path.convert dest)
+      destTypes <- Cli.getTypesAt (HQ'.NameOnly <$> dest)
      when (not (Set.null destTypes)) do
        Cli.returnEarly (Output.TypeAlreadyExists dest' destTypes)
-      let p = Path.convert src
+      let p = first Path.unabsolute src
      pure
        [ -- Mitchell: throwing away any hash-qualification here seems wrong!
          BranchUtil.makeDeleteTypeName (over _2 HQ'.toName p) srcType,
-          BranchUtil.makeAddTypeName (Path.convert dest) srcType
+          BranchUtil.makeAddTypeName (first Path.unabsolute dest) srcType
        ]

 doMoveType :: (Path', HQ'.HQSegment) -> (Path', NameSegment) -> Text -> Cli ()
--- a/unison-cli/src/Unison/CommandLine/BranchRelativePath.hs
+++ b/unison-cli/src/Unison/CommandLine/BranchRelativePath.hs
@ -63,13 +63,13 @@ instance From BranchRelativePath Text where
      That path ->
        Text.Builder.run
          ( Text.Builder.char ':'
-              <> Text.Builder.text (Path.convert path)
+              <> Text.Builder.text (Path.toText' $ Path.RelativePath' path)
          )
      These eitherProj path ->
        Text.Builder.run
          ( Text.Builder.text (eitherProjToText eitherProj)
              <> Text.Builder.char ':'
-              <> Text.Builder.text (Path.convert path)
+              <> Text.Builder.text (Path.toText' $ Path.RelativePath' path)
          )
    LoosePath path -> Path.toText' path
    where
--- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs
+++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs
@ -3837,7 +3837,8 @@ branchRelativePathSuggestions config inputStr codebase _httpClient currentPath =
          Just projectBranch -> do
            let branchPath = review ProjectUtils.projectBranchPathPrism (projectAndBranch, mempty)
                projectAndBranch = ProjectAndBranch (projectBranch ^. #projectId) (projectBranch ^. #branchId)
-            map prefixPathSep <$> prefixCompleteNamespace (Path.convert relPath) branchPath
+            map prefixPathSep
+              <$> prefixCompleteNamespace (Text.unpack . Path.toText' $ Path.RelativePath' relPath) branchPath
      BranchRelativePath.IncompletePath projStuff mpath -> do
        Codebase.runTransaction codebase do
          mprojectBranch <- runMaybeT do
@ -3853,7 +3854,10 @@ branchRelativePathSuggestions config inputStr codebase _httpClient currentPath =
            Just (projectBranch, prefix) -> do
              let branchPath = review ProjectUtils.projectBranchPathPrism (projectAndBranch, mempty)
                  projectAndBranch = ProjectAndBranch (projectBranch ^. #projectId) (projectBranch ^. #branchId)
-              map (addBranchPrefix prefix) <$> prefixCompleteNamespace (maybe "" Path.convert mpath) branchPath
+              map (addBranchPrefix prefix)
+                <$> prefixCompleteNamespace
+                  (maybe "" (Text.unpack . Path.toText' . Path.RelativePath') mpath)
+                  branchPath
  where
    (mayCurrentProjectId, mayCurrentBranchId) = case projectContextFromPath currentPath of
      LooseCodePath {} -> (Nothing, Nothing)
--- a/unison-core/src/Unison/HashQualified'.hs
+++ b/unison-core/src/Unison/HashQualified'.hs
@ -2,7 +2,7 @@ module Unison.HashQualified' where

 import Data.Text qualified as Text
 import Unison.HashQualified qualified as HQ
-import Unison.Name (Convert, Name, Parse)
+import Unison.Name (Name, Parse)
 import Unison.Name qualified as Name
 import Unison.NameSegment (NameSegment)
 import Unison.Prelude
@ -114,13 +114,5 @@ instance (Name.Alphabetical n) => Name.Alphabetical (HashQualified n) where
  compareAlphabetical HashQualified {} NameOnly {} = GT
  compareAlphabetical (HashQualified n sh) (HashQualified n2 sh2) = Name.compareAlphabetical n n2 <> compare sh sh2

-instance (Convert n n2) => Parse (HashQualified n) n2 where
-  parse = \case
-    NameOnly n -> Just (Name.convert n)
-    _ -> Nothing
-
-instance Convert (HashQualified n) (HQ.HashQualified n) where
-  convert = toHQ
-
 instance Parse (HQ.HashQualified n) (HashQualified n) where
  parse = fromHQ
--- a/unison-core/src/Unison/HashQualified.hs
+++ b/unison-core/src/Unison/HashQualified.hs
@ -3,7 +3,7 @@ module Unison.HashQualified where
 import Data.Text qualified as Text
 import Unison.ConstructorReference (ConstructorReference)
 import Unison.ConstructorReference qualified as ConstructorReference
-import Unison.Name (Convert, Name)
+import Unison.Name (Name)
 import Unison.Name qualified as Name
 import Unison.Prelude hiding (fromString)
 import Unison.Reference (Reference)
@ -139,9 +139,3 @@ instance (Name.Alphabetical n) => Name.Alphabetical (HashQualified n) where
        (Nothing, Just _) -> LT -- prefer NameOnly to HashQualified
        (Just _, Nothing) -> GT
        (Just sh, Just sh2) -> compare sh sh2
-
-instance (Convert n n2) => Convert (HashQualified n) (HashQualified n2) where
-  convert = fmap Name.convert
-
-instance Convert n (HashQualified n) where
-  convert = NameOnly
--- a/unison-core/src/Unison/Name.hs
+++ b/unison-core/src/Unison/Name.hs
@ -1,6 +1,5 @@
 module Unison.Name
  ( Name,
-    Convert (..),
    Parse (..),

    -- * Basic construction
@ -571,9 +570,6 @@ commonPrefix x@(Name p1 _) y@(Name p2 _)
      | a == b = a : commonPrefix' as bs
    commonPrefix' _ _ = []

-class Convert a b where
-  convert :: a -> b
-
 class Parse a b where
  parse :: a -> Maybe b

--- a/unison-core/src/Unison/NamesWithHistory.hs
+++ b/unison-core/src/Unison/NamesWithHistory.hs
@ -225,7 +225,7 @@ longestTermName :: Int -> Referent -> Names -> HQ.HashQualified Name
 longestTermName length r ns =
  case reverse (termNamesByLength length r ns) of
    [] -> HQ.take length (HQ.fromReferent r)
-    (h : _) -> Name.convert h
+    (h : _) -> HQ'.toHQ h

 termName :: Int -> Referent -> Names -> Set (HQ'.HashQualified Name)
 termName length r names =
--- a/unison-core/src/Unison/Term.hs
+++ b/unison-core/src/Unison/Term.hs
@ -19,6 +19,7 @@ import Unison.Blank qualified as B
 import Unison.ConstructorReference (ConstructorReference, GConstructorReference (..))
 import Unison.ConstructorType qualified as CT
 import Unison.DataDeclaration.ConstructorId (ConstructorId)
+import Unison.HashQualified qualified as HQ
 import Unison.LabeledDependency (LabeledDependency)
 import Unison.LabeledDependency qualified as LD
 import Unison.Name qualified as Name
@ -160,14 +161,14 @@ bindNames unsafeVarToName keepFreeTerms ns e = do
      -- !_ = trace "bindNames.free type vars: " ()
      -- !_ = traceShow $ fst <$> freeTyVars
      okTm :: (v, a) -> Names.ResolutionResult v a (v, Term v a)
-      okTm (v, a) = case Names.lookupHQTerm Names.IncludeSuffixes (Name.convert $ unsafeVarToName v) ns of
+      okTm (v, a) = case Names.lookupHQTerm Names.IncludeSuffixes (HQ.NameOnly $ unsafeVarToName v) ns of
        rs
          | Set.size rs == 1 ->
              pure (v, fromReferent a $ Set.findMin rs)
          | otherwise -> case NES.nonEmptySet rs of
              Nothing -> Left (pure (Names.TermResolutionFailure v a Names.NotFound))
              Just refs -> Left (pure (Names.TermResolutionFailure v a (Names.Ambiguous ns refs)))
-      okTy (v, a) = case Names.lookupHQType Names.IncludeSuffixes (Name.convert $ unsafeVarToName v) ns of
+      okTy (v, a) = case Names.lookupHQType Names.IncludeSuffixes (HQ.NameOnly $ unsafeVarToName v) ns of
        rs
          | Set.size rs == 1 -> pure (v, Type.ref a $ Set.findMin rs)
          | otherwise -> case NES.nonEmptySet rs of
--- a/unison-core/src/Unison/Type/Names.hs
+++ b/unison-core/src/Unison/Type/Names.hs
@ -6,6 +6,7 @@ where
 import Data.Set qualified as Set
 import Data.Set.NonEmpty qualified as NES
 import Unison.ABT qualified as ABT
+import Unison.HashQualified qualified as HQ
 import Unison.Name qualified as Name
 import Unison.Names qualified as Names
 import Unison.Names.ResolutionResult qualified as Names
@ -24,7 +25,7 @@ bindNames ::
  Names.ResolutionResult v a (Type v a)
 bindNames unsafeVarToName keepFree ns t =
  let fvs = ABT.freeVarOccurrences keepFree t
-      rs = [(v, a, Names.lookupHQType Names.IncludeSuffixes (Name.convert $ unsafeVarToName v) ns) | (v, a) <- fvs]
+      rs = [(v, a, Names.lookupHQType Names.IncludeSuffixes (HQ.NameOnly $ unsafeVarToName v) ns) | (v, a) <- fvs]
      ok (v, a, rs) =
        if Set.size rs == 1
          then pure (v, Set.findMin rs)