conduit 1.3 compatibility

Tested on stack lts-9 through lts-11
2018-03-21 12:31:57 -04:00 · 2018-03-21 12:31:57 -04:00 · f729f05ff5
commit f729f05ff5
parent a4381f8746
7 changed files with 60 additions and 19 deletions
--- a/Codec/Archive/Zip/Conduit/Internal.hs
+++ b/Codec/Archive/Zip/Conduit/Internal.hs
@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 module Codec.Archive.Zip.Conduit.Internal
  ( osVersion, zipVersion
  , zipError
@ -19,6 +20,13 @@ import           Data.Word (Word8, Word32, Word64)

 import           Codec.Archive.Zip.Conduit.Types

+#if MIN_VERSION_conduit(1,3,0)
+#define ConduitM ConduitT
+#define PRE13(x)
+#else
+#define PRE13(x) x
+#endif
+
 -- | The version of this zip program, really just rough indicator of compatibility
 zipVersion :: Word8
 zipVersion = 48
@ -30,7 +38,7 @@ osVersion = 0 -- DOS
 zipError :: MonadThrow m => String -> m a
 zipError = throwM . ZipError

-idConduit :: Monad m => C.Conduit a m a
+idConduit :: Monad m => C.ConduitM a a m ()
 idConduit = C.awaitForever C.yield

 passthroughFold :: Monad m => (a -> b -> a) -> a -> C.ConduitM b b m a
@ -46,16 +54,16 @@ sizeCRC = passthroughFold (\(l, c) b -> (l + fromIntegral (BS.length b), crc32Up
 sizeC :: Monad m => C.ConduitM BS.ByteString BS.ByteString m Word64
 sizeC = passthroughFold (\l b -> l + fromIntegral (BS.length b)) 0 -- fst <$> sizeCRC

-outputSize :: Monad m => C.Conduit i m BS.ByteString -> C.ConduitM i BS.ByteString m Word64
+outputSize :: Monad m => C.ConduitM i BS.ByteString m () -> C.ConduitM i BS.ByteString m Word64
 outputSize = (C..| sizeC)

-inputSize :: Monad m => C.Conduit BS.ByteString m o -> C.ConduitM BS.ByteString o m Word64
+inputSize :: Monad m => C.ConduitM BS.ByteString o m () -> C.ConduitM BS.ByteString o m Word64
 -- inputSize = fuseUpstream sizeC -- won't work because we need to deal with leftovers properly
 inputSize (CI.ConduitM src) = CI.ConduitM $ \rest -> let
  go n (CI.Done ()) = rest n
  go n (CI.PipeM m) = CI.PipeM $ go n <$> m
  go n (CI.Leftover p b) = CI.Leftover (go (n - fromIntegral (BS.length b)) p) b
-  go n (CI.HaveOutput p f o) = CI.HaveOutput (go n p) f o
+  go n (CI.HaveOutput p PRE13(f) o) = CI.HaveOutput (go n p) PRE13(f) o
  go n (CI.NeedInput p q) = CI.NeedInput (\b -> go (n + fromIntegral (BS.length b)) (p b)) (go n . q)
  in go 0 (src CI.Done)

--- a/Codec/Archive/Zip/Conduit/UnZip.hs
+++ b/Codec/Archive/Zip/Conduit/UnZip.hs
@ -1,4 +1,5 @@
 -- |Stream the extraction of a zip file, e.g., as it's being downloaded.
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE RankNTypes #-}
 module Codec.Archive.Zip.Conduit.UnZip
@ -9,7 +10,9 @@ module Codec.Archive.Zip.Conduit.UnZip

 import           Control.Applicative ((<|>), empty)
 import           Control.Monad (when, unless, guard)
+#if !MIN_VERSION_conduit(1,3,0)
 import           Control.Monad.Base (MonadBase)
+#endif
 import           Control.Monad.Catch (MonadThrow)
 import           Control.Monad.Primitive (PrimMonad)
 import qualified Data.Binary.Get as G
@ -28,7 +31,7 @@ import           Codec.Archive.Zip.Conduit.Internal

 data Header m
  = FileHeader
-    { fileDecompress :: C.Conduit BS.ByteString m BS.ByteString
+    { fileDecompress :: C.ConduitM BS.ByteString BS.ByteString m ()
    , fileEntry :: !ZipEntry
    , fileCRC :: !Word32
    , fileCSize :: !Word64
@ -53,7 +56,7 @@ data ExtField = ExtField
  }
 -}

-pass :: (MonadThrow m, Integral n) => n -> C.Conduit BS.ByteString m BS.ByteString
+pass :: (MonadThrow m, Integral n) => n -> C.ConduitM BS.ByteString BS.ByteString m ()
 pass 0 = return ()
 pass n = C.await >>= maybe
  (zipError $ "EOF in file data, expecting " ++ show ni ++ " more bytes")
@ -94,7 +97,14 @@ fromDOSTime time date = LocalTime
 -- It does not (ironically) support uncompressed zip files that have been created as streams, where file sizes are not known beforehand.
 -- Since it does not use the offset information at the end of the file, it assumes all entries are packed sequentially, which is usually the case.
 -- Any errors are thrown in the underlying monad (as 'ZipError's or 'Data.Conduit.Serialization.Binary.ParseError').
-unZipStream :: (MonadBase b m, PrimMonad b, MonadThrow m) => C.ConduitM BS.ByteString (Either ZipEntry BS.ByteString) m ZipInfo
+unZipStream ::
+  ( MonadThrow m
+#if MIN_VERSION_conduit(1,3,0)
+  , PrimMonad m
+#else
+  , MonadBase b m, PrimMonad b
+#endif
+  ) => C.ConduitM BS.ByteString (Either ZipEntry BS.ByteString) m ZipInfo
 unZipStream = next where
  next = do -- local header, or start central directory
    h <- sinkGet $ do
--- a/Codec/Archive/Zip/Conduit/Zip.hs
+++ b/Codec/Archive/Zip/Conduit/Zip.hs
@ -1,4 +1,5 @@
 -- |Stream the creation of a zip file, e.g., as it's being uploaded.
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ViewPatterns #-}
 module Codec.Archive.Zip.Conduit.Zip
@ -14,7 +15,9 @@ module Codec.Archive.Zip.Conduit.Zip
 import qualified Codec.Compression.Zlib.Raw as Z
 import           Control.Arrow ((&&&), (+++), left)
 import           Control.Monad (when)
+#if !MIN_VERSION_conduit(1,3,0)
 import           Control.Monad.Base (MonadBase)
+#endif
 import           Control.Monad.Catch (MonadThrow)
 import           Control.Monad.Primitive (PrimMonad)
 import           Control.Monad.State.Strict (StateT, get)
@ -63,7 +66,7 @@ False ?* _ = 0
 zipFileData :: MonadResource m => FilePath -> ZipData m
 zipFileData = ZipDataSource . CB.sourceFile

-zipData :: Monad m => ZipData m -> Either (C.Source m BS.ByteString) BSL.ByteString
+zipData :: Monad m => ZipData m -> Either (C.ConduitM () BS.ByteString m ()) BSL.ByteString
 zipData (ZipDataByteString b) = Right b
 zipData (ZipDataSource s) = Left s

@ -77,7 +80,7 @@ toDOSTime (LocalTime (toGregorian -> (year, month, day)) (TimeOfDay hour mins se
  , fromIntegral (year - 1980) `shiftL` 9 .|. fromIntegral month `shiftL` 5 .|. fromIntegral day
  )

-countOutput :: Monad m => C.Conduit i m BS.ByteString -> C.Conduit i (StateT Word64 m) BS.ByteString
+countOutput :: Monad m => C.ConduitM i BS.ByteString m () -> C.ConduitM i BS.ByteString (StateT Word64 m) ()
 countOutput c = stateC $ \s -> (,) () . (s +) <$> outputSize c

 output :: MonadThrow m => P.Put -> C.ConduitM i BS.ByteString (StateT Word64 m) ()
@ -92,7 +95,14 @@ maxBound16 = fromIntegral (maxBound :: Word16)
 --
 -- Depending on options, the resulting zip file should be compatible with most unzipping applications.
 -- Any errors are thrown in the underlying monad (as 'ZipError's).
-zipStream :: (MonadBase b m, PrimMonad b, MonadThrow m) => ZipOptions -> C.ConduitM (ZipEntry, ZipData m) BS.ByteString m Word64
+zipStream :: 
+  ( MonadThrow m
+#if MIN_VERSION_conduit(1,3,0)
+  , PrimMonad m
+#else
+  , MonadBase b m, PrimMonad b
+#endif
+  ) => ZipOptions -> C.ConduitM (ZipEntry, ZipData m) BS.ByteString m Word64
 zipStream ZipOptions{..} = execStateC 0 $ do
  (cnt, cdir) <- next 0 (return ())
  cdoff <- get
--- a/cmd/unzip.hs
+++ b/cmd/unzip.hs
@ -7,6 +7,7 @@ import qualified Data.ByteString.Char8 as BSC
 import qualified Data.Conduit as C
 import qualified Data.Conduit.Binary as CB
 import           Data.Time.LocalTime (localTimeToUTC, utc)
+import           Data.Void (Void)
 import           System.Directory (createDirectoryIfMissing
 #if MIN_VERSION_directory(1,2,3)
  , setModificationTime
@ -19,7 +20,7 @@ import           System.IO (stdin, openFile, IOMode(WriteMode), hClose, hSetFile

 import           Codec.Archive.Zip.Conduit.UnZip

-extract :: C.Sink (Either ZipEntry BS.ByteString) IO ()
+extract :: C.ConduitM (Either ZipEntry BS.ByteString) Void IO ()
 extract = C.awaitForever start where
  start (Left ZipEntry{..}) = do
    liftIO $ BSC.putStrLn zipEntryName
--- a/cmd/zip.hs
+++ b/cmd/zip.hs
@ -10,7 +10,12 @@ import           Data.Time.LocalTime (utcToLocalTime, utc)
 import qualified System.Console.GetOpt as Opt
 import           System.Directory (doesDirectoryExist, getModificationTime
 #if MIN_VERSION_directory(1,2,6)
-  , isSymbolicLink, listDirectory
+#if MIN_VERSION_directory(1,3,0)
+  , pathIsSymbolicLink
+#else
+  , isSymbolicLink
+#endif
+  , listDirectory
 #else
  , getDirectoryContents
 #endif
@ -34,7 +39,7 @@ opts =
    "set zip comment"
  ]

-generate :: (MonadIO m, MonadResource m) => [FilePath] -> C.Source m (ZipEntry, ZipData m)
+generate :: (MonadIO m, MonadResource m) => [FilePath] -> C.ConduitM () (ZipEntry, ZipData m) m ()
 generate (p:paths) = do
  t <- liftIO $ getModificationTime p
  let e = ZipEntry
@ -45,10 +50,17 @@ generate (p:paths) = do
  isd <- liftIO $ doesDirectoryExist p
  if isd
    then do
+      dl <- liftIO $
 #if MIN_VERSION_directory(1,2,6)
-      dl <- liftIO $ filterM (fmap not . isSymbolicLink) . map (p </>) =<< listDirectory p
+        filterM (fmap not .
+#if MIN_VERSION_directory(1,3,0)
+          pathIsSymbolicLink
 #else
-      dl <- liftIO $ filter (`notElem` [".",".."]) . map (p </>) <$> getDirectoryContents p
+          isSymbolicLink
+#endif
+          ) . map (p </>) =<< listDirectory p
+#else
+        filter (`notElem` [".",".."]) . map (p </>) <$> getDirectoryContents p
 #endif
      C.yield (e{ zipEntryName = zipEntryName e `BSC.snoc` '/', zipEntrySize = Just 0 }, mempty)
      generate $ dl ++ paths
--- a/stack.yaml
+++ b/stack.yaml
@ -1,4 +1,4 @@
-resolver: lts-9.9
+resolver: lts-11.1
 packages:
 - '.'
 extra-deps: []
--- a/zip-stream.cabal
+++ b/zip-stream.cabal
@ -23,7 +23,7 @@ library
  other-modules:
    Codec.Archive.Zip.Conduit.Internal
  default-language:    Haskell2010
-  ghc-options: -Wall
+  ghc-options: -Wall -Werror
  build-depends:       
    base >= 4.8 && < 5,
    binary >= 0.7.2,
@ -44,7 +44,7 @@ executable unzip-stream
  main-is: unzip.hs
  hs-source-dirs: cmd
  default-language:    Haskell2010
-  ghc-options: -Wall
+  ghc-options: -Wall -Werror
  build-depends:
    base >=4.8 && <5,
    bytestring,
@ -60,7 +60,7 @@ executable zip-stream
  main-is: zip.hs
  hs-source-dirs: cmd
  default-language:    Haskell2010
-  ghc-options: -Wall
+  ghc-options: -Wall -Werror
  build-depends:
    base >=4.8 && <5,
    bytestring,