packages feed

zip-conduit-0.3.0: tests/Tests.hs

{-# 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 ""