{-# LANGUAGE OverloadedStrings #-} module Main where import Prelude hiding (zip) import Control.Monad import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B import Data.List ((\\)) import Data.Time import System.Directory import System.FilePath import System.IO import Control.Monad.State import Data.Conduit import qualified Data.Conduit.List as CL import System.IO.Temp import Test.Framework import Test.Framework.Providers.HUnit import Test.HUnit hiding (Test, path) import Codec.Archive.Zip main :: IO () main = defaultMain tests tests :: [Test] tests = [ testGroup "cases" [ testCase "conduit " (assertConduit sinkEntry) , testCase "conduit-un " (assertConduit sinkEntryUncompressed) , testCase "conduit-dep" assertConduitDeprecated , testCase "files " assertFiles ] ] assertConduit :: Monad m => (FilePath -> Source m ByteString -> Archive b) -> IO () assertConduit s = withSystemTempDirectory "zip-conduit" $ \dir -> do let archivePath = dir archiveName archive s archivePath entriesInfo result <- unarchive archivePath entriesInfo assertEqual "" [] (entriesInfo \\ result) where archiveName = "test.zip" entriesInfo = [ ("test1.txt", "some test text") , ("test2.txt", "some another test text") , ("test3.txt", "one more") ] assertFiles :: Assertion assertFiles = withSystemTempDirectory "zip-conduit" $ \dir -> do -- create files filePaths <- putFiles dir filesInfo -- archive and unarchive withArchive (dir archiveName) $ do addFiles filePaths names <- entryNames extractFiles names dir -- read unarchived files result <- getFiles dir -- compare assertEqual "" [] (filesInfo \\ result) where archiveName = "test.zip" filesInfo = [ ("test1.txt", "some test text") , ("test2.txt", "some another test text") , ("test3.txt", "one more") ] putFiles :: FilePath -> [(FilePath, ByteString)] -> IO [FilePath] putFiles dir fileInfo = forM fileInfo $ \(name, content) -> do let path = dir name withFile path WriteMode $ \h -> do B.hPut h content return path getFiles :: FilePath -> IO [(FilePath, ByteString)] getFiles dir = do let path = dir dropDrive dir dirContents <- getDirectoryContents path let resultFiles = map (path ) $ filter (`notElem` [".", ".."]) dirContents forM resultFiles $ \file -> do content <- withFile file ReadMode B.hGetContents return (takeFileName file, content) archive :: Monad m => (FilePath -> Source m ByteString -> Archive b) -> FilePath -> [(FilePath, ByteString)] -> IO () archive s archivePath entriesInfo = withArchive archivePath $ forM_ entriesInfo $ \(entryName, content) -> s entryName $ CL.sourceList [content] unarchive :: FilePath -> [(FilePath, ByteString)] -> IO [(FilePath, ByteString)] unarchive archivePath entriesInfo = withArchive archivePath $ forM entriesInfo $ \(entryName, _) -> do content <- sourceEntry entryName $ CL.fold B.append "" return (entryName, content) ------------------------------------------------------------------------------ -- Tests for deprecated functions assertConduitDeprecated :: Assertion assertConduitDeprecated = withSystemTempDirectory "zip-conduit" $ \dir -> do let archivePath = dir archiveName archiveD archivePath fileName content result <- unarchiveD archivePath fileName assertEqual "" content result where archiveName = "test.zip" fileName = "test.txt" content = "some not really long test text" -- | Creates new archive at 'archivePath' and puts there file with -- 'content'. archiveD :: FilePath -> FilePath -> ByteString -> IO () archiveD archivePath fileName content = do time <- liftIO getCurrentTime withArchive archivePath $ do sink <- getSink fileName time runResourceT $ CL.sourceList [content] $$ sink -- | Gets content from 'fileName' in archive at 'arcihvePath'. unarchiveD :: FilePath -> FilePath -> IO ByteString unarchiveD archivePath fileName = withArchive archivePath $ do source <- getSource fileName runResourceT $ source $$ CL.fold B.append ""