From bdc48f4ca258b1d91d0567cc1ae1baf89a68c3bb Mon Sep 17 00:00:00 2001
From: fr33domlover <fr33domlover@riseup.net>
Date: Wed, 23 Oct 2019 09:31:37 +0000
Subject: [PATCH] When parsing a Darcs repo's patch file, fail with error
 detail in the message

I'm not sure this will improve much, because the error messages come from
attoparsec, but at least the message text won't be constant, which was the
previous situation.
---
 src/Vervis/Darcs.hs | 19 +++++++++++--------
 1 file changed, 11 insertions(+), 8 deletions(-)

diff --git a/src/Vervis/Darcs.hs b/src/Vervis/Darcs.hs
index ab37706..3093bbb 100644
--- a/src/Vervis/Darcs.hs
+++ b/src/Vervis/Darcs.hs
@@ -282,16 +282,15 @@ joinHunks =
 -- * The hash may or may not be found in the repo. If there's no patch in the
 --   repo with the given hash, 'Nothing' is returned.
 readPatch :: FilePath -> Text -> IO (Maybe Patch)
-readPatch path hash = do
+readPatch path hash = handle $ runExceptT $ do
     let pih = PatchInfoHash $ fst $ B16.decode $ encodeUtf8 hash
-    li <- handle =<< readLatestInventory path latestInventoryAllP
+    li <- ExceptT $ readLatestInventory path latestInventoryAllP
     mp <- loop pih (liPatches li) (fst <$> liPrevTag li)
     for mp $ \ (pi, pch) -> do
         (_pir, hunks) <-
-            handle =<< readCompressedPatch path pch (P.patch <* A.endOfInput)
-        let (an, ae) =
-                either error id $
-                A.parseOnly (author <* A.endOfInput) $ piAuthor pi
+            ExceptT $ readCompressedPatch path pch (P.patch <* A.endOfInput)
+        (an, ae) <-
+            ExceptT . pure $ A.parseOnly (author <* A.endOfInput) $ piAuthor pi
         return Patch
             { patchWritten     =
                 ( Author
@@ -307,7 +306,11 @@ readPatch path hash = do
                 map (mkedit . second joinHunks) $ groupHunksByFile hunks
             }
   where
-    handle = either (const $ fail "readPatch failed") pure
+    handle a = do
+        r <- a
+        case r of
+            Left e -> fail $ "readPatch failed: " ++ e
+            Right mp -> return mp
     lookup' pih ps = case F.find (\ (_pi, pih', _pch) -> pih' == pih) ps of
         Nothing              -> Nothing
         Just (pi, _pih, pch) -> Just (pi, pch)
@@ -316,7 +319,7 @@ readPatch path hash = do
         Nothing -> case mih of
             Nothing -> return Nothing
             Just ih -> do
-                i <- handle =<< readCompressedInventory path ih earlyInventoryAllP
+                i <- ExceptT $ readCompressedInventory path ih earlyInventoryAllP
                 case i of
                     Left ei  -> loop pih (eiPatches ei) Nothing
                     Right mi -> loop pih (miPatches mi) (Just $ miPrevious mi)