Pack.hs

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