Merge pull request #5404 from unisonweb/24-10-09-edit-add-to-fold

unison-cli/src/Unison/Cli/Monad.hs

@@ -164,8 +164,8 @@ data Env = Env
     generateUniqueName :: IO Parser.UniqueName,
     -- | How to load source code.
     loadSource :: SourceName -> IO LoadSourceResult,
-    -- | How to write source code.
-    writeSource :: SourceName -> Text -> IO (),
+    -- | How to write source code. Bool = make new fold?
+    writeSource :: SourceName -> Text -> Bool -> IO (),
     -- | What to do with output for the user.
     notify :: Output -> IO (),
     -- | What to do with numbered output for the user.

unison-cli/src/Unison/Cli/Pretty.hs

@@ -37,7 +37,9 @@ module Unison.Cli.Pretty
     prettySharePath,
     prettyShareURI,
     prettySlashProjectBranchName,
+    prettyTerm,
     prettyTermName,
+    prettyType,
     prettyTypeName,
     prettyTypeResultHeader',
     prettyTypeResultHeaderFull',
@@ -47,14 +49,11 @@ module Unison.Cli.Pretty
     prettyWriteRemoteNamespace,
     shareOrigin,
     unsafePrettyTermResultSigFull',
-    prettyTermDisplayObjects,
-    prettyTypeDisplayObjects,
   )
 where
 
 import Control.Lens hiding (at)
 import Control.Monad.Writer (Writer, runWriter)
-import Data.List qualified as List
 import Data.Map qualified as Map
 import Data.Set qualified as Set
 import Data.Time (UTCTime)
@@ -92,7 +91,6 @@ import Unison.HashQualified qualified as HQ
 import Unison.HashQualifiedPrime qualified as HQ'
 import Unison.LabeledDependency as LD
 import Unison.Name (Name)
-import Unison.Name qualified as Name
 import Unison.NameSegment (NameSegment)
 import Unison.NameSegment.Internal qualified as NameSegment
 import Unison.Parser.Ann (Ann)
@@ -102,10 +100,9 @@ import Unison.PrettyPrintEnv.Names qualified as PPE
 import Unison.PrettyPrintEnv.Util qualified as PPE
 import Unison.PrettyPrintEnvDecl qualified as PPED
 import Unison.Project (ProjectAndBranch (..), ProjectName, Semver (..))
-import Unison.Reference (Reference, TermReferenceId)
+import Unison.Reference (Reference)
 import Unison.Reference qualified as Reference
 import Unison.Referent (Referent)
-import Unison.Referent qualified as Referent
 import Unison.Server.SearchResultPrime qualified as SR'
 import Unison.ShortHash (ShortHash)
 import Unison.Symbol (Symbol)
@@ -439,34 +436,6 @@ prettyUnisonFile ppe uf@(UF.UnisonFileId datas effects terms watches) =
     rd = Reference.DerivedId
     hqv v = HQ.unsafeFromVar v
 
-prettyTypeDisplayObjects ::
-  PPED.PrettyPrintEnvDecl ->
-  (Map Reference (DisplayObject () (DD.Decl Symbol Ann))) ->
-  [P.Pretty SyntaxText]
-prettyTypeDisplayObjects pped types =
-  types
-    & Map.toList
-    & map (\(ref, dt) -> (PPE.typeName unsuffixifiedPPE ref, ref, dt))
-    & List.sortBy (\(n0, _, _) (n1, _, _) -> Name.compareAlphabetical n0 n1)
-    & map (prettyType pped)
-  where
-    unsuffixifiedPPE = PPED.unsuffixifiedPPE pped
-
-prettyTermDisplayObjects ::
-  PPED.PrettyPrintEnvDecl ->
-  Bool ->
-  (TermReferenceId -> Bool) ->
-  (Map Reference.TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann))) ->
-  [P.Pretty SyntaxText]
-prettyTermDisplayObjects pped isSourceFile isTest terms =
-  terms
-    & Map.toList
-    & map (\(ref, dt) -> (PPE.termName unsuffixifiedPPE (Referent.Ref ref), ref, dt))
-    & List.sortBy (\(n0, _, _) (n1, _, _) -> Name.compareAlphabetical n0 n1)
-    & map (\t -> prettyTerm pped isSourceFile (fromMaybe False . fmap isTest . Reference.toId $ (t ^. _2)) t)
-  where
-    unsuffixifiedPPE = PPED.unsuffixifiedPPE pped
-
 prettyTerm ::
   PPED.PrettyPrintEnvDecl ->
   Bool {- whether we're printing to a source-file or not. -} ->

unison-cli/src/Unison/Codebase/Editor/HandleInput.hs

@@ -14,7 +14,6 @@ import Control.Monad.State qualified as State
 import Data.Foldable qualified as Foldable
 import Data.List qualified as List
 import Data.List.Extra (nubOrd)
-import Data.List.NonEmpty (NonEmpty)
 import Data.List.NonEmpty qualified as Nel
 import Data.Map qualified as Map
 import Data.Set qualified as Set
@@ -85,7 +84,7 @@ import Unison.Codebase.Editor.HandleInput.Reflogs qualified as Reflogs
 import Unison.Codebase.Editor.HandleInput.ReleaseDraft (handleReleaseDraft)
 import Unison.Codebase.Editor.HandleInput.Run (handleRun)
 import Unison.Codebase.Editor.HandleInput.RuntimeUtils qualified as RuntimeUtils
-import Unison.Codebase.Editor.HandleInput.ShowDefinition (showDefinitions)
+import Unison.Codebase.Editor.HandleInput.ShowDefinition (handleShowDefinition)
 import Unison.Codebase.Editor.HandleInput.TermResolution (resolveMainRef)
 import Unison.Codebase.Editor.HandleInput.Tests qualified as Tests
 import Unison.Codebase.Editor.HandleInput.Todo (handleTodo)
@@ -616,7 +615,7 @@ loop e = do
             DisplayI outputLoc namesToDisplay -> do
               traverse_ (displayI outputLoc) namesToDisplay
             ShowDefinitionI outputLoc showDefinitionScope query -> handleShowDefinition outputLoc showDefinitionScope query
-            EditNamespaceI paths -> handleEditNamespace LatestFileLocation paths
+            EditNamespaceI paths -> handleEditNamespace (LatestFileLocation AboveFold) paths
             FindShallowI pathArg -> handleLs pathArg
             FindI isVerbose fscope ws -> handleFindI isVerbose fscope ws input
             StructuredFindI _fscope ws -> handleStructuredFindI ws
@@ -763,25 +762,25 @@ loop e = do
                 Nothing -> do
                   Cli.respond DebugFuzzyOptionsNoResolver
             DebugFormatI -> do
-              Cli.Env {writeSource, loadSource} <- ask
+              env <- ask
               void $ runMaybeT do
                 (filePath, _) <- MaybeT Cli.getLatestFile
                 pf <- lift Cli.getLatestParsedFile
                 tf <- lift Cli.getLatestTypecheckedFile
                 names <- lift Cli.currentNames
                 let buildPPED uf tf =
                       let names' = (fromMaybe mempty $ (UF.typecheckedToNames <$> tf) <|> (UF.toNames <$> uf)) `Names.shadowing` names
-                      in pure (PPED.makePPED (PPE.hqNamer 10 names') (PPE.suffixifyByHashName names'))
+                       in pure (PPED.makePPED (PPE.hqNamer 10 names') (PPE.suffixifyByHashName names'))
                 let formatWidth = 80
                 currentPath <- lift $ Cli.getCurrentPath
                 updates <- MaybeT $ Format.formatFile buildPPED formatWidth currentPath pf tf Nothing
                 source <-
-                  liftIO (loadSource (Text.pack filePath)) >>= \case
+                  liftIO (env.loadSource (Text.pack filePath)) >>= \case
                     Cli.InvalidSourceNameError -> lift $ Cli.returnEarly $ Output.InvalidSourceName filePath
                     Cli.LoadError -> lift $ Cli.returnEarly $ Output.SourceLoadFailed filePath
                     Cli.LoadSuccess contents -> pure contents
                 let updatedSource = Format.applyTextReplacements updates source
-                liftIO $ writeSource (Text.pack filePath) updatedSource
+                liftIO $ env.writeSource (Text.pack filePath) updatedSource True
             DebugDumpNamespacesI -> do
               let seen h = State.gets (Set.member h)
                   set h = State.modify (Set.insert h)
@@ -1264,50 +1263,6 @@ handleDependents hq = do
   Cli.setNumberedArgs . map SA.HashQualified $ types <> terms
   Cli.respond (ListDependents ppe lds types terms)
 
--- | Handle a @ShowDefinitionI@ input command, i.e. `view` or `edit`.
-handleShowDefinition :: OutputLocation -> ShowDefinitionScope -> NonEmpty (HQ.HashQualified Name) -> Cli ()
-handleShowDefinition outputLoc showDefinitionScope query = do
-  Cli.Env {codebase} <- ask
-  hqLength <- Cli.runTransaction Codebase.hashLength
-  let hasAbsoluteQuery = any (any Name.isAbsolute) query
-  (names, unbiasedPPED) <- case (hasAbsoluteQuery, showDefinitionScope) of
-    -- TODO: We should instead print each definition using the names from its project-branch root.
-    (True, _) -> do
-      root <- Cli.getCurrentProjectRoot
-      let root0 = Branch.head root
-      let names = Names.makeAbsolute $ Branch.toNames root0
-      let pped = PPED.makePPED (PPE.hqNamer 10 names) (suffixify names)
-      pure (names, pped)
-    (_, ShowDefinitionGlobal) -> do
-      -- TODO: Maybe rewrite to be properly global
-      root <- Cli.getCurrentProjectRoot
-      let root0 = Branch.head root
-      let names = Names.makeAbsolute $ Branch.toNames root0
-      let pped = PPED.makePPED (PPE.hqNamer 10 names) (suffixify names)
-      pure (names, pped)
-    (_, ShowDefinitionLocal) -> do
-      currentNames <- Cli.currentNames
-      let pped = PPED.makePPED (PPE.hqNamer 10 currentNames) (suffixify currentNames)
-      pure (currentNames, pped)
-  let pped = PPED.biasTo (mapMaybe HQ.toName (toList query)) unbiasedPPED
-  Backend.DefinitionResults terms types misses <- do
-    let nameSearch = NameSearch.makeNameSearch hqLength names
-    Cli.runTransaction (Backend.definitionsByName codebase nameSearch includeCycles Names.IncludeSuffixes (toList query))
-  showDefinitions outputLoc pped terms types misses
-  where
-    suffixify =
-      case outputLoc of
-        ConsoleLocation -> PPE.suffixifyByHash
-        FileLocation _ -> PPE.suffixifyByHashName
-        LatestFileLocation -> PPE.suffixifyByHashName
-
-    -- `view`: don't include cycles; `edit`: include cycles
-    includeCycles =
-      case outputLoc of
-        ConsoleLocation -> Backend.DontIncludeCycles
-        FileLocation _ -> Backend.IncludeCycles
-        LatestFileLocation -> Backend.IncludeCycles
-
 -- todo: compare to `getHQTerms` / `getHQTypes`.  Is one universally better?
 resolveHQToLabeledDependencies :: HQ.HashQualified Name -> Cli (Set LabeledDependency)
 resolveHQToLabeledDependencies = \case
@@ -1355,17 +1310,17 @@ doDisplay outputLoc names tm = do
   rendered <- DisplayValues.displayTerm pped loadTerm loadTypeOfTerm' evalTerm loadDecl tm
   mayFP <- case outputLoc of
     ConsoleLocation -> pure Nothing
-    FileLocation path -> Just <$> Directory.canonicalizePath path
-    LatestFileLocation -> traverse Directory.canonicalizePath $ fmap fst (loopState ^. #latestFile) <|> Just "scratch.u"
+    FileLocation path _ -> Just <$> Directory.canonicalizePath path
+    LatestFileLocation _ -> traverse Directory.canonicalizePath $ fmap fst (loopState ^. #latestFile) <|> Just "scratch.u"
   whenJust mayFP \fp -> do
     liftIO $ prependFile fp (Text.pack . P.toPlain 80 $ rendered)
   Cli.respond $ DisplayRendered mayFP rendered
   where
     suffixify =
       case outputLoc of
         ConsoleLocation -> PPE.suffixifyByHash
-        FileLocation _ -> PPE.suffixifyByHashName
-        LatestFileLocation -> PPE.suffixifyByHashName
+        FileLocation _ _ -> PPE.suffixifyByHashName
+        LatestFileLocation _ -> PPE.suffixifyByHashName
 
     prependFile :: FilePath -> Text -> IO ()
     prependFile filePath txt = do
@@ -1475,7 +1430,7 @@ doCompile profile native output main = do
       outf
         | native = output
         | otherwise = output <> ".uc"
-      copts = Runtime.defaultCompileOpts { Runtime.profile = profile }
+      copts = Runtime.defaultCompileOpts {Runtime.profile = profile}
   whenJustM
     ( liftIO $
         Runtime.compileTo theRuntime copts codeLookup ppe ref outf
@@ -1661,8 +1616,8 @@ displayI outputLoc hq = do
     suffixify =
       case outputLoc of
         ConsoleLocation -> PPE.suffixifyByHash
-        FileLocation _ -> PPE.suffixifyByHashName
-        LatestFileLocation -> PPE.suffixifyByHashName
+        FileLocation _ _ -> PPE.suffixifyByHashName
+        LatestFileLocation _ -> PPE.suffixifyByHashName
 
 docsI :: Name -> Cli ()
 docsI src = do

unison-cli/src/Unison/Codebase/Editor/HandleInput/FindAndReplace.hs

@@ -52,7 +52,7 @@ import Unison.Var qualified as Var
 
 handleStructuredFindReplaceI :: HQ.HashQualified Name -> Cli ()
 handleStructuredFindReplaceI rule = do
-  Cli.Env {writeSource} <- ask
+  env <- ask
   uf0 <- Cli.expectLatestParsedFile
   let (prepare, uf, finish) = UF.prepareRewrite uf0
   (ppe, _ns, rules) <- lookupRewrite InvalidStructuredFindReplace prepare rule
@@ -67,7 +67,7 @@ handleStructuredFindReplaceI rule = do
   #latestTypecheckedFile .= Just (Left . snd $ uf')
   let msg = "| Rewrote using: "
   let rendered = Text.pack . P.toPlain 80 $ renderRewrittenFile ppe msg uf'
-  liftIO $ writeSource (Text.pack dest) rendered
+  liftIO $ env.writeSource (Text.pack dest) rendered True
   Cli.respond $ OutputRewrittenFile dest vs
 
 handleStructuredFindI :: HQ.HashQualified Name -> Cli ()
@@ -116,13 +116,13 @@ handleTextFindI allowLib tokens = do
   results0 <- traverse ok results
   let results = Alphabetical.sortAlphabetically [hq | (hq, True) <- results0]
   Cli.setNumberedArgs $ map SA.HashQualified results
-  Cli.respond (ListTextFind allowLib results) 
+  Cli.respond (ListTextFind allowLib results)
   where
     tokensTxt = Text.pack <$> tokens
-    containsTokens tm = 
+    containsTokens tm =
       hasAll . join $ ABT.find txts tm
-      where 
-        hasAll txts = all (\tok -> any (\haystack -> Text.isInfixOf tok haystack) txts) tokensTxt 
+      where
+        hasAll txts = all (\tok -> any (\haystack -> Text.isInfixOf tok haystack) txts) tokensTxt
         txts (Term.Text' haystack) = ABT.Found [haystack]
         txts (Term.Nat' haystack) = ABT.Found [Text.pack (show haystack)]
         txts (Term.Int' haystack) = ABT.Found [Text.pack (show haystack)]

unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs

@@ -318,7 +318,7 @@ doMerge info = do
 
       blob5 <-
         maybeBlob5 & onNothing do
-          Cli.Env {writeSource} <- ask
+          env <- ask
           (_temporaryBranchId, temporaryBranchName) <-
             HandleInput.Branch.createBranch
               info.description
@@ -336,7 +336,7 @@ doMerge info = do
             Cli.getLatestFile <&> \case
               Nothing -> "scratch.u"
               Just (file, _) -> file
-          liftIO $ writeSource (Text.pack scratchFilePath) (Text.pack $ Pretty.toPlain 80 blob3.unparsedFile)
+          liftIO $ env.writeSource (Text.pack scratchFilePath) (Text.pack $ Pretty.toPlain 80 blob3.unparsedFile) True
           done (Output.MergeFailure scratchFilePath mergeSourceAndTarget temporaryBranchName)
 
       Cli.runTransaction (Codebase.addDefsToCodebase env.codebase blob5.file)