{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
module Main where
import Control.Monad (forM, forM_)
import Control.Monad.IO.Class (liftIO)
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B (append, hGetContents, hPut)
import Data.List ((\\))
import Data.Maybe (fromMaybe)
import Data.Time (getCurrentTime)
import System.Directory (getDirectoryContents)
import System.FilePath ((</>), dropDrive, takeFileName)
import System.IO (IOMode(..), withFile)
import Data.Conduit (runConduitRes, ConduitT, (.|))
import qualified Data.Conduit.List as CL (fold, sourceList)
import System.IO.Temp (withSystemTempDirectory)
import Test.Framework (Test, defaultMain, testGroup)
import Test.Framework.Providers.HUnit (testCase)
import Test.HUnit (Assertion, assertEqual)
import "zip-conduit" 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 Nothing)
, testCase "files-as " (assertFiles $ Just ("contents" </>))
]
]
assertConduit :: Monad m
=> (FilePath -> ConduitT () ByteString m () -> 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 :: Maybe (FilePath -> FilePath) -> Assertion
assertFiles mFunPath =
withSystemTempDirectory "zip-conduit" $ \dir -> do
-- create files
filePaths <- putFiles dir filesInfo
-- archive and unarchive
withArchive (dir </> archiveName) $ do
addFilesAdjusted 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")
]
adjustPath = fromMaybe id mFunPath
addFilesAdjusted = maybe addFiles addFilesAs mFunPath
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 </> (adjustPath $ 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 -> ConduitT () ByteString m () -> 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 <- getCurrentTime
withArchive archivePath $ do
sink <- getSink fileName time
liftIO . runConduitRes $ 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
liftIO . runConduitRes $ source .| CL.fold B.append ""