{-# LANGUAGE OverloadedStrings #-} module Tests.Pack (tests) where import Control.Monad.Trans import Control.Monad.Writer import Data.Foldable import Data.Git.Hash import Data.Git.Internal.FileUtil import Data.Git.Internal.Pack import Data.Git.Internal.Types import Data.Git.Object import Data.List (sort) import Data.Maybe (mapMaybe) import qualified Data.Set as Set import qualified Data.Text as T import qualified Data.Text.Encoding as TE import System.Posix.FilePath import System.Process (rawSystem) import System.Exit import TestUtil tests :: TestTree tests = testGroup "Pack Tests" [ testInDir "Pack Basic Data" $ do let os = [BlobObj $ Blob "a", BlobObj $ Blob "b"] [pack] <- execWriterT $ writePackFile (tell . pure) "packfile" os [packr] <- mapM (readPackFile . dropExtension) =<< findPackIdxs assertEqual "Returned wasn't read for pack" pack packr liftIO $ os @=? allObjInPacks [pack] let [o1, o2] = os liftIO $ (Just o1) @=? findPackSha pack (sha1 o1) liftIO $ (Just o2) @=? findPackSha pack (sha1 o2) , testPropInDir "Pack is readable" $ \(o, os') -> do let os = o:os' writePackFile (const (pure ())) "packfile" os [pfl] <- findPackIdxs ps <- readPackFile . dropExtension $ pfl ((&&) ((uniqAsc os) == (uniqAsc $ allObjInPacks [ps])) . (==) ExitSuccess) <$> rawSystem "git" ["verify-pack", T.unpack . TE.decodeUtf8 $ pfl] , testInDir "Basic multi-Pack" $ do let os = [BlobObj $ Blob "a", BlobObj $ Blob "b"] let [o1, o2] = os ps <- execWriterT $ do writePackFile (tell . pure) "packfile" [o1] writePackFile (tell . pure) "packfile" [o2] liftIO $ os @=? allObjInPacks ps -- TODO: As above, but in a real git repo, running repack before reading. ] uniqAsc :: Ord a => [a] -> [a] uniqAsc = sort . Set.toList . Set.fromList allObjInPacks :: [PackFile] -> [Object] allObjInPacks = concatMap (\pack -> mapMaybe (findPackSha pack) . toList . indexShas . getIndex $ pack) findPackIdxs :: IO [RawFilePath] findPackIdxs = (filter isPackIndex) <$> getRawDirectoryContents "."