Work on git pack protocol, not done yet

This is a lot of code, better save now than sorry later when something
gets deleted by mistake.

Either way, the code will move later - once tested and organized
properly - into its own package.

src/Data/Binary/Get/Local.hs

@@ -0,0 +1,90 @@
+{- This file is part of Vervis.
+ -
+ - Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+ -
+ - ♡ Copying is an act of love. Please copy, reuse and share.
+ -
+ - The author(s) have dedicated all copyright and related and neighboring
+ - rights to this software to the public domain worldwide. This software is
+ - distributed without any warranty.
+ -
+ - You should have received a copy of the CC0 Public Domain Dedication along
+ - with this software. If not, see
+ - <http://creativecommons.org/publicdomain/zero/1.0/>.
+ -}
+
+module Data.Binary.Get.Local
+    ( getHexDigit
+    , getHex16
+    , getDecimal
+    --TODO i added more functions below, didnt export yet
+    )
+where
+
+-- | Read an ASCII character representing a hexadecimal digit, and convert to
+-- the integral value of the digit (i.e. a number between 0 and 15).
+getHexDigit :: Get Word8
+getHexDigit =
+    let fromHex w
+            | 48 <= w && w <= 57  = return $ w - 48 -- 0-9
+            | 65 <= w && w <= 70  = return $ w - 55 -- A-F
+            | 97 <= w && w <= 102 = return $ w - 87 -- a-f
+            | otherwise           = fail "Not an ASCII hex digit"
+    in  getWord8 >>= fromHex
+
+-- | Efficienty convert 'Word8' to 'Int'.
+toInt :: Word8 -> Int
+toInt w =
+    fromMaybe (error "Huh? Converting Word8 to Int failed!") $
+    toIntegralSized w
+
+-- | Read 4 ASCII hex digits and parse them as a hex string into the integer it
+-- represents. Since each hex digit is 4 bits, 4 such digits form a 16-bit
+-- integer (but this function reads 4 bytes which are 32 bits).
+--
+-- The resulting 16-bit integer is returned as an 'Int' because it is used
+-- below with a function which takes an 'Int' parameter.
+getHex16 :: Get Int
+getHex16 = do
+    let sl n = unsafeShiftL n . toInt
+    hh <- sl 12 <$> getHexDigit
+    h  <- sl  8 <$> getHexDigit
+    l  <- sl  4 <$> getHexDigit
+    ll <- toInt <$> getHexDigit
+    return $ hh .&. h .&. l .&. ll
+
+-- Read a string of given size representing an integer in decimal, and parse
+-- the integer.
+getDecimal :: Num a => Int -> Get a
+getDecimal len = do
+    s <- getByteString len
+    case fromDecimal s
+        Nothing -> fail "s doesn't represent a decimal integer"
+        Just n  -> return n
+
+-- | Get a word which satisfies the predicate, otherwise fail.
+requireWord8 :: (Word8 -> Bool) -> Get Word8
+requireWord8 p = do
+    w <- getWord8
+    if p w
+        then return w
+        else fail "Word doesn't satisfy predicate"
+
+requireSpace :: Get ()
+requireSpace = void $ requireWord8 (== 32)
+
+attemptByteString :: ByteString -> Get Bool
+attemptByteString s = fmap isJust . lookAheadM $ do
+    b <- getByteString $ length s
+    if b == s
+        then return $ Just b
+        else return Nothing
+
+-- | Read a bytestring of the same length as the parameter, and fail if they
+-- aren't equal. If equal, return the given value.
+requireByteString :: ByteString -> a -> Get a
+requireByteString s v = fmap isJust $ lookAheadM $ do
+    b <- getByteString $ length s
+    if b == s
+        then return v
+        else fail "Didn't get the expected bytestring"

src/Data/Binary/Put/Local.hs

@@ -0,0 +1,62 @@
+{- This file is part of Vervis.
+ -
+ - Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+ -
+ - ♡ Copying is an act of love. Please copy, reuse and share.
+ -
+ - The author(s) have dedicated all copyright and related and neighboring
+ - rights to this software to the public domain worldwide. This software is
+ - distributed without any warranty.
+ -
+ - You should have received a copy of the CC0 Public Domain Dedication along
+ - with this software. If not, see
+ - <http://creativecommons.org/publicdomain/zero/1.0/>.
+ -}
+
+module Data.Binary.Put.Local
+    ( putNull
+    , putLF
+    , putSpace
+    , putHexDigit
+    , putHex16
+    )
+where
+
+putNull :: Put
+putNull = putWord8 0
+
+putLF :: Put
+putLF = putWord8 10
+
+putSpace :: Put
+putSpace = putWord8 32
+
+-- | Efficiently convert an 'Int' between 0 and 127 to 'Word8'.
+toWord8 :: Int -> Word8
+toWord8 i =
+    fromMaybe (error "Converting Int to Word8 failed") $
+    toIntegralSized i
+
+-- | Take an integral value of a hex digit (i.e. between 0 and 15). Put the
+-- ASCII character representing the digit in lowecase hexadecimal.
+putHexDigit :: Word8 -> Put
+putHexDigit w
+    | 0 <= w && w <= 9   =
+    | 10 <= w && w <= 15 =
+    | otherwise          =
+
+-- | Takes a number which must be a 16-bit non-negative integer. Generates a
+-- 4-byte ASCII hexadecimal representation of the number's value and puts it.
+putHex16 :: Int -> Put
+putHex16 n =
+    let (rem1, ll) = n    `divMod` 16
+        (rem2, l)  = rem1 `divMod` 16
+        (rem3, h)  = rem2 `divMod` 16
+        (rem4, hh) = rem3 `divMod` 16
+    in  if rem4 /= 0
+            then fail "Hex integer to put is too large, must be 16 bit"
+            else do
+                putHexDigit $ toWord8 hh
+                putHexDigit $ toWord8 h
+                putHexDigit $ toWord8 l
+                putHexDigit $ toWord8 ll

src/Data/ByteString/Local.hs

@@ -0,0 +1,40 @@
+{- This file is part of Vervis.
+ -
+ - Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+ -
+ - ♡ Copying is an act of love. Please copy, reuse and share.
+ -
+ - The author(s) have dedicated all copyright and related and neighboring
+ - rights to this software to the public domain worldwide. This software is
+ - distributed without any warranty.
+ -
+ - You should have received a copy of the CC0 Public Domain Dedication along
+ - with this software. If not, see
+ - <http://creativecommons.org/publicdomain/zero/1.0/>.
+ -}
+
+module Data.ByteString.Local
+    ( fromDecimal
+    )
+where
+
+import Prelude
+
+import Data.ByteString (ByteString)
+
+import qualified Data.ByteString as B
+
+-- | Given an ASCII string representing an integer in decimal, parse it and
+-- return the number. Return 'Nothing' on invalid digit chars and on an empty
+-- bytestring.
+--
+-- >>> fromDecimal "345"
+-- Just 345
+--
+-- >>> fromDecimal "a1b2c3"
+-- Nothing
+fromDecimal :: Num a => ByteString -> Maybe a
+fromDecimal s =
+    if (not . B.null) s && B.all (\ b -> 48 <= b && b <= 57) s
+        then Just $ B.foldl' (\ n b -> 10 * n + b - 48) 0 s
+        else Nothing

src/Data/Git/Local.hs

@@ -15,7 +15,10 @@
 
 -- | Git repo tools using the @hit@ package.
 module Data.Git.Local
-    ( loadCommits
+    ( resolveNameMaybe
+    , resolveName
+    , listReferences
+    , loadCommits
     , NodeLabel
     , EdgeLabel
     , CommitGraph
@@ -32,21 +35,45 @@ import Prelude
 
 import Control.Monad.IO.Class
 import Data.Foldable (foldl', foldlM)
+import Data.Git.Named (RefName (..))
 import Data.Git.Ref (Ref, toBinary)
-import Data.Git.Repository (getCommit, resolveRevision)
+import Data.Git.Repository (getCommit, resolveRevision, branchList, tagList)
 import Data.Git.Revision (Revision (..))
 import Data.Git.Storage (Git)
 import Data.Git.Types (Commit (..))
 import Data.Graph.Inductive.Graph (Graph (mkGraph), Node)
 import Data.Graph.Inductive.PatriciaTree (Gr)
 import Data.Hashable (Hashable (..))
+import Data.Maybe (catMaybes, fromMaybe)
 import Data.Ord (Down (..))
 
 import qualified Data.DList as D
 import qualified Data.HashMap.Strict as M
+import qualified Data.Set as S
 
 import Data.Graph.Inductive.Local
 
+-- | For a given ref name - HEAD or branch or tag - determine its ref hash.
+resolveNameMaybe :: Git -> String -> IO (Maybe Ref)
+resolveNameMaybe git name = resolveRevision git $ Revision name []
+
+-- | For a given ref name - HEAD or branch or tag - determine its ref hash.
+resolveName :: Git -> String -> IO Ref
+resolveName git name = do
+    mref <- resolveNameMaybe git name
+    return $ fromMaybe (error "No such ref name in the repo") mref
+
+-- | List the available references in a git repo, sorted by ref name. The list
+-- includes HEAD, branches and tags.
+listReferences :: Git -> IO [(Ref, String)]
+listReferences git = do
+    branches <- S.mapMonotonic refNameRaw <$> branchList git
+    tags <- S.mapMonotonic refNameRaw <$> tagList git
+    let names = S.toAscList $ S.insert "HEAD" $ S.union branches tags
+    mentries <-
+        traverse (\ name -> fmap (,name) <$> resolveNameMaybe git name) names
+    return $ catMaybes mentries
+
 instance Hashable Ref where
     hashWithSalt salt = hashWithSalt salt . toBinary
     hash = hash . toBinary