{-# LANGUAGE OverloadedStrings #-}
module Main ( main ) where

import           Codec.Archive
import           Codec.Archive.Roundtrip (itPacksUnpacks, itPacksUnpacksViaFS, roundtrip, roundtripFreaky, roundtripStrict)
import           Codec.Archive.Test
import           Data.Either             (isRight)
import           Data.Foldable           (traverse_)
import           System.Directory        (doesDirectoryExist, listDirectory)
import           System.FilePath         ((</>))
import           System.IO.Temp          (withSystemTempDirectory)
import           Test.Hspec

testFp :: FilePath -> Spec
testFp fp = parallel $ it ("sucessfully unpacks/packs (" ++ fp ++ ")") $
    roundtrip fp >>= (`shouldSatisfy` isRight)

testFpStrict :: FilePath -> Spec
testFpStrict fp = parallel $ it ("works on strict bytestring (" ++ fp ++ ")") $
    roundtripStrict fp >>= (`shouldSatisfy` isRight)

testFpFreaky :: FilePath -> Spec
testFpFreaky fp = parallel $ it ("works on nonstandard bytestring (" ++ fp ++ ")") $
    roundtripFreaky fp >>= (`shouldSatisfy` isRight)

unpack :: FilePath -> IO (Either ArchiveResult ())
unpack fp = withSystemTempDirectory "libarchive" $
    \tmp -> runArchiveM $ unpackArchive fp tmp

readArchiveFile' :: FilePath -> IO (Either ArchiveResult [Entry])
readArchiveFile' = runArchiveM . readArchiveFile

testUnpackLibarchive :: FilePath -> Spec
testUnpackLibarchive fp = parallel $ it ("unpacks " ++ fp) $
    unpack fp >>= (`shouldSatisfy` isRight)

testReadArchiveFile :: FilePath -> Spec
testReadArchiveFile fp = parallel $ it ("reads " ++ fp) $
    readArchiveFile' fp >>= (`shouldSatisfy` isRight)

main :: IO ()
main = do

    dir <- doesDirectoryExist "test/data"
    tarballs <- if dir then listDirectory "test/data" else pure []
    let tarPaths = ("test/data" </>) <$> tarballs

    hspec $
        describe "roundtrip" $ do

            traverse_ testFp tarPaths
#ifndef LOW_MEMORY
            traverse_ testFpFreaky tarPaths
            traverse_ testFpStrict tarPaths
#endif
            traverse_ testUnpackLibarchive tarPaths
            traverse_ testReadArchiveFile tarPaths

            context "with symlinks" $ do
                let entries =
                        [ simpleDir "x/"
                        , simpleFile "x/a.txt" (NormalFile "referenced")
                        , simpleFile "x/b.txt" (Symlink "a.txt" SymlinkUndefined)
                        ]
                itPacksUnpacks entries
                itPacksUnpacksViaFS entries

            context "with hardlinks" $ do
                let entries =
                        [ simpleDir "x/"
                        , simpleFile "x/a.txt" (NormalFile "shared")
                        , simpleFile "x/b.txt" (Hardlink "x/a.txt")
                        ]
                itPacksUnpacks entries
                context "issue#4" $ itPacksUnpacksViaFS entries

            context "with forward referenced hardlinks" $ do
                let entries =
                        [ simpleDir "x/"
                        , simpleFile "x/b.txt" (Hardlink "x/a.txt")
                        , simpleFile "x/a.txt" (NormalFile "shared")
                        ]
                itPacksUnpacks entries
                xcontext "re-ordering on unpack" $ itPacksUnpacksViaFS entries

            xcontext "having entry without ownership" . itPacksUnpacks $
                [ stripOwnership (simpleFile "a.txt" (NormalFile "text")) ]
            xcontext "having entry without timestamp" . itPacksUnpacks $
                [ stripTime (simpleFile "a.txt" (NormalFile "text")) ]