git-0.2.0: Tests/Repo.hs

{-# LANGUAGE ScopedTypeVariables #-}
import Test.Tasty
import Test.Tasty.QuickCheck

import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString as B

import Control.Applicative
import Control.Monad

import Data.Git.Storage.Object
import Data.Git.Storage.Loose
import Data.Git.Storage
import Data.Git.Ref
import Data.Git.Types
import Data.Git.Repository

import Data.Maybe

import Text.Bytedump
import System.Exit

import Monad

onLocalRepo f = do
    fpath <- findRepoMaybe
    case fpath of
        Nothing -> putStrLn "cannot run this test without repository. clone the original repository for test"
        Just _  -> withCurrentRepo f

doLocalMarshallEq
    :: Git SHA1
    -> IO [[Maybe (Ref SHA1, Ref SHA1, (ObjectHeader SHA1, L.ByteString), (ObjectHeader SHA1, L.ByteString))]]
doLocalMarshallEq git = do
     prefixes <- looseEnumeratePrefixes (gitRepoPath git)
     forM prefixes $ \prefix -> do
         refs <- looseEnumerateWithPrefix (gitRepoPath git) prefix
         forM refs $ \ref -> do
             raw <- looseReadRaw (gitRepoPath git) ref
             obj <- looseRead (gitRepoPath git) ref
             let content = looseMarshall obj
             let raw2 = looseUnmarshallRaw content
             let hashed = hashLBS content
             if ref /= hashed
                  then return $ Just (ref, hashed, raw, raw2)
                  else return Nothing

printDiff (actualRef, gotRef, (actualHeader, actualRaw), (gotHeader, gotRaw)) = do
    putStrLn "=========== difference found"
    putStrLn ("ref expected: " ++ show actualRef)
    putStrLn ("ref got     : " ++ show gotRef)
    putStrLn ("header expected: " ++ show actualHeader)
    putStrLn ("header got     : " ++ show gotHeader)
    putStrLn "raw diff:"
    putStrLn $ dumpDiffLBS actualRaw gotRaw

printLocalMarshallError l
    | null l    = putStrLn "local marshall:   [OK]"
    | otherwise = putStrLn ("local marshall: [" ++ show (length l) ++ " errors]")
               >> mapM_ printDiff l
               >> exitFailure

main = do
    onLocalRepo $ \(git :: Git SHA1) -> do
        doLocalMarshallEq git >>= printLocalMarshallError . catMaybes . concat
        testGitMonadLocal
        return ()