Prettier error S-4926

Author: mpilgrem

doc/list_command.md

@@ -39,14 +39,16 @@ Could not find package paltry, updating
 ...
 Package index cache populated
 Error: [S-4926]
-- Could not find package paltry on Hackage. Perhaps you meant: pantry, pretty, pasty, xattr, alloy, para, pappy, alure, polar, factory
+       * Could not find package paltry on Hackage. Perhaps you meant one of:
+         pantry, pretty, pasty, xattr, alloy, para, pappy, alure, polar and
+         factory.
 
 stack --resolver lts-21.12 list base unix Win32 acme-missiles pantry
 Error: [S-4926]
-- Package does not appear in snapshot: base
-- Package does not appear in snapshot: unix
-- Package does not appear in snapshot: Win32
-- Package does not appear in snapshot: acme-missiles
+       * Package does not appear in snapshot: base.
+       * Package does not appear in snapshot: unix.
+       * Package does not appear in snapshot: Win32.
+       * Package does not appear in snapshot: acme-missiles.
 
 stack --resolver lts-21.12 list pantry
 pantry-0.8.3

doc/maintainers/stack_errors.md

@@ -5,7 +5,7 @@
 In connection with considering Stack's support of the
 [Haskell Error Index](https://errors.haskell.org/) initiative, this page seeks
 to take stock of the errors that Stack itself can raise, by reference to the
-`master` branch of the Stack repository. Last updated: 2023-09-02.
+`master` branch of the Stack repository. Last updated: 2023-09-16.
 
 *   `GHC.GHC.Utils.GhcPkg.Main.Compat`
 
@@ -183,10 +183,10 @@ to take stock of the errors that Stack itself can raise, by reference to the
         [S-2422] | ResolverPartial RawSnapshotLocation String
         ~~~
 
-    -   `Stack.List.ListException`
+    -   `Stack.List.ListPrettyException`
 
         ~~~haskell
-        [S-4926] = CouldNotParsePackageSelectors [String]
+        [S-4926] = CouldNotParsePackageSelectors [StyleDoc]
         ~~~
 
     -   `Stack.Lock.LockPrettyException`

src/Stack/List.hs

@@ -8,7 +8,6 @@ module Stack.List
   ) where
 
 import           Pantry ( loadSnapshot )
-import           RIO.List ( intercalate )
 import qualified RIO.Map as Map
 import           RIO.Process ( HasProcessContext )
 import           Stack.Config ( makeConcreteResolver )
@@ -19,14 +18,17 @@ import           Stack.Types.Runner ( Runner, globalOptsL )
 
 -- | Type representing exceptions thrown by functions exported by the
 -- "Stack.List" module.
-newtype ListException
-  = CouldNotParsePackageSelectors [String]
+newtype ListPrettyException
+  = CouldNotParsePackageSelectors [StyleDoc]
   deriving (Show, Typeable)
 
-instance Exception ListException where
-  displayException (CouldNotParsePackageSelectors strs) = unlines $
-    "Error: [S-4926]"
-    : map ("- " ++) strs
+instance Pretty ListPrettyException where
+  pretty (CouldNotParsePackageSelectors errs) =
+    "[S-4926]"
+    <> line
+    <> bulletedList errs
+
+instance Exception ListPrettyException
 
 -- | Function underlying the @stack list@ command. List packages.
 listCmd :: [String] -> RIO Runner ()
@@ -53,13 +55,13 @@ listPackages mSnapshot input = do
   (errs2, locs) <- partitionEithers <$> traverse toLoc names
   case errs1 ++ errs2 of
     [] -> pure ()
-    errs -> throwM $ CouldNotParsePackageSelectors errs
+    errs -> prettyThrowM $ CouldNotParsePackageSelectors errs
   mapM_ (prettyInfo . fromString . packageIdentifierString) locs
  where
   toLoc | Just snapshot <- mSnapshot = toLocSnapshot snapshot
         | otherwise = toLocNoSnapshot
 
-  toLocNoSnapshot :: PackageName -> RIO env (Either String PackageIdentifier)
+  toLocNoSnapshot :: PackageName -> RIO env (Either StyleDoc PackageIdentifier)
   toLocNoSnapshot name = do
     mloc1 <-
       getLatestHackageLocation YesRequireHackageIndex name UsePreferredVersions
@@ -82,31 +84,38 @@ listPackages mSnapshot input = do
     case mloc of
       Nothing -> do
         candidates <- getHackageTypoCorrections name
-        pure $ Left $ concat
-          [ "Could not find package "
-          , packageNameString name
-          , " on Hackage"
+        pure $ Left $ fillSep
+          [ flow "Could not find package"
+          , style Current (fromString $ packageNameString name)
+          , flow "on Hackage."
           , if null candidates
-              then ""
-              else ". Perhaps you meant: " ++
-                     intercalate ", " (map packageNameString candidates)
+              then mempty
+              else fillSep $
+                  flow "Perhaps you meant one of:"
+                : mkNarrativeList (Just Good) False
+                    (map (fromString . packageNameString) candidates :: [StyleDoc])
           ]
       Just loc -> pure $ Right (packageLocationIdent loc)
 
   toLocSnapshot ::
        RawSnapshot
     -> PackageName
-    -> RIO env (Either String PackageIdentifier)
+    -> RIO env (Either StyleDoc PackageIdentifier)
   toLocSnapshot snapshot name =
     case Map.lookup name (rsPackages snapshot) of
       Nothing ->
-        pure $ Left $
-          "Package does not appear in snapshot: " ++ packageNameString name
+        pure $ Left $ fillSep
+          [ flow "Package does not appear in snapshot:"
+          , style Current (fromString $ packageNameString name) <> "."
+          ]
       Just sp -> do
         loc <- cplComplete <$> completePackageLocation (rspLocation sp)
         pure $ Right (packageLocationIdent loc)
 
   parse s =
     case parsePackageName s of
       Just x -> Right x
-      Nothing -> Left $ "Could not parse as package name or identifier: " ++ s
+      Nothing -> Left $ fillSep
+        [ flow "Could not parse as package name or identifier:"
+        , style Current (fromString s) <> "."
+        ]