Merge pull request #72 from commercialhaskell/fix71

Fix #71 Handle exceptions thrown by Hpack
commercialhaskell · Nov 21, 2022 · d42c2c3 · d42c2c3
2 parents 45e7e70 + 536d52f
commit d42c2c3
Show file tree

Hide file tree

Showing 2 changed files with 31 additions and 8 deletions.
diff --git a/src/Pantry.hs b/src/Pantry.hs
@@ -742,11 +742,14 @@ hpack progName pkgDir = do
         he <- view $ pantryConfigL.to pcHpackExecutable
         case he of
             HpackBundled -> do
-                r <- liftIO
-                       $ Hpack.hpackResult
-                       $ mHpackProgName
-                       $ Hpack.setTarget
-                           (toFilePath hpackFile) Hpack.defaultOptions
+                r <- catchAny
+                       ( liftIO
+                           $ Hpack.hpackResult
+                           $ mHpackProgName
+                           $ Hpack.setTarget
+                               (toFilePath hpackFile) Hpack.defaultOptions
+                       )
+                       ( throwIO . HpackLibraryException hpackFile )
                 forM_ (Hpack.resultWarnings r) (logWarn . fromString)
                 let cabalFile = fromString . Hpack.resultCabalFile $ r
                 case Hpack.resultStatus r of
@@ -767,9 +770,11 @@ hpack progName pkgDir = do
                         fromString (toFilePath (filename hpackFile)) <>
                         " file instead of the Cabal file,\n" <>
                         "then please delete the Cabal file."
-            HpackCommand command ->
-                withWorkingDir (toFilePath pkgDir) $
-                proc command [] runProcess_
+            HpackCommand command -> catchAny
+                ( withWorkingDir (toFilePath pkgDir) $
+                  proc command [] runProcess_
+                )
+                ( throwIO . HpackExeException command pkgDir)
 
 -- | Get the 'PackageIdentifier' from a 'GenericPackageDescription'.
 --

diff --git a/src/Pantry/Types.hs b/src/Pantry/Types.hs
@@ -970,6 +970,8 @@ data PantryException
   | MigrationFailure !Text !(Path Abs File) !SomeException
   | InvalidTreeFromCasa !BlobKey !ByteString
   | ParseSnapNameException !Text
+  | HpackLibraryException !(Path Abs File) !SomeException
+  | HpackExeException !FilePath !(Path Abs Dir) !SomeException
 
   deriving Typeable
 instance Exception PantryException where
@@ -1276,6 +1278,22 @@ instance Display PantryException where
     "Error: [S-994]\n"
      <> "Invalid snapshot name: "
      <> display t
+  display (HpackLibraryException file e) =
+    "Error: [S-305]\n"
+    <> "Failed to generate a Cabal file using the Hpack library on file:\n"
+    <> fromString (toFilePath file)
+    <> "\n\n"
+    <> "The exception encountered was:\n\n"
+    <> fromString (show e)
+  display (HpackExeException fp dir e) =
+    "Error: [S-720]\n"
+    <> "Failed to generate a Cabal file using the Hpack executable:\n"
+    <> fromString fp
+    <> "in directory: "
+    <> fromString (toFilePath dir)
+    <> "\n\n"
+    <> "The exception encountered was:\n\n"
+    <> fromString (show e)
 
 data FuzzyResults
   = FRNameNotFound ![PackageName]