sup39/vervis
1
0
Fork 0
mirror of https://code.sup39.dev/repos/Wqawg synced 2024-12-29 00:04:52 +09:00
Code Issues Activity

When parsing a Darcs repo's patch file, fail with error detail in the message

Browse source 
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.
This commit is contained in:
fr33domlover 2019-10-23 09:31:37 +00:00
parent 90ad05b327
commit bdc48f4ca2
1 changed files with 11 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

19
src/Vervis/Darcs.hs
View file

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