{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ >= 711
{-# LANGUAGE PatternSynonyms #-}
#endif
#ifndef MIN_VERSION_binary
#define MIN_VERSION_binary(x, y, z) 0
#endif
module Distribution.Compat.Binary
( decodeOrFailIO
, decodeFileOrFail'
#if __GLASGOW_HASKELL__ >= 708 || MIN_VERSION_binary(0,7,0)
, module Data.Binary
#else
, Binary(..)
, decode, encode, encodeFile
#endif
) where
import Control.Exception (ErrorCall (..), catch, evaluate)
import Data.ByteString.Lazy (ByteString)
#if __GLASGOW_HASKELL__ >= 708 || MIN_VERSION_binary(0,7,0)
import Data.Binary
decodeFileOrFail' :: Binary a => FilePath -> IO (Either String a)
decodeFileOrFail' :: forall a. Binary a => FilePath -> IO (Either FilePath a)
decodeFileOrFail' FilePath
f = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a.
Binary a =>
FilePath -> IO (Either (ByteOffset, FilePath) a)
decodeFileOrFail FilePath
f
#else
import Data.Binary.Get
import Data.Binary.Put
import qualified Data.ByteString.Lazy as BSL
import Distribution.Compat.Binary.Class
import Distribution.Compat.Binary.Generic ()
decode :: Binary a => ByteString -> a
decode = runGet get
encode :: Binary a => a -> ByteString
encode = runPut . put
{-# INLINE encode #-}
decodeFileOrFail' :: Binary a => FilePath -> IO (Either String a)
decodeFileOrFail' f = decodeOrFailIO =<< BSL.readFile f
encodeFile :: Binary a => FilePath -> a -> IO ()
encodeFile f = BSL.writeFile f . encode
#endif
decodeOrFailIO :: Binary a => ByteString -> IO (Either String a)
decodeOrFailIO :: forall a. Binary a => ByteString -> IO (Either FilePath a)
decodeOrFailIO ByteString
bs =
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (forall a. a -> IO a
evaluate (forall a. Binary a => ByteString -> a
decode ByteString
bs) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right) forall {m :: * -> *} {b}.
Monad m =>
ErrorCall -> m (Either FilePath b)
handler
where
#if MIN_VERSION_base(4,9,0)
handler :: ErrorCall -> m (Either FilePath b)
handler (ErrorCallWithLocation FilePath
str FilePath
_) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left FilePath
str
#else
handler (ErrorCall str) = return $ Left str
#endif