Merge pull request #2428 from ttuegel/binary-lbi

D.Compat.Binary: catch all ErrorCall in decodeOrFailIO
haskell · Feb 20, 2015 · 9225192 · 9225192
2 parents 3c0e648 + b31dce6
commit 9225192
Showing 1 changed file with 7 additions and 12 deletions.
diff --git 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