git 0.2.2 → 0.3.0

raw patch · 11 files changed

+145/−34 lines, 11 filesdep −byteabledep −patiencedep ~bytestringPVP ok

version bump matches the API change (PVP)

Dependencies removed: byteable, patience

Dependency ranges changed: bytestring

API changes (from Hackage documentation)

Files

• Data/Git/Delta.hs +7/−5
• Data/Git/Diff.hs +11/−11
• Data/Git/Diff/Patience.hs +108/−0
• Data/Git/Monad.hs +3/−3
• Data/Git/Named.hs +1/−1
• Data/Git/Repository.hs +6/−2
• Data/Git/Storage/Object.hs +1/−2
• Data/Git/Types.hs +2/−4
• LICENSE +1/−1
• README.md +3/−2
• git.cabal +2/−3

@@ -5,6 +5,7 @@ -- Stability   : experimental -- Portability : unix --+{-# LANGUAGE BangPatterns #-} module Data.Git.Delta     ( Delta(..)     , DeltaCmd(..)@@ -22,13 +23,13 @@ import           Data.Git.Imports  -- | a delta is a source size, a destination size and a list of delta cmd-data Delta = Delta Word64 Word64 [DeltaCmd]+data Delta = Delta !Word64 !Word64 ![DeltaCmd]     deriving (Show,Eq)  -- | possible commands in a delta data DeltaCmd =-      DeltaCopy ByteString   -- command to insert this bytestring-    | DeltaSrc Word64 Word64 -- command to copy from source (offset, size)+      DeltaCopy !ByteString   -- command to insert this bytestring+    | DeltaSrc !Word64 !Word64 -- command to copy from source (offset, size)     deriving (Show,Eq)  -- | parse a delta.@@ -62,8 +63,9 @@                 let size   = s1 .|. s2 .|. s3                 return $ DeltaSrc offset (if size == 0 then 0x10000 else size)             | otherwise       = DeltaCopy <$> P.take (fromIntegral cmd)-        word8cond cond sh =-            if cond then (flip shiftL sh . fromIntegral) <$> P.anyByte else return 0++        word8cond False _  = return 0+        word8cond True  sh = flip shiftL sh . fromIntegral <$> P.anyByte  -- | read one delta from a lazy bytestring. deltaRead :: [ByteString] -> Maybe Delta

@@ -36,8 +36,9 @@ import Data.ByteString.Lazy.Char8 as L  import Data.Typeable-import Data.Algorithm.Patience as AP (Item(..), diff)+import Data.Git.Diff.Patience (Item(..), diff) + -- | represents a blob's content (i.e., the content of a file at a given -- reference). data BlobContent = FileContent [L.ByteString] -- ^ Text file's lines@@ -257,22 +258,21 @@     let (_, _, filteredDiff) = Prelude.foldr filterContext (0, AccuBottom, []) list         theList = removeTrailingBoth filteredDiff     in case Prelude.head theList of-        (NormalLine (Both l1 _)) -> if (lineNumber l1) > 1 then Separator:theList-                                                           else theList+        (NormalLine (Both l _)) -> if lineNumber l > 1 then Separator:theList else theList         _ -> theList     where -- only keep 'context'. The file is annalyzed from the bottom to the top.           -- The accumulator here is a tuple3 with (the line counter, the           -- direction and the list of elements)           filterContext :: (Item TextLine) -> (Int, GitAccu, [FilteredDiff]) -> (Int, GitAccu, [FilteredDiff])-          filterContext (Both l1 l2) (c, AccuBottom, acc) =-              if c < context then (c+1, AccuBottom, (NormalLine (Both l1 l2)):acc)-                             else (c  , AccuBottom, (NormalLine (Both l1 l2))+          filterContext b@(Both {}) (c, AccuBottom, acc) =+              if c < context then (c+1, AccuBottom, (NormalLine b):acc)+                             else (c  , AccuBottom, (NormalLine b)                                                     :((Prelude.take (context-1) acc)                                                     ++ [Separator]                                                     ++ (Prelude.drop (context+1) acc)))-          filterContext (Both l1 l2) (c, AccuTop, acc) =-              if c < context then (c+1, AccuTop   , (NormalLine (Both l1 l2)):acc)-                             else (0  , AccuBottom, (NormalLine (Both l1 l2)):acc)+          filterContext b@(Both {}) (c, AccuTop, acc) =+              if c < context then (c+1, AccuTop   , (NormalLine b):acc)+                             else (0  , AccuBottom, (NormalLine b):acc)           filterContext element (_, _, acc) =               (0, AccuTop, (NormalLine element):acc) @@ -281,8 +281,8 @@           startWithSeparator (Separator:_) = True           startWithSeparator ((NormalLine l):xs) =               case l of-                  (Both _ _) -> startWithSeparator xs-                  _          -> False+                  Both {} -> startWithSeparator xs+                  _       -> False            removeTrailingBoth :: [FilteredDiff] -> [FilteredDiff]           removeTrailingBoth diffList =

@@ -0,0 +1,108 @@+-- loosely based on the patience-0.1.1 package which is:+--+--     Copyright (c) Keegan McAllister 2011+--+module Data.Git.Diff.Patience+    ( Item(..)+    , diff+    ) where++import           Data.List+import           Data.Function (on)+import qualified Data.Map      as M+import qualified Data.IntMap   as IM++data Card a = Card !Int a !(Maybe (Card a))++-- sort using patience making stack of card with the list of elements,+-- then take the highest stack (maxView) and flatten the path back into a list+-- to get the longest increasing path+longestIncreasing :: [(Int,a)] -> [(Int,a)]+longestIncreasing =+      maybe [] (flatten . head . fst)+    . IM.maxView+    . foldl' ins IM.empty+  where+    ins :: IM.IntMap [Card a] -> (Int, a) -> IM.IntMap [Card a]+    ins m (x,a) =+        case IM.minViewWithKey gt of+            Nothing        -> IM.insert x [new] m+            Just ((k,_),_) ->+                case IM.updateLookupWithKey (\_ _ -> Nothing) k m of+                    (Just v, mm) -> IM.insert x (new : v) mm+                    (Nothing, _) -> m+      where+            (lt, gt) = IM.split x m+            prev = (head . fst) `fmap` IM.maxView lt+            new  = Card x a prev++    flatten :: Card a -> [(Int, a)]+    flatten (Card x a c) = (x,a) : maybe [] flatten c++-- Type for decomposing a diff problem.  We either have two+-- lines that match, or a recursive subproblem.+data Piece a =+      Match !a !a+    | Diff [a] [a]+    deriving (Show)++-- Get the longest common subsequence+lcs :: Ord t => [t] -> [t] -> [Piece t]+lcs ma mb =+      chop ma mb+    $ longestIncreasing+    $ sortBy (compare `on` snd)+    $ M.elems+    $ M.intersectionWith (,) (unique ma) (unique mb)+  where+    unique = M.mapMaybe id . foldr ins M.empty . zip [0..]+      where+        ins (a,x) = M.insertWith (\_ _ -> Nothing) x (Just a)++    -- Subdivides a diff problem according to the indices of matching lines.+    chop :: [t] -> [t] -> [(Int,Int)] -> [Piece t]+    chop xs ys []+        | null xs && null ys = []+        | otherwise = [Diff xs ys]+    chop xs ys ((nx,ny):ns) =+        let (xsr, (x : xse)) = splitAt nx xs+            (ysr, (y : yse)) = splitAt ny ys+         in  Diff xse yse : Match x y : chop xsr ysr ns++-- | An element of a computed difference.+data Item t =+      Old  !t+    | New  !t+    | Both !t !t+    deriving (Show,Eq)++instance Functor Item where+    fmap f (Old  x)   = Old  (f x)+    fmap f (New  x)   = New  (f x)+    fmap f (Both x y) = Both (f x) (f y)++-- | The difference between two lists using the patience algorithm+diff :: Ord t => [t] -> [t] -> [Item t]+diff = matchPrefix []+  where+    -- match the prefix between old and new document+    matchPrefix acc (x:xs) (y:ys)+        | x == y    = Both x y : matchPrefix acc xs ys+    matchPrefix acc l r = matchSuffix acc (reverse l) (reverse r)++    -- match the suffix between old and new document, accumulating the+    -- matched item in a reverse accumulator to keep TCO+    matchSuffix acc (x:xs) (y:ys)+        | x == y = matchSuffix (Both x y : acc) xs ys+    matchSuffix acc l r = diffInner (reverse acc) (reverse l) (reverse r)++    -- prefix and suffix are striped, and now do the LCS+    diffInner acc l r =+        case lcs l r of+            -- If we fail to subdivide, just record the chunk as is.+            [Diff _ _] -> fmap Old l ++ fmap New r ++ acc+            ps -> recur acc ps++    recur acc [] = acc+    recur acc (Match x y  : ps) = recur (Both x y : acc) ps+    recur acc (Diff xs ys : ps) = recur [] ps ++ matchPrefix acc xs ys

@@ -581,8 +581,8 @@ -- -- Example: ----- > withCurrentRepo $--- >    (r, ()) <- withNewCommit person Nothing $ do+-- > withCurrentRepo $ do+-- >    (r, ()) <- withNewCommit person (Nothing :: Maybe (Ref SHA1)) $ do -- >        setMessage "inital commit" -- >        setFile ["README.md"] "# My awesome project\n\nthis is a new project\n" -- >    branchWrite "master" r@@ -592,7 +592,7 @@ -- parent is already set to the Reference associated to the revision. -- You can, change the parents if you wish to erase, or replace, this value. ----- > withCurrentRepo $+-- > withCurrentRepo $ do -- >    readmeContent <- withCommit (Just "master") $ getFile ["README.md"] -- >    (r, ()) <- withNewCommit person (Just "master") $ do -- >        setMessage "update the README"

@@ -142,7 +142,7 @@         getRefsRecursively dir acc (x:xs) = do             isDir <- isDirectory x             extra <- if isDir-                        then listRefsAcc [] dir+                        then listRefsAcc [] x                         else let r = UTF8.toString $ localPathEncode $ stripRoot x                               in if isValidRefName r                                     then return [fromString r]

@@ -42,7 +42,7 @@ import Control.Exception (Exception, throw)  import Data.Maybe (fromMaybe)-import Data.List (find)+import Data.List (find, stripPrefix) import Data.Data import Data.IORef @@ -129,7 +129,11 @@                              "HEAD"       -> [ RefHead ]                              "ORIG_HEAD"  -> [ RefOrigHead ]                              "FETCH_HEAD" -> [ RefFetchHead ]-                             _            -> map (flip ($) (RefName prefix)) [RefTag,RefBranch,RefRemote]+                             _            ->+                                maybe (map (flip ($) (RefName prefix)) [RefTag,RefBranch,RefRemote]) (:[]) $+                                        (RefBranch . RefName <$> stripPrefix "refs/heads/"   prefix)+                                    <|> (RefTag    . RefName <$> stripPrefix "refs/tags/"    prefix)+                                    <|> (RefRemote . RefName <$> stripPrefix "refs/remotes/" prefix)          tryResolvers :: HashAlgorithm hash => [IO (Maybe (Ref hash))] -> IO (Maybe (Ref hash))         tryResolvers []            = return $ if (isHexString prefix)

@@ -45,7 +45,6 @@ import Data.Git.Imports import qualified Data.Git.Parser as P -import Data.Byteable (toBytes) import Data.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC@@ -265,7 +264,7 @@     where writeTreeEnt (ModePerm perm,name,ref) =                 [ string7 (printf "%o" perm)                 , string7 " "-                , byteString $ toBytes name+                , byteString $ getEntNameBytes name                 , string7 "\0"                 , byteString $ toBinary ref                 ]

@@ -19,6 +19,7 @@     , Person(..)     , EntName     , entName+    , getEntNameBytes     , EntPath     , entPathAppend     -- * modeperm type@@ -40,7 +41,6 @@  import Data.Word import Data.Bits-import Data.Byteable import Data.String import Data.ByteString (ByteString) import qualified Data.ByteString as B@@ -147,14 +147,12 @@ type Perm = Word8  -- | Entity name-newtype EntName = EntName ByteString+newtype EntName = EntName { getEntNameBytes :: 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

@@ -1,4 +1,4 @@-Copyright (c) 2010-2016 Vincent Hanquez <vincent@snarc.org>+Copyright (c) 2010-2019 Vincent Hanquez <vincent@snarc.org>  All rights reserved. 

@@ -7,13 +7,14 @@  git is a reimplementation of git storage and protocol in pure haskell. -what it does do:+What it does do:  * read loose objects, and packed objects. * write new loose objects * git like operations available: commit, cat-file, verify-pack, rev-list, ls-tree.+* diff between commits -what is doesn't do:+What is doesn't do:  * reimplement the whole of git. * checkout's index reading/writing, fetching, merging, diffing.

@@ -1,5 +1,5 @@ Name:                git-Version:             0.2.2+Version:             0.3.0 Synopsis:            Git operations in haskell Description:     .@@ -29,7 +29,6 @@   Build-Depends:     base >= 4 && < 5                    , basement                    , bytestring >= 0.9-                   , byteable                    , containers                    , memory >= 0.13                    , cryptonite >= 0.22@@ -40,7 +39,6 @@                    , hourglass >= 0.2                    , unix-compat                    , utf8-string-                   , patience                    -- to remove                    , system-filepath                    , system-fileio@@ -58,6 +56,7 @@                      Data.Git.Revision                      Data.Git.Repository                      Data.Git.Diff+                     Data.Git.Diff.Patience   Other-modules:     Data.Git.Internal                      Data.Git.Imports                      Data.Git.OS