packages feed

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 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