Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

D.Compat.Binary: catch all ErrorCall in decodeOrFailIO #2428

Merged
merged 1 commit into from
Feb 20, 2015
Merged

D.Compat.Binary: catch all ErrorCall in decodeOrFailIO #2428

Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
19 changes: 7 additions & 12 deletions Cabal/Distribution/Compat/Binary.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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 ()
Expand All @@ -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