From b31dce66d204cae545eae13eaa56c95966ae427e Mon Sep 17 00:00:00 2001
From: Thomas Tuegel <ttuegel@gmail.com>
Date: Fri, 20 Feb 2015 11:46:25 -0600
Subject: [PATCH] D.Compat.Binary: catch all ErrorCall in decodeOrFailIO
---
Cabal/Distribution/Compat/Binary.hs | 19 +++++++------------
1 file changed, 7 insertions(+), 12 deletions(-)
diff --git a/Cabal/Distribution/Compat/Binary.hs b/Cabal/Distribution/Compat/Binary.hs
index b073671624..70ac76d10f 100644
--- a/Cabal/Distribution/Compat/Binary.hs
+++ b/Cabal/Distribution/Compat/Binary.hs
@@ -14,26 +14,21 @@ module Distribution.Compat.Binary
#endif
) where
+import Control.Exception (ErrorCall(..), catch, evaluate)
import Data.ByteString.Lazy (ByteString)
+#if __GLASGOW_HASKELL__ < 706
+import Prelude hiding (catch)
+#endif
+
#if __GLASGOW_HASKELL__ >= 708 || MIN_VERSION_binary(0,7,0)
import Data.Binary
-decodeOrFailIO :: Binary a => ByteString -> IO (Either String a)
-decodeOrFailIO bs =
- return $ case decodeOrFail bs of
- Left (_, _, msg) -> Left msg
- Right (_, _, a) -> Right a
-
#else
-import Control.Exception (ErrorCall(..), catch, evaluate)
import Data.Binary.Get
import Data.Binary.Put
-#if __GLASGOW_HASKELL__ < 706
-import Prelude hiding (catch)
-#endif
import Distribution.Compat.Binary.Class
import Distribution.Compat.Binary.Generic ()
@@ -49,9 +44,9 @@ encode :: Binary a => a -> ByteString
encode = runPut . put
{-# INLINE encode #-}
+#endif
+
decodeOrFailIO :: Binary a => ByteString -> IO (Either String a)
decodeOrFailIO bs =
catch (evaluate (decode bs) >>= return . Right)
$ \(ErrorCall str) -> return $ Left str
-
-#endif
--
GitLab