module Text.XML.HXT.Arrow.Binary
( readBinaryValue
, writeBinaryValue
)
where
import Control.Arrow ()
import Control.Arrow.ArrowExc
import Control.Arrow.ArrowIO
import Control.Arrow.ArrowList
import Data.Binary
import qualified Data.ByteString.Lazy as B
import System.IO (IOMode (..), hClose,
openBinaryFile)
import Text.XML.HXT.Arrow.XmlState.ErrorHandling
import Text.XML.HXT.Arrow.XmlState.TypeDefs
readBinaryValue :: (Binary a) => String -> IOStateArrow s b a
readBinaryValue :: forall a s b. Binary a => String -> IOStateArrow s b a
readBinaryValue String
file
= (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a b. (a -> b) -> a -> b
$ forall a s b.
Binary a =>
String -> Bool -> DeCompressionFct -> IOStateArrow s b a
decodeBinaryValue String
file)
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< forall c s b. Selector XIOSysState c -> IOStateArrow s b c
getSysVar ( Selector XIOSysState Bool
theStrictDeserialize
forall s a b. Selector s a -> Selector s b -> Selector s (a, b)
.&&&.
Selector XIOSysState DeCompressionFct
theBinaryDeCompression
)
decodeBinaryValue :: (Binary a) => String -> Bool -> DeCompressionFct -> IOStateArrow s b a
decodeBinaryValue :: forall a s b.
Binary a =>
String -> Bool -> DeCompressionFct -> IOStateArrow s b a
decodeBinaryValue String
file Bool
strict DeCompressionFct
decompress
= forall (a :: * -> * -> *) c b. ArrowIO a => IO c -> a b c
arrIO0 IO a
dec
forall (a :: * -> * -> *) b c.
ArrowExc a =>
a b c -> a SomeException c -> a b c
`catchA`
forall s b. String -> IOStateArrow s SomeException b
issueExc String
"readBinaryValue"
where
dec :: IO a
dec = ( if Bool
strict
then IO ByteString
readItAll
else String -> IO ByteString
B.readFile String
file
) 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. Binary a => ByteString -> a
decode forall b c a. (b -> c) -> (a -> b) -> a -> c
. DeCompressionFct
decompress
readItAll :: IO ByteString
readItAll = do
Handle
h <- String -> IOMode -> IO Handle
openBinaryFile String
file IOMode
ReadMode
ByteString
c <- Handle -> IO ByteString
B.hGetContents Handle
h
ByteString -> Int64
B.length ByteString
c seq :: forall a b. a -> b -> b
`seq`
do
Handle -> IO ()
hClose Handle
h
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
c
writeBinaryValue :: (Binary a) => String -> IOStateArrow s a ()
writeBinaryValue :: forall a s. Binary a => String -> IOStateArrow s a ()
writeBinaryValue String
file = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a s.
Binary a =>
DeCompressionFct -> String -> IOStateArrow s a ()
encodeBinaryValue String
file forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< forall c s b. Selector XIOSysState c -> IOStateArrow s b c
getSysVar Selector XIOSysState DeCompressionFct
theBinaryCompression
encodeBinaryValue :: (Binary a) => CompressionFct -> String -> IOStateArrow s a ()
encodeBinaryValue :: forall a s.
Binary a =>
DeCompressionFct -> String -> IOStateArrow s a ()
encodeBinaryValue DeCompressionFct
compress String
file
= forall (a :: * -> * -> *) b c. ArrowIO a => (b -> IO c) -> a b c
arrIO a -> IO ()
enc
forall (a :: * -> * -> *) b c.
ArrowExc a =>
a b c -> a SomeException c -> a b c
`catchA`
forall s b. String -> IOStateArrow s SomeException b
issueExc String
"writeBinaryXmlTree"
where
enc :: a -> IO ()
enc = String -> ByteString -> IO ()
B.writeFile String
file forall b c a. (b -> c) -> (a -> b) -> a -> c
. DeCompressionFct
compress forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Binary a => a -> ByteString
encode