diff --git a/Data/Git/Storage.hs b/Data/Git/Storage.hs --- a/Data/Git/Storage.hs +++ b/Data/Git/Storage.hs @@ -167,6 +167,7 @@ exists <- isDirectory path when exists $ error "destination directory already exists" createParentDirectory path + createDirectory False path mapM_ (createDirectory False . (path )) [ "branches", "hooks", "info" , "logs", "objects", "refs" diff --git a/Tests/Monad.hs b/Tests/Monad.hs deleted file mode 100644 --- a/Tests/Monad.hs +++ /dev/null @@ -1,63 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Monad - ( testGitMonadLocal - ) where - -import Control.Applicative -import Control.Exception -import Control.Monad - -import Data.Git.Monad -import Data.Git.Types (GitTime(..)) -import System.Exit -import qualified System.Hourglass as T - -testBranch :: RefName -testBranch = "test/not/push" - -catchAll :: IO (Either String a) -> IO () -catchAll f = do - r <- catchAll' f - case r of - Left err -> failWith $ show err - Right (Left err) -> failWith err - Right (Right _) -> putStrLn " test/git/monad [OK]" - where - catchAll' :: IO a -> IO (Either SomeException a) - catchAll' f = try f - - failWith :: String -> IO () - failWith msg = do - putStrLn " test/git/monad [FAILED]" - putStrLn $ " - " ++ msg - exitFailure - -testGitMonadLocal :: IO () -testGitMonadLocal = catchAll (withCurrentRepo testGitMonad) - -timeCurrentGit :: GitM GitTime -timeCurrentGit = liftGit $ GitTime - <$> T.timeCurrent - <*> T.timezoneCurrent - -step :: String -> GitM () -step = liftGit . putStrLn - -testGitMonad :: GitM () -testGitMonad = do - t <- timeCurrentGit - let person = Person - { personName = "Hit Test Machinery" - , personEmail = "hit@snarc.org" - , personTime = t - } - withBranch person testBranch True (return ()) $ \isFirstCommit -> case isFirstCommit of - Nothing -> setMessage "Initial commit" - Just _ -> setMessage "add new commit" - step " + new branch created" - withCommit testBranch $ do - author <- getAuthor - when (t /= personTime author) - $ fail "master's commit is not the last commit performed" - step " + branch has been verified" diff --git a/Tests/Repo.hs b/Tests/Repo.hs deleted file mode 100644 --- a/Tests/Repo.hs +++ /dev/null @@ -1,67 +0,0 @@ -{-# 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 () diff --git a/Tests/Tests.hs b/Tests/Tests.hs deleted file mode 100644 --- a/Tests/Tests.hs +++ /dev/null @@ -1,139 +0,0 @@ -{-# LANGUAGE FlexibleInstances #-} -import Test.Tasty.QuickCheck -import Test.Tasty - -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.Ref -import Data.Git.Revision -import Data.Git.Types -import Data.Hourglass - -import Data.Maybe - --- for arbitrary instance to generate only data that are writable --- to disk. i.e. no deltas. -data ObjNoDelta hash = ObjNoDelta (Object hash) - deriving (Eq) - -instance Show (ObjNoDelta hash) where - show (ObjNoDelta o) = show o - -arbitraryBS size = B.pack . map fromIntegral <$> replicateM size (choose (0,255) :: Gen Int) -arbitraryBSno0 size = B.pack . map fromIntegral <$> replicateM size (choose (1,255) :: Gen Int) -arbitraryBSasciiNoSpace size = B.pack . map fromIntegral <$> replicateM size (choose (0x21,0x7f) :: Gen Int) -arbitraryBSascii size = B.pack . map fromIntegral <$> replicateM size (choose (0x20,0x7f) :: Gen Int) -arbitraryBSnoangle size = B.pack . map fromIntegral <$> replicateM size (choose (0x40,0x7f) :: Gen Int) - -arbitraryEntname size = entName . B.pack . map fromIntegral <$> replicateM size range - where range :: Gen Int - range = oneof [ choose (0x21, 0x2e) -- remove 0x2f (slash) - , choose (0x30, 0x7f) - ] - -arbitraryRef :: HashAlgorithm hash => hash -> Gen (Ref hash) -arbitraryRef alg = fromBinary <$> arbitraryBS (hashDigestSize alg) - -instance HashAlgorithm hash => Arbitrary (Ref hash) where - arbitrary = arbitraryRef (error "alg") - -arbitraryMsg = arbitraryBSno0 1 -arbitraryLazy = L.fromChunks . (:[]) <$> arbitraryBS 40 - -arbitraryRefList :: Gen [Ref SHA1] -arbitraryRefList = replicateM 2 arbitrary - -arbitraryEnt :: Gen (TreeEnt SHA1) -arbitraryEnt = liftM3 (,,) arbitrary (arbitraryEntname 23) arbitrary -arbitraryEnts = choose (1,2) >>= \i -> replicateM i arbitraryEnt - -instance Arbitrary TimezoneOffset where - arbitrary = TimezoneOffset <$> choose (-11*60, 12*60) -instance Arbitrary Elapsed where - arbitrary = Elapsed . Seconds <$> choose (0,2^32-1) -instance Arbitrary GitTime where - arbitrary = GitTime <$> arbitrary <*> arbitrary -instance Arbitrary ModePerm where - arbitrary = ModePerm <$> elements [ 0o644, 0o664, 0o755, 0 ] -instance Arbitrary RevModifier where - arbitrary = oneof - [ RevModParent . getPositive <$> arbitrary - , RevModParentFirstN . getPositive <$> arbitrary - , RevModAtType <$> arbitraryType - , RevModAtDate <$> arbitraryDate - --, RevModAtN . getPositive <$> arbitrary - ] - -arbitraryDate = elements ["yesterday","29-Jan-1982","5 days ago"] -arbitraryType = elements ["commit","tree"] - -instance Arbitrary Revision where - arbitrary = do - s <- choose (1,40) >>= flip replicateM (elements ['a'..'z']) - rms <- choose (1,4) >>= flip replicateM arbitrary - return $ Revision s rms - -arbitraryName = liftM3 Person (arbitraryBSnoangle 16) - (arbitraryBSnoangle 16) - arbitrary - -arbitraryObjTypeNoDelta = oneof [return TypeTree,return TypeBlob,return TypeCommit,return TypeTag] - -arbitrarySmallList = frequency [ (2, return []), (1, resize 3 arbitrary) ] - -instance Arbitrary (Commit SHA1) where - arbitrary = Commit <$> arbitrary <*> arbitraryRefList <*> arbitraryName <*> arbitraryName <*> return Nothing <*> arbitrarySmallList <*> arbitraryMsg - -instance Arbitrary CommitExtra where - arbitrary = CommitExtra <$> arbitraryBSasciiNoSpace 80 <*> arbitraryMsg - -instance Arbitrary (Tree SHA1) where - arbitrary = Tree <$> arbitraryEnts - -instance Arbitrary (Blob SHA1) where - arbitrary = Blob <$> arbitraryLazy - -instance Arbitrary (Tag SHA1) where - arbitrary = Tag <$> arbitrary <*> arbitraryObjTypeNoDelta <*> arbitraryBSascii 20 <*> arbitraryName <*> arbitraryMsg - -instance Arbitrary (ObjNoDelta SHA1) where - arbitrary = ObjNoDelta <$> oneof - [ toObject <$> (arbitrary :: Gen (Commit SHA1)) - , toObject <$> (arbitrary :: Gen (Tree SHA1)) - , toObject <$> (arbitrary :: Gen (Blob SHA1)) - , toObject <$> (arbitrary :: Gen (Tag SHA1)) - ] - -prop_object_marshalling_id :: ObjNoDelta SHA1 -> Bool -prop_object_marshalling_id (ObjNoDelta obj) = - let unmarshall = looseUnmarshall :: L.ByteString -> Object SHA1 - in obj `assertEq` (unmarshall $ looseMarshall obj) - where assertEq a b - | show a == show b = True - | otherwise = error ("not equal:\n" ++ show a ++ "\ngot: " ++ show b) - -refTests = - [ testProperty "hexadecimal" (marshEqual (fromHex . toHex :: Ref SHA1 -> Ref SHA1)) - , testProperty "binary" (marshEqual (fromBinary . toBinary :: Ref SHA1 -> Ref SHA1)) - , testProperty "ref" $ marshEqual (fromString . show :: Revision -> Revision) - ] - where - marshEqual t ref = ref `assertEq` t ref - assertEq a b - | a == b = True - | otherwise = error ("expecting: " ++ show a ++ " got: " ++ show b) - -objTests = - [ testProperty "unmarshall.marshall==id" prop_object_marshalling_id - ] - -main = defaultMain $ testGroup "hit" - [ testGroup "ref marshalling" refTests - , testGroup "object marshalling" objTests - ] diff --git a/git.cabal b/git.cabal --- a/git.cabal +++ b/git.cabal @@ -1,5 +1,5 @@ Name: git -Version: 0.2.0 +Version: 0.2.1 Synopsis: Git operations in haskell Description: . @@ -20,27 +20,18 @@ Stability: experimental Build-Type: Simple Homepage: https://github.com/vincenthz/hs-git -tested-with: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1 +tested-with: GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.2 Cabal-Version: >=1.8 data-files: README.md -extra-source-files: Tests/*.hs - -Flag executable - Description: Build the executable - Default: False - -Flag debug - Description: Add some debugging options - Default: False +extra-source-files: tests/*.hs Library Build-Depends: base >= 4 && < 5 - , mtl , bytestring >= 0.9 , byteable , containers , memory >= 0.13 - , cryptonite + , cryptonite >= 0.22 , vector , random , zlib