module Text.XML.HXT.Arrow.Binary
( readBinaryValue
, writeBinaryValue
)
where
import Control.Exception ( SomeException
, try
)
import Codec.Compression.BZip ( compress
, decompress
)
import Data.Binary
import qualified Data.ByteString.Lazy as B
import Text.XML.HXT.Arrow
readBinaryValue :: (Binary a) => Bool -> String -> IOStateArrow s b a
readBinaryValue c f = arrIO (\ _ -> try' $ dec c)
>>>
issueExc "readBinaryValue"
where
dec False = decodeFile f
dec True = B.readFile f >>= return . decode . decompress
writeBinaryValue :: (Binary a) => Bool -> String -> IOStateArrow s a ()
writeBinaryValue c f = arrIO (\ x -> try' $ enc c x)
>>>
issueExc "writeBinaryXmlTree"
where
enc False = encodeFile f
enc True = B.writeFile f . compress . encode
issueExc :: String -> IOStateArrow s (Either SomeException a) a
issueExc s = ( ( issueFatal $< arr ((("Exception in " ++ s ++ ": ") ++) . show)
>>>
none
)
|||
this
)
try' :: IO a -> IO (Either SomeException a)
try' = try