git 0.2.0 → 0.2.1
raw patch · 5 files changed
+5/−282 lines, 5 filesdep −mtldep ~cryptonitePVP ok
version bump matches the API change (PVP)
Dependencies removed: mtl
Dependency ranges changed: cryptonite
API changes (from Hackage documentation)
Files
- Data/Git/Storage.hs +1/−0
- Tests/Monad.hs +0/−63
- Tests/Repo.hs +0/−67
- Tests/Tests.hs +0/−139
- git.cabal +4/−13
Data/Git/Storage.hs view
@@ -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"
− Tests/Monad.hs
@@ -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"
− Tests/Repo.hs
@@ -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 ()
− Tests/Tests.hs
@@ -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- ]
git.cabal view
@@ -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