e825007 · Idris-dev · git.iko.soy

idris.cabal+1

compare with master

unifiedsplit

@@ -412,6 +412,7 @@ Library

412 Util.Pretty

413 , Util.System

414 , Util.Net

415+ , Util.Zlib

415

416

416 , Pkg.PParser

417 , Pkg.PParser

417

418

src/Idris/IBC.hs+9−5

@@ -21,11 +21,9 @@ import Control.Monad.State.Strict hiding (get, put)

21import qualified Control.Monad.State.Strict as ST

22import System.FilePath

23import System.Directory

24−import Codec.Compression.Zlib

24+import Codec.Compression.Zlib (compress)

25+import Util.Zlib (decompressEither)

25

26

26−import Debug.Trace

27−

28−import Paths_idris

29

27

30ibcVersion :: Word8

28ibcVersion :: Word8

31ibcVersion = 54

29ibcVersion = 54

@@ -74,9 +72,15 @@ loadIBC fp = do iLOG $ "Loading ibc " ++ fp

74 ibcf <- runIO $ (bdecode fp :: IO IBCFile)

72 ibcf <- runIO $ (bdecode fp :: IO IBCFile)

75 process ibcf fp

73 process ibcf fp

76

74

75+bencode :: Binary a => FilePath -> a -> IO ()

77bencode f d = B.writeFile f (compress (encode d))

76bencode f d = B.writeFile f (compress (encode d))

77+

78+bdecode :: Binary b => FilePath -> IO b

78bdecode f = do d' <- B.readFile f

79bdecode f = do d' <- B.readFile f

80+ either

81+ (\(_, e) -> error $ "Invalid / corrupted zip format on " ++ show f ++ ": " ++ e)

79− return (decode (decompress d'))

82+ (return . decode)

83+ (decompressEither d')

80

84

81writeIBC :: FilePath -> FilePath -> Idris ()

85writeIBC :: FilePath -> FilePath -> Idris ()

82writeIBC src f

86writeIBC src f

src/Util/Zlib.hsnew file+15

@@ -0,0 +1,15 @@

1+module Util.Zlib (decompressEither) where

2+

3+-- From http://stackoverflow.com/questions/10043102/how-to-catch-the-decompress-ioerror/10045963#10045963

4+import Codec.Compression.Zlib.Internal

5+import Data.ByteString.Lazy (ByteString, fromChunks)

6+import Control.Arrow (right)

7+

8+decompressEither :: ByteString -> Either (DecompressError, String) ByteString

9+decompressEither = finalise

10+ . foldDecompressStream cons nil err

11+ . decompressWithErrors zlibFormat defaultDecompressParams

12+ where err errorCode errorString = Left (errorCode, errorString)

13+ nil = Right []

14+ cons chunk = right (chunk :)

15+ finalise = right fromChunks