hit 0.6.2 → 0.6.3
raw patch · 16 files changed
+317/−64 lines, 16 filesdep +byteabledep +tastydep +tasty-quickcheckdep −HUnitdep −QuickCheckdep −test-frameworkdep ~basedep ~patiencePVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: byteable, tasty, tasty-quickcheck, utf8-string
Dependencies removed: HUnit, QuickCheck, test-framework, test-framework-quickcheck2
Dependency ranges changed: base, patience
API changes (from Hackage documentation)
- Data.Git.Repository: configRead :: Git -> IO Config
+ Data.Git: EntDirectory :: EntType
+ Data.Git: EntExecutable :: EntType
+ Data.Git: EntFile :: EntType
+ Data.Git: data EntName
+ Data.Git: data EntType
+ Data.Git: entName :: ByteString -> EntName
+ Data.Git: entPathAppend :: EntPath -> EntName -> EntPath
+ Data.Git: type EntPath = [EntName]
+ Data.Git: type WorkTree = MVar TreeSt
+ Data.Git: workTreeDelete :: Git -> WorkTree -> EntPath -> IO ()
+ Data.Git: workTreeFlush :: Git -> WorkTree -> IO Ref
+ Data.Git: workTreeFrom :: Ref -> IO WorkTree
+ Data.Git: workTreeNew :: IO WorkTree
+ Data.Git: workTreeSet :: Git -> WorkTree -> EntPath -> (EntType, Ref) -> IO ()
+ Data.Git.Repository: configGet :: Git -> String -> String -> IO (Maybe String)
+ Data.Git.Repository: configGetAll :: Git -> IO [Config]
+ Data.Git.Storage: configs :: Git -> IORef [Config]
+ Data.Git.Types: data EntName
+ Data.Git.Types: entName :: ByteString -> EntName
+ Data.Git.Types: entPathAppend :: EntPath -> EntName -> EntPath
+ Data.Git.Types: instance Byteable EntName
+ Data.Git.Types: instance Eq EntName
+ Data.Git.Types: instance IsString EntName
+ Data.Git.Types: instance Ord EntName
+ Data.Git.Types: instance Show EntName
+ Data.Git.Types: type EntPath = [EntName]
- Data.Git: resolvePath :: Git -> Ref -> [ByteString] -> IO (Maybe Ref)
+ Data.Git: resolvePath :: Git -> Ref -> EntPath -> IO (Maybe Ref)
- Data.Git.Diff: BlobState :: ByteString -> ModePerm -> Ref -> BlobContent -> BlobState
+ Data.Git.Diff: BlobState :: EntPath -> ModePerm -> Ref -> BlobContent -> BlobState
- Data.Git.Diff: HitDiff :: ByteString -> HitFileContent -> HitFileMode -> HitFileRef -> HitDiff
+ Data.Git.Diff: HitDiff :: EntPath -> HitFileContent -> HitFileMode -> HitFileRef -> HitDiff
- Data.Git.Diff: bsFilename :: BlobState -> ByteString
+ Data.Git.Diff: bsFilename :: BlobState -> EntPath
- Data.Git.Diff: hFileName :: HitDiff -> ByteString
+ Data.Git.Diff: hFileName :: HitDiff -> EntPath
- Data.Git.Repository: resolvePath :: Git -> Ref -> [ByteString] -> IO (Maybe Ref)
+ Data.Git.Repository: resolvePath :: Git -> Ref -> EntPath -> IO (Maybe Ref)
- Data.Git.Repository: type HTree = [(ModePerm, ByteString, HTreeEnt)]
+ Data.Git.Repository: type HTree = [(ModePerm, EntName, HTreeEnt)]
- Data.Git.Types: type TreeEnt = (ModePerm, ByteString, Ref)
+ Data.Git.Types: type TreeEnt = (ModePerm, EntName, Ref)
Files
- Data/Git.hs +14/−0
- Data/Git/Config.hs +25/−1
- Data/Git/Diff.hs +8/−9
- Data/Git/Repository.hs +28/−12
- Data/Git/Revision.hs +1/−0
- Data/Git/Storage.hs +17/−6
- Data/Git/Storage/Object.hs +4/−2
- Data/Git/Storage/Pack.hs +6/−5
- Data/Git/Storage/PackIndex.hs +5/−4
- Data/Git/Types.hs +30/−1
- Data/Git/WorkTree.hs +151/−0
- Hit/Hit.hs +6/−5
- LICENSE +1/−1
- Tests/Repo.hs +2/−3
- Tests/Tests.hs +11/−6
- hit.cabal +8/−9
Data/Git.hs view
@@ -18,6 +18,10 @@ , Tag(..) , GitTime , ModePerm(..)+ , EntName+ , EntPath+ , entName+ , entPathAppend -- * Helper & type related to ModePerm , ObjectFileType(..)@@ -55,6 +59,15 @@ , setObject , toObject + -- * Work trees+ , WorkTree+ , EntType(..)+ , workTreeNew+ , workTreeFrom+ , workTreeDelete+ , workTreeSet+ , workTreeFlush+ -- * Named refs , branchWrite , branchList@@ -70,3 +83,4 @@ import Data.Git.Repository import Data.Git.Revision import Data.Git.Storage.Object (toObject)+import Data.Git.WorkTree
Data/Git/Config.hs view
@@ -7,16 +7,25 @@ -- -- config related types and methods. --+{-# LANGUAGE OverloadedStrings #-} module Data.Git.Config ( Config(..) , Section(..)- -- * methods+ -- * reading methods , readConfig+ , readGlobalConfig+ -- * methods+ , listSections+ , get ) where import Control.Applicative+import Control.Monad (mplus) import Data.Git.Path+import Data.List (find) import Filesystem.Path.CurrentOS+import Filesystem (getHomeDirectory)+import qualified Data.Set as S newtype Config = Config [Section] deriving (Show,Eq)@@ -56,3 +65,18 @@ readConfigPath filepath = parseConfig <$> readFile (encodeString filepath) readConfig gitRepo = readConfigPath (configPath gitRepo)++readGlobalConfig = getHomeDirectory >>= readConfigPath . (\homeDir -> homeDir </> ".gitconfig")++listSections :: [Config] -> [String]+listSections = S.toList . foldr accSections S.empty+ where accSections (Config sections) set = foldr S.insert set (map sectionName sections)++-- | Get a configuration element in a stack of config file, starting from the top.+get :: [Config] -- ^ stack of config+ -> String -- ^ section name+ -> String -- ^ key name+ -> Maybe String+get [] _ _ = Nothing+get (Config c:cs) section key = findOne `mplus` get cs section key+ where findOne = find (\s -> sectionName s == section) c >>= lookup key . sectionKVs
Data/Git/Diff.hs view
@@ -33,7 +33,6 @@ import Data.Git.Storage import Data.Git.Storage.Object import Data.ByteString.Lazy.Char8 as L-import Data.ByteString.Char8 as BS import Data.Algorithm.Patience as AP (Item(..), diff) @@ -45,7 +44,7 @@ -- | This is a blob description at a given state (revision) data BlobState = BlobState- { bsFilename :: BS.ByteString+ { bsFilename :: EntPath , bsMode :: ModePerm , bsRef :: Ref , bsContent :: BlobContent@@ -73,21 +72,21 @@ tree <- resolveTreeish git $ commitTreeish commit case tree of Just t -> do htree <- buildHTree git t- buildTreeList htree (BS.empty)+ buildTreeList htree [] _ -> error "cannot build a tree from this reference" where- buildTreeList :: HTree -> BS.ByteString -> IO [BlobState]+ buildTreeList :: HTree -> EntPath -> IO [BlobState] buildTreeList [] _ = return []- buildTreeList ((d,n,TreeFile r):xs) pathPrefix = do+ buildTreeList ((d,n,TreeFile r):xs) pathPrefix = do content <- catBlobFile r let isABinary = isBinaryFile content listTail <- buildTreeList xs pathPrefix case isABinary of- False -> return $ (BlobState (BS.append pathPrefix n) d r (FileContent $ L.lines content)) : listTail- True -> return $ (BlobState (BS.append pathPrefix n) d r (BinaryContent content)) : listTail+ False -> return $ (BlobState (entPathAppend pathPrefix n) d r (FileContent $ L.lines content)) : listTail+ True -> return $ (BlobState (entPathAppend pathPrefix n) d r (BinaryContent content)) : listTail buildTreeList ((_,n,TreeDir _ subTree):xs) pathPrefix = do l1 <- buildTreeList xs pathPrefix- l2 <- buildTreeList subTree (BS.concat [pathPrefix, n, BS.pack "/"])+ l2 <- buildTreeList subTree (entPathAppend pathPrefix n) return $ l1 ++ l2 catBlobFile :: Ref -> IO L.ByteString@@ -187,7 +186,7 @@ -- * the file's mode (i.e. the file priviledge) -- * the file's ref data HitDiff = HitDiff- { hFileName :: BS.ByteString+ { hFileName :: EntPath , hFileContent :: HitFileContent , hFileMode :: HitFileMode , hFileRef :: HitFileRef
Data/Git/Repository.hs view
@@ -11,9 +11,10 @@ module Data.Git.Repository ( Git -- * Config- , configRead- , Cfg.Config(..)- , Cfg.Section(..)+ , configGetAll+ , configGet+ , Config(..)+ , Section(..) -- * Trees , HTree , HTreeEnt(..)@@ -45,8 +46,7 @@ import Data.Maybe (fromMaybe) import Data.List (find) import Data.Data--import Data.ByteString (ByteString)+import Data.IORef import Data.Git.Named import Data.Git.Types@@ -56,6 +56,7 @@ import Data.Git.Storage.Loose import Data.Git.Storage.CacheFile import Data.Git.Ref+import Data.Git.Config (Config(..), Section(..)) import qualified Data.Git.Config as Cfg import Data.Set (Set)@@ -65,7 +66,7 @@ -- | hierarchy tree, either a reference to a blob (file) or a tree (directory). data HTreeEnt = TreeDir Ref HTree | TreeFile Ref-type HTree = [(ModePerm,ByteString,HTreeEnt)]+type HTree = [(ModePerm,EntName,HTreeEnt)] -- | Exception when trying to convert an object pointed by 'Ref' to -- a type that is different@@ -223,13 +224,13 @@ Nothing -> error "unknown reference in tree object" -- | resolve the ref (tree or blob) related to a path at a specific commit ref-resolvePath :: Git -- ^ repository- -> Ref -- ^ commit reference- -> [ByteString] -- ^ paths+resolvePath :: Git -- ^ repository+ -> Ref -- ^ commit reference+ -> EntPath -- ^ paths -> IO (Maybe Ref) resolvePath git commitRef paths = getCommit git commitRef >>= \commit -> resolve (commitTreeish commit) paths- where resolve :: Ref -> [ByteString] -> IO (Maybe Ref)+ where resolve :: Ref -> EntPath -> IO (Maybe Ref) resolve treeRef [] = return $ Just treeRef resolve treeRef (x:xs) = do (Tree ents) <- getTree git treeRef@@ -292,5 +293,20 @@ RefContentUnknown bs -> error ("unknown content in HEAD: " ++ show bs) -- | Read the Config-configRead :: Git -> IO Cfg.Config-configRead git = Cfg.readConfig (gitRepoPath git)+configGetAll :: Git -> IO [Config]+configGetAll git = readIORef (configs git)++-- | Get a configuration element from the config file, starting from the+-- local repository config file, then the global config file.+--+-- for example the equivalent to git config user.name is:+--+-- > configGet git "user" "name"+--+configGet :: Git -- ^ Git context+ -> String -- ^ section name+ -> String -- ^ key name+ -> IO (Maybe String) -- ^ The resulting value if it exists+configGet git section key = do+ cfgs <- configGetAll git+ return $ Cfg.get cfgs section key
Data/Git/Revision.hs view
@@ -56,6 +56,7 @@ instance IsString Revision where fromString = revFromString +revFromString :: String -> Revision revFromString s = either (error.show) id $ parse parser "" s where parser = do p <- many (noneOf "^~@")
Data/Git/Storage.hs view
@@ -12,6 +12,7 @@ ( Git , packedNamed , gitRepoPath+ , configs -- * opening repositories , openRepo , closeRepo@@ -45,13 +46,14 @@ import Filesystem.Path.Rules import System.Environment -import Control.Applicative ((<$>))+import Control.Applicative import Control.Exception import qualified Control.Exception as E import Control.Monad import Data.String import Data.List ((\\), isPrefixOf)+import Data.Either (partitionEithers) import Data.IORef import Data.Word @@ -65,6 +67,7 @@ import Data.Git.Storage.Loose import Data.Git.Storage.CacheFile import Data.Git.Ref+import Data.Git.Config import qualified Data.Map as M @@ -82,14 +85,22 @@ , indexReaders :: IORef [(Ref, PackIndexReader)] , packReaders :: IORef [(Ref, FileReader)] , packedNamed :: CachedPackedRef+ , configs :: IORef [Config] } -- | open a new git repository context openRepo :: FilePath -> IO Git-openRepo path = liftM3 (Git path) (newIORef []) (newIORef []) packedRef- where packedRef = newCacheVal (packedRefsPath path)- (readPackedRefs path M.fromList)- (PackedRefs M.empty M.empty M.empty)+openRepo path = Git path <$> newIORef []+ <*> newIORef []+ <*> packedRef+ <*> (readConfigs >>= newIORef)+ where packedRef = newCacheVal (packedRefsPath path)+ (readPackedRefs path M.fromList)+ (PackedRefs M.empty M.empty M.empty)+ readConfigs = do+ global <- E.try readGlobalConfig :: IO (Either IOException Config)+ local <- E.try (readConfig path)+ return $ snd $ partitionEithers [local,global] -- | close a git repository context, closing all remaining fileReaders. closeRepo :: Git -> IO ()@@ -150,7 +161,7 @@ dir <- isDirectory path subDirs <- mapM (isDirectory . (path </>)) [ "hooks", "info"- , "logs", "objects", "refs"+ , "objects", "refs" , "refs"</> "heads", "refs"</> "tags"] return $ and ([dir] ++ subDirs)
Data/Git/Storage/Object.hs view
@@ -43,6 +43,7 @@ import Data.Git.Ref import Data.Git.Types +import Data.Byteable (toBytes) import Data.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC@@ -182,7 +183,8 @@ -- | parse a tree content treeParse = Tree <$> parseEnts where parseEnts = atEnd >>= \end -> if end then return [] else liftM2 (:) parseEnt parseEnts- parseEnt = liftM3 (,,) modeperm (PC.char ' ' >> takeTill ((==) 0)) (word8 0 >> referenceBin)+ parseEnt = liftM3 (,,) modeperm parseEntName (word8 0 >> referenceBin)+ parseEntName = entName <$> (PC.char ' ' >> takeTill ((==) 0)) -- | parse a blob content blobParse = (Blob <$> takeLazyByteString)@@ -259,7 +261,7 @@ where writeTreeEnt (ModePerm perm,name,ref) = [ string7 (printf "%o" perm) , string7 " "- , byteString name+ , byteString $ toBytes name , string7 "\0" , byteString $ toBinary ref ]
Data/Git/Storage/Pack.hs view
@@ -20,7 +20,7 @@ , packReadAtOffset , packReadRawAtOffset , packEnumerateObjects- -- * turn a packed object into a + -- * turn a packed object into a , packedObjectToObject , packObjectFromRaw ) where@@ -64,10 +64,11 @@ -- | Enumerate the pack refs available in this repository. packEnumerate repoPath = map onlyHash . filter isPackFile . map (encodeString posix . filename) <$> listDirectory (repoPath </> "objects" </> "pack")- where- isPackFile x = ".pack" `isSuffixOf` x- onlyHash = fromHexString . takebut 5 . drop 5- takebut n l = take (length l - n) l+ where+ isPackFile :: String -> Bool+ isPackFile x = ".pack" `isSuffixOf` x+ onlyHash = fromHexString . takebut 5 . drop 5+ takebut n l = take (length l - n) l -- | open a pack packOpen :: FilePath -> Ref -> IO FileReader
Data/Git/Storage/PackIndex.hs view
@@ -63,10 +63,11 @@ -- | enumerate every indexes file in the pack directory packIndexEnumerate repoPath = map onlyHash . filter isPackFile . map (encodeString posix . filename) <$> listDirectory (repoPath </> "objects" </> "pack")- where- isPackFile x = ".idx" `isSuffixOf` x && "pack-" `isPrefixOf` x- onlyHash = fromHexString . takebut 4 . drop 5- takebut n l = take (length l - n) l+ where+ isPackFile :: String -> Bool+ isPackFile x = ".idx" `isSuffixOf` x && "pack-" `isPrefixOf` x+ onlyHash = fromHexString . takebut 4 . drop 5+ takebut n l = take (length l - n) l -- | open an index packIndexOpen :: FilePath -> Ref -> IO FileReader
Data/Git/Types.hs view
@@ -17,6 +17,10 @@ , Blob(..) , Tag(..) , Person(..)+ , EntName+ , entName+ , EntPath+ , entPathAppend -- * modeperm type , ModePerm(..) , FilePermissions(..)@@ -36,8 +40,11 @@ import Data.Word import Data.Bits+import Data.Byteable import Data.Monoid+import Data.String import Data.ByteString (ByteString)+import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import Data.Git.Ref@@ -47,6 +54,7 @@ , Time(..), Timeable(..) , LocalTime, localTimeSetTimezone, localTimeFromGlobal) import Data.Data+import qualified Data.ByteString.UTF8 as UTF8 -- | type of a git object. data ObjectType =@@ -138,10 +146,31 @@ -- * bit 2 represents the execute permission type Perm = Word8 +-- | Entity name+newtype EntName = EntName ByteString+ deriving (Eq,Ord)+instance Show EntName where+ show (EntName e) = UTF8.toString e+instance IsString EntName where+ fromString s = entName $ UTF8.fromString s+instance Byteable EntName where+ toBytes (EntName n) = n++entName :: ByteString -> EntName+entName bs+ | B.elem slash bs = error ("entity name " ++ show bs ++ " contains an invalid '/' character")+ | otherwise = EntName bs+ where slash = 47++entPathAppend :: EntPath -> EntName -> EntPath+entPathAppend l e = l ++ [e]++type EntPath = [EntName]+ -- | represent one entry in the tree -- (permission,file or directory name,blob or tree ref) -- name should maybe a filepath, but not sure about the encoding.-type TreeEnt = (ModePerm,ByteString,Ref)+type TreeEnt = (ModePerm,EntName,Ref) -- | an author or committer line -- has the format: name <email> time timezone
+ Data/Git/WorkTree.hs view
@@ -0,0 +1,151 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+-- |+-- Module : Data.Git.WorkTree+-- License : BSD-style+-- Maintainer : Vincent Hanquez <vincent@snarc.org>+-- Stability : experimental+-- Portability : unix+--+-- a load-on-demand, write-on-demand working tree.+--+module Data.Git.WorkTree+ ( WorkTree+ , EntType(..)+ -- * Create new work trees+ , workTreeNew+ , workTreeFrom+ -- * Modifications methods+ , workTreeDelete+ , workTreeSet+ , workTreeFlush+ ) where++import Data.Git.Ref+import Data.Git.Types+import Data.Git.Storage.Object+import Data.Git.Storage+import Data.Git.Repository++--import qualified Data.ByteString as B++import qualified Data.Map as M++import Control.Monad+import Control.Concurrent.MVar++type Dir = M.Map EntName (ModePerm, TreeSt)+type TreeVar = MVar Dir+data TreeSt = TreeRef Ref | TreeLoaded TreeVar+type WorkTree = MVar TreeSt++data EntType = EntDirectory | EntFile | EntExecutable+ deriving (Show,Eq)++-- | Create a new worktree+workTreeNew :: IO WorkTree+workTreeNew = newMVar M.empty >>= newMVar . TreeLoaded++-- | Create a worktree from a tree reference.+workTreeFrom :: Ref -> IO WorkTree+workTreeFrom ref = newMVar (TreeRef ref)++-- | delete a path from a working tree+--+-- if the path doesn't exist, no error is raised+workTreeDelete :: Git -> WorkTree -> EntPath -> IO ()+workTreeDelete git wt path = diveFromRoot git wt path dive+ where dive _ [] = error "internal error: delete: empty dive"+ dive varCurrent [file] = modifyMVar_ varCurrent (return . M.delete file)+ dive varCurrent (x:xs) = do+ evarChild <- loadOrGetTree git x varCurrent $ \m -> return (m, Right ())+ case evarChild of+ Left varChild -> dive varChild xs+ Right () -> return ()++-- | Set a file in this working tree to a specific ref.+--+-- The ref should point to a valid blob or tree object, and+-- it's safer to write the referenced tree or blob object first.+workTreeSet :: Git -> WorkTree -> EntPath -> (EntType, Ref) -> IO ()+workTreeSet git wt path (entType, entRef) = diveFromRoot git wt path dive+ where dive :: TreeVar -> EntPath -> IO ()+ dive _ [] = error "internal error: set: empty dive"+ dive varCurrent [file] = modifyMVar_ varCurrent (return . M.insert file (entTypeToPerm entType, TreeRef entRef))+ dive varCurrent (x:xs) = do+ evarChild <- loadOrGetTree git x varCurrent $ \m -> do+ -- create an empty tree+ v <- newMVar M.empty+ return (M.insert x (entTypeToPerm EntDirectory, TreeLoaded v) m, Left v)+ case evarChild of+ Left varChild -> dive varChild xs+ Right () -> return ()++{-+workTreeFlushAt :: Git -> WorkTree -> EntPath -> IO ()+workTreeFlushAt git wt path = do+ undefined+-}++-- | Flush the worktree by creating all the necessary trees in the git store+-- and return the root ref of the work tree.+workTreeFlush :: Git -> WorkTree -> IO Ref+workTreeFlush git wt = do+ -- write all the trees that need to be written+ -- switch to modifyMVar+ wtVal <- takeMVar wt+ case wtVal of+ TreeRef ref -> putMVar wt wtVal >> return ref+ TreeLoaded var -> do+ ref <- writeTreeRecursively (TreeLoaded var)+ putMVar wt $ TreeRef ref+ return ref+ where writeTreeRecursively (TreeRef ref) = return ref+ writeTreeRecursively (TreeLoaded var) = do+ c <- readMVar var+ ents <- forM (M.toList c) $ \(bs, (mperm, entSt)) -> do+ ref <- writeTreeRecursively entSt+ return (mperm, bs, ref)+ setTree ents++ setTree ents = setObject git (toObject $ Tree ents)++----- helpers -----++loadTreeVar :: Git -> Ref -> IO TreeVar+loadTreeVar git treeRef = do+ (Tree ents) <- getTree git treeRef+ let t = foldr (\(m,b,r) acc -> M.insert b (m,TreeRef r) acc) M.empty ents+ newMVar t++entTypeToPerm :: EntType -> ModePerm+entTypeToPerm EntDirectory = ModePerm 0o040000+entTypeToPerm EntExecutable = ModePerm 0o100755 +entTypeToPerm EntFile = ModePerm 0o100644++loadOrGetTree :: Git -> EntName -> TreeVar -> (Dir -> IO (Dir, Either TreeVar a)) -> IO (Either TreeVar a)+loadOrGetTree git x varCurrent onMissing =+ modifyMVar varCurrent $ \m -> do+ case M.lookup x m of+ Nothing -> onMissing m+ Just (_, treeSt) -> -- check perm to see if it is a directory+ case treeSt of+ TreeRef ref -> do+ -- replace the ref by a loaded tree+ var <- loadTreeVar git ref+ return (M.adjust (\(perm,_) -> (perm, TreeLoaded var)) x m, Left var)+ TreeLoaded var -> return (m, Left var)++diveFromRoot :: Git -> WorkTree -> EntPath+ -> (TreeVar -> EntPath -> IO ())+ -> IO () +diveFromRoot git wt path dive+ | path == [] = return ()+ | otherwise = do+ -- switch to modifyMVar+ wtVal <- takeMVar wt+ current <- case wtVal of+ TreeLoaded var -> return var+ TreeRef ref -> loadTreeVar git ref+ putMVar wt $ TreeLoaded current+ dive current path+
Hit/Hit.hs view
@@ -134,8 +134,8 @@ mapM_ (showTreeEnt) htree _ -> error "cannot build a tree from this reference" where- showTreeEnt (ModePerm p,n,TreeDir r _) = printf "%06o tree %s %s\n" p (show r) (BC.unpack n)- showTreeEnt (ModePerm p,n,TreeFile r) = printf "%06o blob %s %s\n" p (show r) (BC.unpack n)+ showTreeEnt (ModePerm p,n,TreeDir r _) = printf "%06o tree %s %s\n" p (show r) (show n)+ showTreeEnt (ModePerm p,n,TreeFile r) = printf "%06o blob %s %s\n" p (show r) (show n) revList revision git = do ref <- maybe (error "revision cannot be found") id <$> resolveRevision git revision@@ -178,8 +178,8 @@ printFileRef $ hFileRef hd printFileDiff $ hFileContent hd - printFileName :: BC.ByteString -> IO ()- printFileName filename = putStrLn $ "Hit.Diff on file: " ++ (BC.unpack filename)+ printFileName :: EntPath -> IO ()+ printFileName filename = putStrLn $ "Hit.Diff on file: " ++ (show filename) printFileMode :: HitFileMode -> IO () printFileMode (NewMode (ModePerm m)) = printf "new file mode: %06o\n" m@@ -235,7 +235,8 @@ ["diff",rev1,rev2] -> withCurrentRepo $ showDiff (fromString rev1) (fromString rev2) ["tag"] -> withCurrentRepo $ showRefs ["show-refs"] -> withCurrentRepo $ showRefs- ["read-config"] -> withCurrentRepo $ \git -> configRead git >>= putStrLn . show+ ["read-config"] -> withCurrentRepo $ \git -> configGetAll git >>= putStrLn . show+ ["config",section,value] -> withCurrentRepo $ \git -> configGet git section value >>= putStrLn . show cmd : [] -> error ("unknown command: " ++ cmd) [] -> error "no args" _ -> error "unknown command line arguments"
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2010-2012 Vincent Hanquez <vincent@snarc.org>+Copyright (c) 2010-2014 Vincent Hanquez <vincent@snarc.org> All rights reserved.
Tests/Repo.hs view
@@ -1,6 +1,5 @@-import Test.QuickCheck-import Test.Framework(defaultMain, testGroup, buildTest)-import Test.Framework.Providers.QuickCheck2(testProperty)+import Test.Tasty+import Test.Tasty.QuickCheck import qualified Data.ByteString.Lazy as L import qualified Data.ByteString as B
Tests/Tests.hs view
@@ -1,6 +1,5 @@-import Test.QuickCheck-import Test.Framework(defaultMain, testGroup)-import Test.Framework.Providers.QuickCheck2(testProperty)+import Test.Tasty.QuickCheck+import Test.Tasty import qualified Data.ByteString.Lazy as L import qualified Data.ByteString as B@@ -26,11 +25,16 @@ 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)+ ]+ instance Arbitrary Ref where arbitrary = fromBinary <$> arbitraryBS 20 @@ -40,7 +44,8 @@ arbitraryRefList :: Gen [Ref] arbitraryRefList = replicateM 2 arbitrary -arbitraryEnt = liftM3 (,,) arbitrary (arbitraryBSno0 48) arbitrary+arbitraryEnt :: Gen TreeEnt+arbitraryEnt = liftM3 (,,) arbitrary (arbitraryEntname 23) arbitrary arbitraryEnts = choose (1,2) >>= \i -> replicateM i arbitraryEnt instance Arbitrary TimezoneOffset where@@ -99,7 +104,7 @@ [ testProperty "unmarshall.marshall==id" prop_object_marshalling_id ] -main = defaultMain+main = defaultMain $ testGroup "hit" [ testGroup "ref marshalling" refTests , testGroup "object marshalling" objTests ]
hit.cabal view
@@ -1,5 +1,5 @@ Name: hit-Version: 0.6.2+Version: 0.6.3 Synopsis: Git operations in haskell Description: .@@ -36,6 +36,7 @@ Build-Depends: base >= 4 && < 5 , mtl , bytestring >= 0.9+ , byteable , attoparsec >= 0.10.1 , parsec >= 3 , containers@@ -48,6 +49,7 @@ , zlib-bindings >= 0.1 && < 0.2 , hourglass >= 0.2 , unix-compat+ , utf8-string , patience Exposed-modules: Data.Git Data.Git.Types@@ -68,6 +70,7 @@ Data.Git.Storage.FileWriter Data.Git.Storage.CacheFile Data.Git.Path+ Data.Git.WorkTree ghc-options: -Wall -fno-warn-missing-signatures Executable Hit@@ -99,11 +102,9 @@ hs-source-dirs: Tests Main-Is: Tests.hs Build-depends: base >= 3 && < 7- , HUnit- , QuickCheck >= 2 , bytestring- , test-framework >= 0.3- , test-framework-quickcheck2 >= 0.2+ , tasty+ , tasty-quickcheck , hourglass , hit @@ -112,11 +113,9 @@ hs-source-dirs: Tests Main-Is: Repo.hs Build-depends: base >= 3 && < 7- , HUnit- , QuickCheck >= 2 , bytestring- , test-framework >= 0.3- , test-framework-quickcheck2 >= 0.2+ , tasty+ , tasty-quickcheck , hourglass , bytedump >= 1.0 , hit