Git Object Storage example

gitobjectstore.hs

-- Section "9.2.3 Object Storage" in <<Pro Git>>
-- The original example was written in ruby.

import Codec.Zlib
import qualified Crypto.Hash.SHA1 as SHA1
import qualified Data.ByteString.Char8  as C
import qualified Data.ByteString as B
import Data.Char
import System.Directory

hexalise s = concatMap (\c -> [ hex $ c `div` 16, hex $ c `mod` 16 ]) s
        where hex i
                | i >= 0 && i <= 9   = fromIntegral (ord '0') + i
                | i >= 10 && i <= 15 = fromIntegral (ord 'a') + i - 10
                | otherwise          = 0

showHash :: B.ByteString -> String
showHash = map (toEnum.fromEnum) . hexalise . B.unpack

main = do
    let content = "what is up, doc?"
        header = "blob " ++ (show $ length content) ++ "\0"
        store = header ++ content
        blob = showHash $ SHA1.hash $ C.pack store
    def <- initDeflate (-1) (WindowBits 15)
    _ <- feedDeflate def $ C.pack store
    pop <- finishDeflate def
    case pop of
         Just b -> do
             putStrLn blob
             pwd <- getCurrentDirectory
             let gitobject = pwd ++ "/.git/objects/"
             putStrLn gitobject
             createDirectoryIfMissing False $ gitobject ++ (take 2 blob)
             let path = gitobject ++ (take 2 blob) ++ "/" ++ (drop 2 blob)
             B.writeFile path b
         Nothing -> undefined