gitlib 0.7.0 → 1.0.1

raw patch · 20 files changed

+705/−2250 lines, 20 filesdep +data-defaultdep +doctest-propdep +failuredep −HUnitdep −gitlibdep −hlibgit2dep ~basedep ~conduitdep ~containersPVP ok

version bump matches the API change (PVP)

Dependencies added: data-default, doctest-prop, failure, lifted-base, tagged, transformers

Dependencies removed: HUnit, gitlib, hlibgit2, lens, parallel-io, stringable, system-fileio, text-icu

Dependency ranges changed: base, conduit, containers, directory, doctest, filepath

API changes (from Hackage documentation)

Files

• Data/Git.hs +0/−41
• Data/Git/Backend.hs +0/−58
• Data/Git/Backend/Trace.hs +0/−118
• Data/Git/Blob.hs +0/−144
• Data/Git/Commit.hs +0/−274
• Data/Git/Common.hs +0/−76
• Data/Git/Error.hs +0/−43
• Data/Git/Internal.hs +0/−242
• Data/Git/Object.hs +0/−71
• Data/Git/Oid.hs +0/−146
• Data/Git/Reference.hs +0/−227
• Data/Git/Repository.hs +0/−26
• Data/Git/Tag.hs +0/−18
• Data/Git/Tree.hs +0/−327
• Data/Git/Tutorial.hs +0/−87
• Git.hs +577/−0
• Git/Tutorial.hs +87/−0
• gitlib.cabal +38/−70
• test/Doctest.hs +3/−2
• test/Smoke.hs +0/−280

@@ -1,41 +0,0 @@-{-| @gitlib@ is a high-level, lazy and conduit-aware type wrapper around the-    libgit2 C library (<http://libgit2.github.com>).  The aim is both-    type-safety and convenience of use for Haskell users, combined with high-    performance and minimal memory footprint by taking advantage of Haskell's-    laziness and the conduit library's deterministic resource cleanup.--    For further information, as well as typical use cases, see-    "Data.Git.Tutorial".--}--module Data.Git (-    module Data.Git.Repository,-    -- module Data.Git.Config,-    -- module Data.Git.Tag,-    -- module Data.Git.Reflog,-    module Data.Git.Commit,-    -- module Data.Git.Index,-    module Data.Git.Blob,-    module Data.Git.Error,-    module Data.Git.Oid,-    module Data.Git.Tree,-    module Data.Git.Reference,-    -- module Data.Git.Odb,-    module Data.Git.Common,-    module Data.Git.Object-) where--import Data.Git.Repository--- import Data.Git.Config--- import Data.Git.Tag--- import Data.Git.Reflog-import Data.Git.Commit--- import Data.Git.Index-import Data.Git.Blob-import Data.Git.Error-import Data.Git.Oid-import Data.Git.Tree-import Data.Git.Reference--- import Data.Git.Odb-import Data.Git.Common-import Data.Git.Object

@@ -1,58 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Data.Git.Backend-       ( odbBackendAdd--       , F'git_odb_backend_read_callback-       , F'git_odb_backend_read_prefix_callback-       , F'git_odb_backend_readstream_callback-       , F'git_odb_backend_read_header_callback-       , F'git_odb_backend_write_callback-       , F'git_odb_backend_writestream_callback-       , F'git_odb_backend_exists_callback-       , F'git_odb_backend_free_callback-       )-       where--import           Data.Git.Error-import           Data.Git.Internal-import qualified Prelude--type F'git_odb_backend_read_callback =-  Ptr (Ptr ()) -> Ptr CSize -> Ptr C'git_otype -> Ptr C'git_odb_backend-    -> Ptr C'git_oid -> IO CInt-type F'git_odb_backend_read_prefix_callback =-  Ptr C'git_oid -> Ptr (Ptr ()) -> Ptr CSize -> Ptr C'git_otype-    -> Ptr C'git_odb_backend -> Ptr C'git_oid -> CUInt -> IO CInt-type F'git_odb_backend_readstream_callback =-  Ptr (Ptr C'git_odb_stream) -> Ptr C'git_odb_backend -> Ptr C'git_oid-    -> IO CInt-type F'git_odb_backend_read_header_callback =-  Ptr CSize -> Ptr C'git_otype -> Ptr C'git_odb_backend -> Ptr C'git_oid-    -> IO CInt-type F'git_odb_backend_write_callback =-  Ptr C'git_oid -> Ptr C'git_odb_backend -> Ptr () -> CSize -> C'git_otype-    -> IO CInt-type F'git_odb_backend_writestream_callback =-  Ptr (Ptr C'git_odb_stream) -> Ptr C'git_odb_backend -> CSize-    -> C'git_otype -> IO CInt-type F'git_odb_backend_exists_callback =-  Ptr C'git_odb_backend -> Ptr C'git_oid -> IO CInt-type F'git_odb_backend_free_callback = Ptr C'git_odb_backend -> IO ()--odbBackendAdd :: Repository -> Ptr C'git_odb_backend -> Int-                 -> IO (Result Repository)-odbBackendAdd repo backend priority =-  withForeignPtr (repoObj repo) $ \repoPtr ->-    alloca $ \odbPtr -> do-      r <- c'git_repository_odb odbPtr repoPtr-      if r < 0-        then return (Left "Cannot get repository ODB")-        else do-        odb <- peek odbPtr-        r2 <- c'git_odb_add_backend odb backend (fromIntegral priority)-        if r2 < 0-          then return (Left "Cannot add backend to repository ODB")-          else return (Right repo)---- Backend.hs

@@ -1,118 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE LiberalTypeSynonyms #-}-{-# LANGUAGE ImpredicativeTypes #-}--module Data.Git.Backend.Trace ( traceBackend ) where--import Data.ByteString.Unsafe-import Data.Git.Backend-import Data.Git.Error-import Data.Git.Internal-import Data.Git.Oid-import Debug.Trace (trace)-import Prelude hiding ((.), mapM_)--data TraceBackend = TraceBackend { traceParent :: C'git_odb_backend-                                 , traceNext   :: Ptr C'git_odb_backend }--instance Storable TraceBackend where-  sizeOf p = sizeOf (undefined :: C'git_odb_backend) +-             sizeOf (undefined :: Ptr C'git_odb_backend)-  alignment p = alignment (traceParent p)-  peek p = do-    v0 <- peekByteOff p 0-    v1 <- peekByteOff p (sizeOf (undefined :: C'git_odb_backend))-    return (TraceBackend v0 v1)-  poke p (TraceBackend v0 v1) = do-    pokeByteOff p 0 v0-    pokeByteOff p (sizeOf (undefined :: C'git_odb_backend)) v1-    return ()--traceBackendReadCallback :: F'git_odb_backend_read_callback-traceBackendReadCallback data_p len_p type_p be oid = do-  oidStr <- oidToStr oid-  putStrLn $ "Read " ++ oidStr-  tb <- peek (castPtr be :: Ptr TraceBackend)-  tn <- peek (traceNext tb)-  (mK'git_odb_backend_read_callback (c'git_odb_backend'read tn))-    data_p len_p type_p (traceNext tb) oid--traceBackendReadPrefixCallback :: F'git_odb_backend_read_prefix_callback-traceBackendReadPrefixCallback out_oid oid_p len_p type_p be oid len = do-  oidStr <- oidToStr oid-  putStrLn $ "Read Prefix " ++ oidStr ++ " " ++ show len-  tb <- peek (castPtr be :: Ptr TraceBackend)-  tn <- peek (traceNext tb)-  (mK'git_odb_backend_read_prefix_callback (c'git_odb_backend'read_prefix tn))-    out_oid oid_p len_p type_p (traceNext tb) oid len--traceBackendReadHeaderCallback :: F'git_odb_backend_read_header_callback-traceBackendReadHeaderCallback len_p type_p be oid = do-  oidStr <- oidToStr oid-  putStrLn $ "Read Header " ++ oidStr-  tb <- peek (castPtr be :: Ptr TraceBackend)-  tn <- peek (traceNext tb)-  (mK'git_odb_backend_read_header_callback (c'git_odb_backend'read_header tn))-    len_p type_p (traceNext tb) oid--traceBackendWriteCallback :: F'git_odb_backend_write_callback-traceBackendWriteCallback oid be obj_data len obj_type = do-  r <- c'git_odb_hash oid obj_data len obj_type-  case r of-    0 -> do-      oidStr <- oidToStr oid-      putStrLn $ "Write " ++ oidStr ++ " len " ++ show len-      tb <- peek (castPtr be :: Ptr TraceBackend)-      tn <- peek (traceNext tb)-      (mK'git_odb_backend_write_callback (c'git_odb_backend'write tn))-        oid (traceNext tb) obj_data len obj_type-    n -> return n--traceBackendExistsCallback :: F'git_odb_backend_exists_callback-traceBackendExistsCallback be oid = do-  oidStr <- oidToStr oid-  putStrLn $ "Exists " ++ oidStr-  tb <- peek (castPtr be :: Ptr TraceBackend)-  tn <- peek (traceNext tb)-  (mK'git_odb_backend_exists_callback (c'git_odb_backend'exists tn))-    (traceNext tb) oid--traceBackendFreeCallback :: F'git_odb_backend_free_callback-traceBackendFreeCallback be = do-  backend <- peek be-  freeHaskellFunPtr (c'git_odb_backend'read backend)-  freeHaskellFunPtr (c'git_odb_backend'read_prefix backend)-  freeHaskellFunPtr (c'git_odb_backend'read_header backend)-  freeHaskellFunPtr (c'git_odb_backend'write backend)-  freeHaskellFunPtr (c'git_odb_backend'exists backend)--foreign export ccall "traceBackendFreeCallback"-  traceBackendFreeCallback :: F'git_odb_backend_free_callback-foreign import ccall "&traceBackendFreeCallback"-  traceBackendFreeCallbackPtr :: FunPtr F'git_odb_backend_free_callback--traceBackend :: Ptr C'git_odb_backend -> IO (Ptr C'git_odb_backend)-traceBackend be = do-  readFun <- mk'git_odb_backend_read_callback traceBackendReadCallback-  readPrefixFun <--    mk'git_odb_backend_read_prefix_callback traceBackendReadPrefixCallback-  readHeaderFun <--    mk'git_odb_backend_read_header_callback traceBackendReadHeaderCallback-  writeFun <- mk'git_odb_backend_write_callback traceBackendWriteCallback-  existsFun <- mk'git_odb_backend_exists_callback traceBackendExistsCallback--  castPtr <$> new TraceBackend {-    traceParent = C'git_odb_backend {-         c'git_odb_backend'odb         = nullPtr-       , c'git_odb_backend'read        = readFun-       , c'git_odb_backend'read_prefix = readPrefixFun-       , c'git_odb_backend'readstream  = nullFunPtr-       , c'git_odb_backend'read_header = readHeaderFun-       , c'git_odb_backend'write       = writeFun-       , c'git_odb_backend'writestream = nullFunPtr-       , c'git_odb_backend'exists      = existsFun-       , c'git_odb_backend'free        = traceBackendFreeCallbackPtr }-    , traceNext = be }---- Trace.hs

@@ -1,144 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ViewPatterns #-}-{-# LANGUAGE PatternGuards #-}--module Data.Git.Blob-       ( Blob(..)-       , BlobContents(..)-       , ByteSource-       , newBlobBase-       , createBlob-       , getBlobContents-       , blobSourceToString-       , lookupBlob-       , writeBlob )-       where--import           Data.ByteString as B hiding (map)-import           Data.ByteString.Unsafe-import           Data.Conduit-import           Data.Git.Common-import           Data.Git.Error-import           Data.Git.Internal-import qualified Prelude--data BlobContents = BlobEmpty-                  | BlobString B.ByteString-                  | BlobStream ByteSource--instance Eq BlobContents where-  BlobEmpty == BlobEmpty = True-  BlobString str1 == BlobString str2 = str1 == str2-  BlobStream src1 == BlobStream src2 = False-  _ == _ = False--blobSourceToString :: BlobContents -> IO (Maybe B.ByteString)-blobSourceToString BlobEmpty = return Nothing-blobSourceToString (BlobString bs) = return (Just bs)-blobSourceToString (BlobStream bs) = do str <- bs $$ await-                                        case str of-                                          Nothing   -> return Nothing-                                          Just str' -> return (Just str')--data Blob = Blob { blobInfo     :: Base Blob-                 , blobContents :: BlobContents }-          deriving Eq--instance Show Blob where-  show x = case gitId (blobInfo x) of-    Pending _ -> "Blob..."-    Stored y  -> "Blob#" ++ show y--instance Updatable Blob where-  getId          = gitId . blobInfo-  objectRepo     = gitRepo . blobInfo-  objectPtr      = gitObj . blobInfo-  update         = writeBlob-  lookupFunction = lookupBlob-#if defined(PROFILING)-  loadObject' x y =-    maybe (throwIO ObjectLookupFailed) return =<< loadObject x y-#endif--newBlobBase :: Blob -> Base Blob-newBlobBase b = newBase (gitRepo (blobInfo b)) (Pending doWriteBlob) Nothing---- | Create a new blob in the 'Repository', with 'ByteString' as its contents.------   Note that since empty blobs cannot exist in Git, no means is provided for---   creating one; if the give string is 'empty', it is an error.-createBlob :: Repository -> B.ByteString -> Blob-createBlob repo text-  | text == B.empty = error "Cannot create an empty blob"-  | otherwise =-    Blob { blobInfo     = newBase repo (Pending doWriteBlob) Nothing-         , blobContents = BlobString text }--lookupBlob :: Repository -> Oid -> IO (Maybe Blob)-lookupBlob repo oid =-  lookupObject' repo oid c'git_blob_lookup c'git_blob_lookup_prefix $-    \coid obj _ ->-      return Blob { blobInfo     = newBase repo (Stored coid) (Just obj)-                  , blobContents = BlobEmpty }--getBlobContents :: Blob -> IO (Blob, BlobContents)-getBlobContents b@(gitId . blobInfo -> Pending _) = return (b, blobContents b)-getBlobContents b@(gitId . blobInfo -> Stored hash)-  | BlobEmpty <- contents =-    case gitObj (blobInfo b) of-      Just blobPtr ->-        withForeignPtr blobPtr $ \ptr -> do-          size <- c'git_blob_rawsize (castPtr ptr)-          buf  <- c'git_blob_rawcontent (castPtr ptr)-          -- The lifetime of buf is tied to the lifetime of the blob object in-          -- libgit2, which this Blob object controls, so we can use-          -- unsafePackCStringLen to refer to its bytes.-          bstr <- curry unsafePackCStringLen (castPtr buf)-                        (fromIntegral size)-          let contents' = BlobString bstr-          return (b { blobContents = contents' }, contents' )--      Nothing -> do-        b' <- lookupBlob repo (Oid hash)-        case b' of-          Just blobPtr' -> getBlobContents blobPtr'-          Nothing       -> return (b, BlobEmpty)--  | otherwise = return (b, contents)--  where repo     = gitRepo (blobInfo b)-        contents = blobContents b---- | Write out a blob to its repository.  If it has already been written,---   nothing will happen.-writeBlob :: Blob -> IO Blob-writeBlob b@(Blob { blobInfo = Base { gitId = Stored _ } }) = return b-writeBlob b = do hash <- doWriteBlob b-                 return b { blobInfo     = (blobInfo b) { gitId = Stored hash }-                          , blobContents = BlobEmpty }---- jww (2012-12-14): Have the write functions return Either instead-doWriteBlob :: Blob -> IO COid-doWriteBlob b = do-    ptr <- mallocForeignPtr-    r   <- withForeignPtr (repoObj (gitRepo (blobInfo b)))-                         (createFromBuffer ptr)-    when (r < 0) $ throwIO BlobCreateFailed-    return (COid ptr)--  where-    createFromBuffer ptr repoPtr =-        maybe (throw BlobCreateFailed)-              (createBlobFromByteString ptr repoPtr)-              =<< blobSourceToString (blobContents b)--    createBlobFromByteString ptr repoPtr bs =-          unsafeUseAsCStringLen bs $-            uncurry (\cstr len ->-                      withForeignPtr ptr $ \ptr' ->-                        c'git_blob_create_frombuffer-                          ptr' repoPtr (castPtr cstr) (fromIntegral len))---- Blob.hs

@@ -1,274 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE OverloadedStrings #-}--module Data.Git.Commit-       ( Commit(..)-       , PinnedEntry(..)-       , newCommitBase-       , createCommit-       , lookupCommit-       , lookupRefCommit-       , addCommitParent-       , writeCommit-       , getCommitParents-       , modifyCommitTree-       , removeFromCommitTree-       , updateCommit-       , commitHistoryFirstParent-       , commitEntry-       , commitEntryHistory )-       where--import           Bindings.Libgit2-import qualified Data.ByteString as BS-import           Data.ByteString.Unsafe-import           Data.Git.Common-import           Data.Git.Internal-import           Data.Git.Reference-import           Data.Git.Tree-import qualified Data.Text as T-import qualified Data.Text.Encoding as E-import qualified Data.Text.ICU.Convert as U-import qualified Foreign.Concurrent as FC-import qualified Foreign.ForeignPtr.Unsafe as FU-import           Foreign.Marshal.Array-import qualified Prelude--data Commit = Commit { commitInfo      :: Base Commit-                     , commitAuthor    :: Signature-                     , commitCommitter :: Signature-                     , commitLog       :: Text-                     , commitEncoding  :: Prelude.String-                     , commitTree      :: ObjRef Tree-                     , commitParents   :: [ObjRef Commit]-                     , commitObj       :: ObjPtr C'git_commit }--instance Show Commit where-  show x = case gitId (commitInfo x) of-    Pending _ -> "Commit..."-    Stored y  -> "Commit#" ++ show y ++ " <" ++ show (commitTree x) ++ ">"--instance Updatable Commit where-  getId x        = gitId (commitInfo x)-  objectRepo x   = gitRepo (commitInfo x)-  objectPtr x    = gitObj (commitInfo x)-  update         = flip writeCommit Nothing-  lookupFunction = lookupCommit-#if defined(PROFILING)-  loadObject' x y =-    maybe (throwIO ObjectLookupFailed) return =<< loadObject x y-#endif--newCommitBase :: Commit -> Base Commit-newCommitBase t =-  newBase (gitRepo (commitInfo t))-          (Pending (flip doWriteCommit Nothing >=> return . snd)) Nothing---- | Create a new, empty commit.------   Since empty commits cannot exist in Git, attempting to write out an empty---   commit is a no-op.-createCommit :: Repository -> Signature -> Commit-createCommit repo sig =-  Commit { commitInfo     =-           newBase repo (Pending (flip doWriteCommit Nothing >=> return . snd))-                   Nothing-         , commitAuthor    = sig-         , commitCommitter = sig-         , commitTree      = ObjRef (createTree repo)-         , commitParents   = []-         , commitLog       = T.empty-         , commitEncoding  = ""-         , commitObj       = Nothing }--lookupCommit :: Repository -> Oid -> IO (Maybe Commit)-lookupCommit repo oid =-  lookupObject' repo oid c'git_commit_lookup c'git_commit_lookup_prefix $-    \coid obj _ ->-      withForeignPtr obj $ \cobj -> do-        let c = castPtr cobj--        enc   <- c'git_commit_message_encoding c-        encs  <- if enc == nullPtr-                then return "UTF-8"-                else peekCString enc-        conv  <- U.open encs (Just False)--        msg   <- c'git_commit_message c   >>= BS.packCString-        auth  <- c'git_commit_author c    >>= packSignature conv-        comm  <- c'git_commit_committer c >>= packSignature conv-        toid  <- c'git_commit_tree_oid c  >>= wrapOidPtr--        pn    <- c'git_commit_parentcount c-        poids <- traverse wrapOidPtr-                =<< sequence-                      (zipWith ($) (replicate (fromIntegral (toInteger pn))-                                              (c'git_commit_parent_oid c))-                                   [0..pn])--        return Commit { commitInfo      = newBase repo (Stored coid) (Just obj)-                      , commitAuthor    = auth-                      , commitCommitter = comm-                      , commitTree      = toid-                      , commitParents   = poids-                      , commitLog       = U.toUnicode conv msg-                      , commitEncoding  = encs-                      , commitObj       = Just $ unsafeCoerce obj }--lookupRefCommit :: Repository -> Text -> IO (Maybe Commit)-lookupRefCommit repo ref = do-  oid <- resolveRef repo ref-  maybe (return Nothing) (lookupCommit repo) oid--addCommitParent :: Commit -> Commit -> Commit-addCommitParent co p = co { commitParents = commitParents co ++ [ObjRef p] }---- | Write out a commit to its repository.  If it has already been written,---   nothing will happen.-writeCommit :: Commit -> Maybe Text -> IO Commit-writeCommit c@(Commit { commitInfo = Base { gitId = Stored _ } }) _ =-  return c-writeCommit c ref = fst <$> doWriteCommit c ref--withForeignPtrs :: [ForeignPtr a] -> ([Ptr a] -> IO b) -> IO b-withForeignPtrs fos io-  = do r <- io (map FU.unsafeForeignPtrToPtr fos)-       mapM touchForeignPtr fos-       return r--doWriteCommit :: Commit -> Maybe Text -> IO (Commit, COid)-doWriteCommit c ref = do-  coid <- withForeignPtr (repoObj (gitRepo (commitInfo c))) $ \repoPtr -> do-    coid <- mallocForeignPtr-    withForeignPtr coid $ \coid' -> do-      conv <- U.open (commitEncoding c) (Just True)-      BS.useAsCString (U.fromUnicode conv (commitLog c)) $ \message ->-        withRef ref $ \update_ref ->-        withSignature conv (commitAuthor c) $ \author ->-        withSignature conv (commitCommitter c) $ \committer ->-        withEncStr (commitEncoding c) $ \message_encoding ->-        withGitTree (commitTree c) c $ \commit_tree -> do-          parentPtrs <- getCommitParentPtrs c-          withForeignPtrs parentPtrs $ \pptrs -> do-            parents <- newArray pptrs-            r <- c'git_commit_create coid' repoPtr-                  update_ref author committer-                  message_encoding message commit_tree-                  (fromIntegral (length (commitParents c)))-                  parents-            when (r < 0) $ throwIO CommitCreateFailed-            return coid--  return (c { commitInfo = (commitInfo c) { gitId = Stored (COid coid) } }-         , COid coid)--  where-    withRef Nothing     = flip ($) nullPtr-    withRef (Just name) = BS.useAsCString (E.encodeUtf8 name)--    withEncStr ""  = flip ($) nullPtr-    withEncStr enc = withCString enc--getCommitParents :: Commit -> IO [Commit]-getCommitParents c =-    traverse (\p -> do parent <- loadObject p c-                       case parent of-                           Nothing -> error "Cannot find Git commit"-                           Just p' -> return p')-             (commitParents c)--getCommitParentPtrs :: Commit -> IO [ForeignPtr C'git_commit]-getCommitParentPtrs c =-  withForeignPtr (repositoryPtr (objectRepo c)) $ \repoPtr ->-    for (commitParents c) $ \p ->-      case p of-        ObjRef (Commit { commitObj = Just obj }) -> return obj-        _ -> do-          Oid (COid oid) <--            case p of-              IdRef coid -> return $ Oid coid-              ObjRef x   -> objectId x--          withForeignPtr oid $ \commit_id ->-            alloca $ \ptr -> do-              r <- c'git_commit_lookup ptr repoPtr commit_id-              when (r < 0) $ throwIO CommitLookupFailed-              ptr' <- peek ptr-              FC.newForeignPtr ptr' (c'git_commit_free ptr')--modifyCommitTree-  :: Commit -> FilePath -> (Maybe TreeEntry -> Either a (Maybe TreeEntry)) -> Bool-  -> IO (Either a Commit)-modifyCommitTree c path f createIfNotExist =-  withObject (commitTree c) c $ \tr -> do-    result <- modifyTree path f createIfNotExist tr-    case result of-      Left x    -> return (Left x)-      Right tr' -> return $ Right $ c { commitTree = ObjRef tr' }--removeFromCommitTree :: Commit -> FilePath -> IO Commit-removeFromCommitTree c path =-  withObject (commitTree c) c $ \tr -> do-    tr' <- removeFromTree path tr-    return c { commitTree = ObjRef tr' }--doUpdateCommit :: Commit -> [Text] -> TreeEntry -> IO Commit-doUpdateCommit c xs item = do-    t <- loadObject (commitTree c) c-    case t of-        Nothing -> throwIO CommitLookupFailed-        Just t' -> do-            newt <- doUpdateTree t' xs item-            return c { commitTree = ObjRef newt-                     , commitInfo =-                            newBase (objectRepo c)-                                    (Pending (flip doWriteCommit Nothing-                                              >=> return . snd)) Nothing-                     , commitObj  = Nothing }--updateCommit :: Commit -> FilePath -> TreeEntry -> IO Commit-updateCommit c = doUpdateCommit c . splitPath--commitHistoryFirstParent :: Commit -> IO [Commit]-commitHistoryFirstParent c =-  case commitParents c of-    []    -> return [c]-    (p:_) -> do p' <- loadObject' p c-                ps <- commitHistoryFirstParent p'-                return (c:ps)--commitEntry :: Commit -> FilePath -> IO (Maybe TreeEntry)-commitEntry c path =-  flip lookupTreeEntry path =<< loadObject' (commitTree c) c--data PinnedEntry = PinnedEntry { pinnedOid    :: Oid-                               , pinnedCommit :: Commit-                               , pinnedEntry  :: TreeEntry }-                 deriving Show--identifyEntry :: Commit -> TreeEntry -> IO PinnedEntry-identifyEntry co x = do-  oid <- case x of-          BlobEntry blob _ -> objectRefId blob-          TreeEntry tree   -> objectRefId tree-  return (PinnedEntry oid co x)--commitEntryHistory :: Commit -> FilePath -> IO [PinnedEntry]-commitEntryHistory c path = map head-                            . filter (not . null)-                            . groupBy ((==) `on` pinnedOid) <$> go c-  where go co = do-          entry <- getEntry co-          rest  <- case commitParents co of-            []    -> return []-            (p:_) -> go =<< loadObject' p co-          return $ maybe rest (:rest) entry--        getEntry co = do-          ce <- commitEntry co path-          case ce of-            Nothing  -> return Nothing-            Just ce' -> Just <$> identifyEntry co ce'---- Commit.hs

@@ -1,76 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Data.Git.Common-       ( Signature(..)-       , createSignature-       , packSignature-       , withSignature--       , Base(..)-       , newBase )-       where--import qualified Data.ByteString as BS-import           Data.Git.Internal-import qualified Data.Text as T-import qualified Data.Text.ICU.Convert as U-import           Data.Time-import           Data.Time.Clock.POSIX (posixSecondsToUTCTime,-                                        utcTimeToPOSIXSeconds)-import qualified Prelude--data Signature = Signature { signatureName  :: Text-                           , signatureEmail :: Text-                           , signatureWhen  :: UTCTime }-               deriving (Show, Eq)---- | Convert a time in seconds (from Stripe's servers) to 'UTCTime'. See---   "Data.Time.Format" for more on working with 'UTCTime'.-fromSeconds :: Integer -> UTCTime-fromSeconds  = posixSecondsToUTCTime . fromInteger---- | Convert a 'UTCTime' back to an Integer suitable for use with Stripe's API.-toSeconds :: UTCTime -> Integer-toSeconds  = round . utcTimeToPOSIXSeconds--peekGitTime :: Ptr (C'git_time) -> IO UTCTime-peekGitTime time =-  -- jww (2012-09-29): Handle offset here-  return . fromSeconds . toInteger . c'git_time'time =<< peek time--packGitTime :: UTCTime -> C'git_time-packGitTime utcTime =-  C'git_time { c'git_time'time   = fromIntegral (toSeconds utcTime)-             , c'git_time'offset = 0 } -- jww (2012-09-29): NYI--createSignature :: Signature-createSignature =-  Signature { signatureName  = T.empty-            , signatureEmail = T.empty-            , signatureWhen  =-              UTCTime { utctDay =-                           ModifiedJulianDay {-                             toModifiedJulianDay = 0 }-                      , utctDayTime = secondsToDiffTime 0 } }--packSignature :: U.Converter -> Ptr C'git_signature -> IO Signature-packSignature conv sig = do-  name  <- peek (p'git_signature'name sig)  >>= BS.packCString-  email <- peek (p'git_signature'email sig) >>= BS.packCString-  time  <- peekGitTime (p'git_signature'when sig)-  return $-    Signature { signatureName  = U.toUnicode conv name-              , signatureEmail = U.toUnicode conv email-              , signatureWhen  = time }--withSignature :: U.Converter -> Signature-              -> (Ptr C'git_signature -> IO a) -> IO a-withSignature conv sig f =-  BS.useAsCString (U.fromUnicode conv (signatureName sig)) $ \nameCStr ->-    BS.useAsCString (U.fromUnicode conv (signatureEmail sig)) $ \emailCStr ->-      alloca $ \ptr -> do-        poke ptr (C'git_signature nameCStr emailCStr-                                  (packGitTime (signatureWhen sig)))-        f ptr---- Common.hs

@@ -1,43 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}---- | Error types which may be thrown during Git operations, using---   'Control.Exception.throwIO'.-module Data.Git.Error-       ( GitException(..), Result )-       where--import Control.Exception-import Data.Typeable-import Data.Text-import Prelude hiding (FilePath)---- | There is a separate 'GitException' for each possible failure when---   interacting with the Git repository.-data GitException = RepositoryNotExist String-                  | RepositoryInvalid-                  | BlobCreateFailed-                  | BlobEmptyCreateFailed-                  | TreeCreateFailed-                  | TreeBuilderCreateFailed-                  | TreeBuilderInsertFailed-                  | TreeBuilderWriteFailed-                  | TreeLookupFailed-                  | TreeCannotTraverseBlob-                  | TreeEntryLookupFailed-                  | TreeUpdateFailed-                  | CommitCreateFailed-                  | CommitLookupFailed-                  | ReferenceCreateFailed-                  | RefCannotCreateFromPartialOid-                  | ReferenceLookupFailed-                  | ObjectLookupFailed-                  | ObjectIdTooLong-                  | ObjectRefRequiresFullOid-                  | OidCopyFailed-                  deriving (Show, Typeable)--type Result = Either Text--instance Exception GitException---- Error.hs

@@ -1,242 +0,0 @@-{-# OPTIONS_HADDOCK hide, prune, ignore-exports #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeSynonymInstances #-}-{-# LANGUAGE FlexibleInstances #-}--module Data.Git.Internal-       ( ObjPtr-       , ByteSource--       , Updatable(..)--       , Base(..), newBase--       , Repository(..)-       , openRepository-       , createRepository-       , openOrCreateRepository-       , repositoryPtr--       , lookupObject'-       , withObject-       , withObjectPtr--       , RefTarget(..)-       , Reference(..)--       , module X )-       where--import           Bindings.Libgit2 as X-import           Control.Applicative as X-import           Control.Category as X-import           Control.Exception as X-import           Control.Lens as X-import           Control.Monad as X hiding (mapM, mapM_, sequence, sequence_,-                                            forM, forM_, msum, unless, guard)-import           Data.Bool as X-import           Data.ByteString as B hiding (map)-import           Data.Conduit-import           Data.Either as X hiding (lefts, rights)-import           Data.Foldable as X-import           Data.Function as X hiding ((.), id)-import           Data.Git.Error as X-import           Data.Git.Oid as X-import           Data.List as X hiding (foldl, foldl', foldl1, foldr1, foldl1',-                                        foldr, concat, maximum, minimum,-                                        product, sum, all, and, any, concatMap,-                                        elem, notElem, or, find, mapAccumL,-                                        mapAccumR, maximumBy, minimumBy)-import           Data.Maybe as X-import           Data.Monoid as X-import           Data.Stringable as X hiding (length)-import           Data.Text as X (Text)-import           Data.Tuple as X-import           Data.Traversable as X-import           Filesystem as X hiding (createTree)-import qualified Filesystem.Path.CurrentOS as F-import           Filesystem.Path.CurrentOS as X (FilePath)-import           Foreign.C.String as X-import           Foreign.C.Types as X-import           Foreign.ForeignPtr as X-import           Foreign.Marshal.Alloc as X-import           Foreign.Marshal.Utils as X-import           Foreign.Ptr as X-import           Foreign.StablePtr as X-import           Foreign.Storable as X-import           Prelude as X (undefined, error, otherwise, IO, Show, show,-                               Enum, Eq, Ord, (<), (==), (/=), round, Int,-                               Integer, fromIntegral, fromInteger, toInteger,-                               putStrLn, (-), (+))-import           Unsafe.Coerce as X--type ObjPtr a = Maybe (ForeignPtr a)--type ByteSource = GSource IO B.ByteString--class Updatable a where-  getId      :: a -> Ident a-  objectRepo :: a -> Repository-  objectPtr  :: a -> ObjPtr C'git_object--  update  :: a -> IO a-  update_ :: a -> IO ()-  update_ = void . update--  objectId :: a -> IO Oid-  objectId x = case getId x of-    Pending f -> Oid <$> f x-    Stored y  -> return $ Oid y--  objectRef :: a -> IO (ObjRef a)-  objectRef x = do-    oid <- objectId x-    case oid of-      Oid coid -> return (IdRef coid)-      PartialOid _ _ -> error "Did not expect to see a PartialOid"--  objectRefId :: ObjRef a -> IO Oid-  objectRefId (IdRef coid) = return (Oid coid)-  objectRefId (ObjRef x)   = objectId x--  maybeObjectId :: a -> Maybe Oid-  maybeObjectId x = case getId x of-    Pending _ -> Nothing-    Stored y  -> Just (Oid y)--  lookupFunction :: Repository -> Oid -> IO (Maybe a)--  loadObject :: Updatable b => ObjRef a -> b -> IO (Maybe a)-  loadObject (IdRef coid) y = lookupFunction (objectRepo y) (Oid coid)-  loadObject (ObjRef x) _   = return (Just x)--  loadObject' :: Updatable b => ObjRef a -> b -> IO a-  loadObject' x y =-    maybe (throwIO ObjectLookupFailed) return =<< loadObject x y--  getObject :: ObjRef a -> Maybe a-  getObject (IdRef _)  = Nothing-  getObject (ObjRef x) = Just x--data Repository = Repository-    { repoPath :: FilePath-    -- jww (2013-01-21): These two callbacks are a temporary workaround until-    -- libgit2 supports full virtualization of repositories.  See:-    -- https://github.com/libgit2/libgit2/issues/1213-    , repoBeforeReadRef :: [Repository -> Text -> IO ()]-    , repoOnWriteRef    :: [Repository -> Reference -> IO ()]-    , repoObj           :: ForeignPtr C'git_repository-    }--instance Eq Repository where-  x == y = repoPath x == repoPath y && repoObj x == repoObj y--instance Show Repository where-  show x = "Repository " <> toString (repoPath x)--data RefTarget = RefTargetId Oid-               | RefTargetSymbolic Text-               deriving (Show, Eq)--data Reference = Reference { refRepo   :: Repository-                           , refName   :: Text-                           , refTarget :: RefTarget-                           , refObj    :: ObjPtr C'git_reference }-               deriving (Show, Eq)--data Base a = Base { gitId   :: Ident a-                   , gitRepo :: Repository-                   , gitObj  :: ObjPtr C'git_object }-            deriving Eq--instance Show (Base a) where-  show x = case gitId x of-             Pending _ -> "Base..."-             Stored y  -> "Base#" ++ show y--newBase :: Repository -> Ident a -> ObjPtr C'git_object -> Base a-newBase repo oid obj = Base { gitId   = oid-                            , gitRepo = repo-                            , gitObj  = obj }--repositoryPtr :: Repository -> ForeignPtr C'git_repository-repositoryPtr repo = repoObj repo--openRepository :: FilePath -> IO Repository-openRepository path =-  openRepositoryWith path c'git_repository_open--createRepository :: FilePath -> Bool -> IO Repository-createRepository path bare =-  openRepositoryWith path (\x y -> c'git_repository_init x y (fromBool bare))--openOrCreateRepository :: FilePath -> Bool -> IO Repository-openOrCreateRepository path bare = do-  p <- isDirectory path-  if p-    then openRepository path-    else createRepository path bare--openRepositoryWith :: FilePath-                   -> (Ptr (Ptr C'git_repository) -> CString -> IO CInt)-                   -> IO Repository-openRepositoryWith path fn = alloca $ \ptr ->-  case F.toText path of-    Left p  -> doesNotExist p-    Right p ->-      withCStringable p $ \str -> do-        r <- fn ptr str-        when (r < 0) $ doesNotExist p-        ptr' <- peek ptr-        fptr <- newForeignPtr p'git_repository_free ptr'-        return Repository { repoPath          = path-                          , repoBeforeReadRef = []-                          , repoOnWriteRef    = []-                          , repoObj           = fptr-                          }-  where doesNotExist = throwIO . RepositoryNotExist . toString--withObject :: (Updatable a, Updatable b) => ObjRef a -> b -> (a -> IO c) -> IO c-withObject objRef parent f = do-  obj <- loadObject objRef parent-  case obj of-    Nothing   -> error "Cannot find Git object in repository"-    Just obj' -> f obj'--withObjectPtr :: (Updatable a, Updatable b)-              => ObjRef a -> b -> (Ptr c -> IO d) -> IO d-withObjectPtr objRef parent f =-  withObject objRef parent $ \obj ->-    case objectPtr obj of-      Nothing     -> error "Cannot find Git object id"-      Just objPtr -> withForeignPtr objPtr (f . castPtr)--lookupObject'-  :: Repository -> Oid-  -> (Ptr (Ptr a) -> Ptr C'git_repository -> Ptr C'git_oid -> IO CInt)-  -> (Ptr (Ptr a) -> Ptr C'git_repository -> Ptr C'git_oid -> CUInt -> IO CInt)-  -> (COid -> ForeignPtr C'git_object -> Ptr C'git_object -> IO b)-  -> IO (Maybe b)-lookupObject' repo oid lookupFn lookupPrefixFn createFn =-  alloca $ \ptr -> do-    r <- withForeignPtr (repositoryPtr repo) $ \repoPtr ->-           case oid of-             Oid (COid oid') ->-               withForeignPtr oid' $ \oidPtr ->-                 lookupFn ptr repoPtr oidPtr-             PartialOid (COid oid') len ->-               withForeignPtr oid' $ \oidPtr ->-                 lookupPrefixFn ptr repoPtr oidPtr (fromIntegral len)-    if r < 0-      then return Nothing-      else do-        ptr'     <- castPtr <$> peek ptr-        coid     <- c'git_object_id ptr'-        coidCopy <- mallocForeignPtr-        withForeignPtr coidCopy $ flip c'git_oid_cpy coid--        fptr <- newForeignPtr p'git_object_free ptr'-        Just <$> createFn (COid coidCopy) fptr ptr'---- Internal.hs

@@ -1,71 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Data.Git.Object-       ( Object(..)-       , ObjectType(..)-       , NamedRef(..)-       , revParse-       , lookupObject )-       where--import           Data.ByteString as B hiding (map)-import           Data.Git.Blob-import           Data.Git.Commit-import           Data.Git.Internal-import           Data.Git.Reference-import           Data.Git.Tag-import           Data.Git.Tree-import qualified Data.Map as M--data ObjectType = BlobType | TreeType | CommitType | TagType--data Object = BlobObj   Blob-            | TreeObj   Tree-            | CommitObj Commit-            | TagObj    Tag--data NamedRef a = FullHash a-                | PartialHash a-                | BranchName a-                | TagName a-                | RefName a-                | FullRefName a-                | Specifier a--revParse :: CStringable a => NamedRef a -> IO (Maybe Oid)-revParse (FullHash r)    = parseOid r-revParse (PartialHash r) = parseOid r-revParse (BranchName r)  = undefined-revParse (TagName r)     = undefined-revParse (RefName r)     = undefined-revParse (FullRefName r) = undefined-revParse (Specifier r)   = undefined--lookupObject :: Repository -> Oid -> IO (Maybe Object)-lookupObject repo oid =-  lookupObject' repo oid-    (\x y z    -> c'git_object_lookup x y z c'GIT_OBJ_ANY)-    (\x y z l  -> c'git_object_lookup_prefix x y z l c'GIT_OBJ_ANY)-    (\coid x y -> c'git_object_type y >>= createObject repo coid x)--lookupRefObject :: Repository -> Text -> IO (Maybe Object)-lookupRefObject repo ref = do-  oid <- resolveRef repo ref-  maybe (return Nothing) (lookupObject repo) oid--createObject :: Repository -> COid -> ForeignPtr C'git_object -> C'git_otype-             -> IO Object-createObject repo coid obj typ-  | typ == c'GIT_OBJ_BLOB =-    return $ BlobObj Blob { blobInfo =-                              newBase repo (Stored coid) (Just obj)-                          , blobContents = BlobEmpty }--  | typ == c'GIT_OBJ_TREE =-    return $ TreeObj Tree { treeInfo =-                              newBase repo (Stored coid) (Just obj)-                          , treeContents = M.empty }--  | otherwise = return undefined---- Object.hs

@@ -1,146 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}---- | The 'Oid' type represents a Git hash value, whether partial or full.  In---   general users do not interact with this type much, as all the top-level---   functions which expect hash values typically expect strings.-module Data.Git.Oid-       ( Oid(..)-       , COid(..)-       , oidToStr-       , ObjRef(..)-       , Ident(..)-       , wrapOidPtr-       , compareCOid-       , compareCOidLen-       , equalCOid-       , parseOid )-       where--import           Bindings.Libgit2.Oid-import           Control.Applicative-import           Control.Exception-import           Control.Monad-import qualified Data.ByteString.Char8 as BC-import           Data.ByteString.Unsafe-import           Data.Git.Error-import           Data.Stringable as S-import           Foreign.C.String-import           Foreign.ForeignPtr-import           Foreign.Ptr-import           System.IO.Unsafe---- | 'COid' is a type wrapper for a foreign pointer to libgit2's 'git_oid'---   structure.  Users should not have to deal with this type.-newtype COid = COid (ForeignPtr C'git_oid)--oidToStr :: Ptr C'git_oid -> IO String-oidToStr = c'git_oid_allocfmt >=> peekCString--instance Show COid where-  show (COid coid) = unsafePerformIO $ withForeignPtr coid oidToStr---- | 'ObjRef' refers to either a Git object of a particular type (if it has---   already been loaded into memory), or it refers to the 'COid' of that---   object in the repository.  This permits deferred loading of objects---   within potentially very large structures, such as trees and commits.---   However, it also means that every access to a sub-object must use---   loadObject from the type class 'Updatable'.-data ObjRef a = IdRef COid-              | ObjRef a-              deriving Show--wrapOidPtr :: Ptr C'git_oid -> IO (ObjRef a)-wrapOidPtr = newForeignPtr_ >=> return . IdRef . COid---- | An 'Ident' abstracts the fact that some objects won't have an identifier---   until they are written to disk -- even if sufficient information exists---   to determine that hash value.  If construct as a 'Pending' value, it is---   an 'IO' action that writes the object to disk and retrieves the resulting---   hash value from Git; if 'Stored', it is a 'COid' that is known to the---   repository.-data Ident a = Pending (a -> IO COid)-             | Stored COid--instance Eq (Ident a) where-  Pending f1 == Pending f2 = False-  Stored oid1 == Stored oid2 = oid1 == oid2-  _ == _ = False--instance Show (Ident a) where-  show (Pending _) = "Ident..."-  show (Stored coid) = show coid---- | 'Oid' represents either a full or partial SHA1 hash code used to identify---   Git objects.-data Oid = Oid COid-         | PartialOid COid Int--instance Show Oid where-  show (Oid x) = show x-  show (PartialOid x l) = take l $ show x---- | Compare two 'COid' values for equality.  More typical is to use 'compare'.-compareCOid :: COid -> COid -> Ordering-(COid x) `compareCOid` (COid y) =-  let c = unsafePerformIO $-            withForeignPtr x $ \x' ->-              withForeignPtr y $ \y' ->-                c'git_oid_cmp x' y'-  in c `compare` 0---- | Compare two 'COid' values for equality, but only up to a certain length.-compareCOidLen :: COid -> COid -> Int -> Ordering-compareCOidLen (COid x) (COid y) l =-  let c = unsafePerformIO $-            withForeignPtr x $ \x' ->-              withForeignPtr y $ \y' ->-                c'git_oid_ncmp x' y' (fromIntegral l)-  in c `compare` 0--instance Ord COid where-  compare = compareCOid---- | 'True' if two 'COid' values are equal.-equalCOid :: Ord a => a -> a -> Bool-x `equalCOid` y = (x `compare` y) == EQ--instance Eq COid where-  (==) = equalCOid--instance Eq Oid where-  (Oid x) == (Oid y) = x `equalCOid` y-  (PartialOid x xl) == (PartialOid y yl) =-    xl == yl && compareCOidLen x y xl == EQ-  _ == _ = False---- | Convert a hash string to a 'Maybe' 'Oid' value.  If the string is less---   than 40 hexadecimal digits, the result will be of type 'PartialOid'.------ >>> parseOid "a143ecf"--- Just a143ecf--- >>> parseOid "a143ecf" >>= (\(Just (PartialOid _ l)) -> return $ l == 7)--- True------ >>> let hash = "6cfc2ca31732fb6fa6b54bae6e586a57a0611aab"--- >>> parseOid hash--- Just 6cfc2ca31732fb6fa6b54bae6e586a57a0611aab--- >>> parseOid hash >>= (\(Just (Oid _)) -> return True)--- True-parseOid :: CStringable a => a -> IO (Maybe Oid)-parseOid str-  | len > 40 = throwIO ObjectIdTooLong-  | otherwise = do-    oid <- mallocForeignPtr-    withCStringable str $ \cstr ->-      withForeignPtr oid $ \ptr -> do-        r <- if len == 40-             then c'git_oid_fromstr ptr cstr-             else c'git_oid_fromstrn ptr cstr (fromIntegral len)-        if r < 0-          then return Nothing-          else return . Just $ if len == 40-                               then Oid (COid oid)-                               else PartialOid (COid oid) len-  where len = S.length str---- Oid.hs

@@ -1,227 +0,0 @@-{-# LANGUAGE ForeignFunctionInterface #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes #-}--module Data.Git.Reference-       ( RefTarget(..)-       , Reference(..)-       , createRef-       , resolveRef-       , lookupRef-       , listRefNames-       , ListFlags-       , allRefsFlag-       , oidRefsFlag-       , looseOidRefsFlag-       , symbolicRefsFlag-       , mapRefs-       , mapAllRefs-       , mapOidRefs-       , mapLooseOidRefs-       , mapSymbolicRefs-       , writeRef-       , writeRef_ )-       where--import           Bindings.Libgit2-import           Data.ByteString-import           Data.Git.Internal-import           Data.IORef-import qualified Data.Text as T-import qualified Data.Text.Encoding as E-import           Foreign.Marshal.Array-import qualified Prelude-import           Prelude ((+),(-))--createRef :: Repository -> Text -> RefTarget -> Reference-createRef repo name target =-  Reference { refRepo   = repo-            , refName   = name-            , refTarget = target-            , refObj    = Nothing }--lookupRef :: Repository -> Text -> IO (Maybe Reference)-lookupRef repo name = alloca $ \ptr -> do-  mapM_ (\f -> f repo name) (repoBeforeReadRef repo)-  r <- withForeignPtr (repositoryPtr repo) $ \repoPtr ->-        withCStringable name $ \namePtr ->-          c'git_reference_lookup ptr repoPtr namePtr-  if r < 0-    then return Nothing-    else do-    ref  <- peek ptr-    fptr <- newForeignPtr p'git_reference_free ref-    typ  <- c'git_reference_type ref-    targ <- if typ == c'GIT_REF_OID-            then do oidPtr <- c'git_reference_oid ref-                    newForeignPtr_ oidPtr-                      >>= return . RefTargetId . Oid . COid-            else do targName <- c'git_reference_target ref-                    packCString targName-                      >>= return . RefTargetSymbolic . E.decodeUtf8-    return $ Just Reference { refRepo   = repo-                            , refName   = name-                            , refTarget = targ-                            , refObj    = Just fptr }--writeRef :: Reference -> IO Reference-writeRef ref = alloca $ \ptr -> do-  withForeignPtr (repoObj (refRepo ref)) $ \repoPtr ->-    withCStringable (refName ref) $ \namePtr -> do-      r <- case refTarget ref of-        RefTargetId (PartialOid {}) ->-          throwIO RefCannotCreateFromPartialOid--        RefTargetId (Oid (COid coid)) ->-          withForeignPtr coid $ \coidPtr ->-            c'git_reference_create_oid ptr repoPtr namePtr-                                       coidPtr (fromBool True)--        RefTargetSymbolic symName ->-          withCStringable symName $ \symPtr ->-            c'git_reference_create_symbolic ptr repoPtr namePtr-                                            symPtr (fromBool True)-      when (r < 0) $ throwIO ReferenceCreateFailed--  fptr <- newForeignPtr_ =<< peek ptr-  let ref' = ref { refObj = Just fptr }-  mapM_ (\f -> f (refRepo ref') ref') (repoOnWriteRef (refRepo ref'))-  return ref'--writeRef_ :: Reference -> IO ()-writeRef_ = void . writeRef---- int git_reference_name_to_oid(git_oid *out, git_repository *repo,---   const char *name)--resolveRef :: Repository -> Text -> IO (Maybe Oid)-resolveRef repos name = alloca $ \ptr -> do-  mapM_ (\f -> f repos name) (repoBeforeReadRef repos)-  withCStringable name $ \namePtr ->-    withForeignPtr (repoObj repos) $ \repoPtr -> do-      r <- c'git_reference_name_to_oid ptr repoPtr namePtr-      if r < 0-        then return Nothing-        else Just . Oid <$> COid <$> newForeignPtr_ ptr---- int git_reference_rename(git_reference *ref, const char *new_name,---   int force)----renameRef = c'git_reference_rename---- int git_reference_delete(git_reference *ref)----deleteRef = c'git_reference_delete---- int git_reference_packall(git_repository *repo)----packallRefs = c'git_reference_packall--data ListFlags = ListFlags { listFlagInvalid  :: Bool-                           , listFlagOid      :: Bool-                           , listFlagSymbolic :: Bool-                           , listFlagPacked   :: Bool-                           , listFlagHasPeel  :: Bool }-               deriving (Show, Eq)--allRefsFlag :: ListFlags-allRefsFlag = ListFlags { listFlagInvalid  = False-                        , listFlagOid      = True-                        , listFlagSymbolic = True-                        , listFlagPacked   = True-                        , listFlagHasPeel  = False }--symbolicRefsFlag :: ListFlags-symbolicRefsFlag = ListFlags { listFlagInvalid  = False-                             , listFlagOid      = False-                             , listFlagSymbolic = True-                             , listFlagPacked   = False-                             , listFlagHasPeel  = False }--oidRefsFlag :: ListFlags-oidRefsFlag = ListFlags { listFlagInvalid  = False-                        , listFlagOid      = True-                        , listFlagSymbolic = False-                        , listFlagPacked   = True-                        , listFlagHasPeel  = False }--looseOidRefsFlag :: ListFlags-looseOidRefsFlag = ListFlags { listFlagInvalid  = False-                             , listFlagOid      = True-                             , listFlagSymbolic = False-                             , listFlagPacked   = False-                             , listFlagHasPeel  = False }--gitStrArray2List :: Ptr C'git_strarray -> IO [Text]-gitStrArray2List gitStrs = do-  count <- fromIntegral <$> ( peek $ p'git_strarray'count gitStrs )-  strings <- peek $ p'git_strarray'strings gitStrs--  r0 <- Foreign.Marshal.Array.peekArray count strings-  r1 <- sequence $ fmap peekCString r0-  return $ fmap T.pack r1--flagsToInt :: ListFlags -> CUInt-flagsToInt flags = (if listFlagOid flags      then 1 else 0)-                 + (if listFlagSymbolic flags then 2 else 0)-                 + (if listFlagPacked flags   then 4 else 0)-                 + (if listFlagHasPeel flags  then 8 else 0)--listRefNames :: Repository -> ListFlags -> IO [Text]-listRefNames repo flags =-  alloca $ \c'refs ->-    withForeignPtr (repositoryPtr repo) $ \repoPtr -> do-      r <- c'git_reference_list c'refs repoPtr (flagsToInt flags)-      when (r < 0) $ throwIO ReferenceLookupFailed--      refs <- gitStrArray2List c'refs-      c'git_strarray_free c'refs-      return refs--foreachRefCallback :: CString -> Ptr () -> IO CInt-foreachRefCallback name payload = do-  (callback,results) <- peek (castPtr payload) >>= deRefStablePtr-  result <- packCString name >>= callback . E.decodeUtf8-  modifyIORef results (\xs -> result:xs)-  return 0--foreign export ccall "foreachRefCallback"-  foreachRefCallback :: CString -> Ptr () -> IO CInt-foreign import ccall "&foreachRefCallback"-  foreachRefCallbackPtr :: FunPtr (CString -> Ptr () -> IO CInt)--mapRefs :: Repository -> ListFlags -> (Text -> IO a) -> IO [a]-mapRefs repo flags callback = do-  ioRef <- newIORef []-  bracket-    (newStablePtr (callback,ioRef))-    deRefStablePtr-    (\ptr -> with ptr $ \pptr ->-      withForeignPtr (repositoryPtr repo) $ \repoPtr -> do-        _ <- c'git_reference_foreach repoPtr (flagsToInt flags)-                                    foreachRefCallbackPtr (castPtr pptr)-        readIORef ioRef)--mapAllRefs :: Repository -> (Text -> IO a) -> IO [a]-mapAllRefs repo = mapRefs repo allRefsFlag-mapOidRefs :: Repository -> (Text -> IO a) -> IO [a]-mapOidRefs repo = mapRefs repo oidRefsFlag-mapLooseOidRefs :: Repository -> (Text -> IO a) -> IO [a]-mapLooseOidRefs repo = mapRefs repo looseOidRefsFlag-mapSymbolicRefs :: Repository -> (Text -> IO a) -> IO [a]-mapSymbolicRefs repo = mapRefs repo symbolicRefsFlag---- int git_reference_is_packed(git_reference *ref)----refIsPacked = c'git_reference_is_packed---- int git_reference_reload(git_reference *ref)----reloadRef = c'git_reference_reload---- int git_reference_cmp(git_reference *ref1, git_reference *ref2)----compareRef = c'git_reference_cmp---- Refs.hs

@@ -1,26 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}---- | Interface for opening and creating repositories.  Repository objects are---   immutable, and serve only to refer to the given repository.  Any data---   associated with the repository — such as the list of branches — is---   queried as needed.-module Data.Git.Repository-       ( ObjPtr--       , Updatable(..)--       , Repository(..)-       , openRepository-       , createRepository-       , openOrCreateRepository-       , repositoryPtr--       , lookupObject'-       , withObject-       , withObjectPtr-       )-       where--import Data.Git.Internal---- Repository.hs

@@ -1,18 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Data.Git.Tag where--import           Data.Git.Common-import           Data.Git.Internal-import qualified Data.Text as T-import qualified Prelude--data Tag = Tag { tagInfo :: Base Tag-               , tagRef  :: Oid }--instance Show Tag where-  show x = case gitId (tagInfo x) of-    Pending _ -> "Tag..."-    Stored y  -> "Tag#" ++ show y---- Tag.hs

@@ -1,327 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FlexibleContexts #-}--module Data.Git.Tree where--import           Bindings.Libgit2-import           Control.Concurrent.ParallelIO-import           Data.Git.Blob-import           Data.Git.Common-import           Data.Git.Error-import           Data.Git.Internal-import qualified Data.Map as M-import qualified Data.Text as T-import qualified Filesystem.Path.CurrentOS as F-import qualified Prelude--data TreeEntry = BlobEntry { blobEntry      :: ObjRef Blob-                           , blobEntryIsExe :: Bool }-               | TreeEntry { treeEntry      :: ObjRef Tree }--blobRefWithMode :: Bool -> Blob -> TreeEntry-blobRefWithMode mode b = BlobEntry (ObjRef b) mode--blobRef :: Blob -> TreeEntry-blobRef = blobRefWithMode False--exeBlobRef :: Blob -> TreeEntry-exeBlobRef = blobRefWithMode True--blobIdRef :: Oid -> Bool -> TreeEntry-blobIdRef (Oid coid)      = BlobEntry (IdRef coid)-blobIdRef (PartialOid {}) = throw ObjectRefRequiresFullOid--treeRef :: Tree -> TreeEntry-treeRef t = TreeEntry (ObjRef t)--treeIdRef :: Oid -> TreeEntry-treeIdRef (Oid coid)      = TreeEntry (IdRef coid)-treeIdRef (PartialOid {}) = throw ObjectRefRequiresFullOid---- instance Eq TreeEntry where---   (BlobEntry x x2) == (BlobEntry y y2) = x == y && x2 == y2---   (TreeEntry x) == (TreeEntry y) = x == y---   _ == _ = False--type TreeMap = M.Map Text TreeEntry--data Tree = Tree { treeInfo     :: Base Tree-                 , treeContents :: TreeMap }--instance Show Tree where-  show x = case gitId (treeInfo x) of-             Pending _ -> "Tree..."-             Stored y  -> "Tree#" ++ show y--instance Show TreeEntry where-  show (BlobEntry blob _) = "BlobEntry (" ++ show blob ++ ")"-  show (TreeEntry tree)   = "TreeEntry (" ++ show tree ++ ")"--instance Updatable Tree where-  getId x        = gitId (treeInfo x)-  objectRepo x   = gitRepo (treeInfo x)-  objectPtr x    = gitObj (treeInfo x)-  update         = writeTree-  lookupFunction = lookupTree-#if defined(PROFILING)-  loadObject' x y =-    maybe (throwIO ObjectLookupFailed) return =<< loadObject x y-#endif--newTreeBase :: Tree -> Base Tree-newTreeBase t =-  newBase (gitRepo (treeInfo t))-          (Pending (doWriteTree >=> return . snd)) Nothing---- | Create a new, empty tree.------   Since empty trees cannot exist in Git, attempting to write out an empty---   tree is a no-op.-createTree :: Repository -> Tree-createTree repo =-  Tree { treeInfo =-            newBase repo (Pending (doWriteTree >=> return . snd)) Nothing-       , treeContents = M.empty }--lookupTree :: Repository -> Oid -> IO (Maybe Tree)-lookupTree repo oid =-  lookupObject' repo oid c'git_tree_lookup c'git_tree_lookup_prefix $-    \coid obj _ -> do-      entriesAList <- withForeignPtr obj $ \treePtr -> do-        entryCount <- c'git_tree_entrycount (castPtr treePtr)-        foldM-          (\m idx -> do-              entry   <- c'git_tree_entry_byindex (castPtr treePtr)-                                                 (fromIntegral idx)-              when (entry == nullPtr) $ throwIO ObjectLookupFailed-              entryId <- c'git_tree_entry_id entry-              coid    <- mallocForeignPtr-              withForeignPtr coid $ \coid' ->-                c'git_oid_cpy coid' entryId--              entryName  <- c'git_tree_entry_name entry-                            >>= peekCString >>= return . T.pack-              entryAttrs <- c'git_tree_entry_attributes entry-              entryType  <- c'git_tree_entry_type entry--              let entryObj = if entryType == c'GIT_OBJ_BLOB-                             then BlobEntry (IdRef (COid coid)) False-                             else TreeEntry (IdRef (COid coid))--              return ((entryName,entryObj):m))-          [] [0..(entryCount-1)]-      return Tree { treeInfo     = newBase repo (Stored coid) (Just obj)-                  , treeContents = M.fromList entriesAList }--doLookupTreeEntry :: Tree -> [Text] -> IO (Maybe TreeEntry)-doLookupTreeEntry t [] = return (Just (TreeEntry (ObjRef t)))-doLookupTreeEntry t (name:names) = do-  -- Lookup the current name in this tree.  If it doesn't exist, and there are-  -- more names in the path and 'createIfNotExist' is True, create a new Tree-  -- and descend into it.  Otherwise, if it exists we'll have @Just (TreeEntry-  -- {})@, and if not we'll have Nothing.--  -- Prelude.putStrLn $ "Tree: " ++ show t-  -- Prelude.putStrLn $ "Tree Entries: " ++ show (treeContents t)-  -- Prelude.putStrLn $ "Lookup: " ++ toString name-  y <- case M.lookup name (treeContents t) of-    Nothing -> return Nothing-    Just j  -> case j of-      BlobEntry b mode -> do-        bl <- loadObject b t-        for bl $ \x -> return $ BlobEntry (ObjRef x) mode-      TreeEntry t' -> do-        tr <- loadObject t' t-        for tr $ \x -> return $ TreeEntry (ObjRef x)--  -- Prelude.putStrLn $ "Result: " ++ show y-  -- Prelude.putStrLn $ "Names: " ++ show names-  if null names-    then return y-    else-      case y of-        Just (BlobEntry {}) -> throw TreeCannotTraverseBlob-        Just (TreeEntry (ObjRef t')) -> doLookupTreeEntry t' names-        _ -> return Nothing--lookupTreeEntry :: Tree -> FilePath -> IO (Maybe TreeEntry)-lookupTreeEntry tr = doLookupTreeEntry tr . splitPath--withGitTree :: Updatable b-            => ObjRef Tree -> b -> (Ptr C'git_tree -> IO a) -> IO a-withGitTree tref obj f =-  withForeignPtr (repositoryPtr (objectRepo obj)) $ \repoPtr ->-    case tref of-      IdRef (COid oid) -> withGitTreeOid repoPtr oid--      ObjRef (Tree { treeInfo = Base { gitId = Stored (COid oid) } }) ->-        withGitTreeOid repoPtr oid--      ObjRef (Tree { treeInfo = Base { gitObj = Just t } }) ->-        withForeignPtr t (f . castPtr)--      ObjRef t -> do t' <- update t-                     withGitTree (ObjRef t') obj f--  where withGitTreeOid repoPtr oid =-          withForeignPtr oid $ \tree_id ->-            alloca $ \ptr -> do-              r <- c'git_tree_lookup ptr repoPtr tree_id-              when (r < 0) $ throwIO TreeLookupFailed-              f =<< peek ptr---- | Write out a tree to its repository.  If it has already been written,---   nothing will happen.-writeTree :: Tree -> IO Tree-writeTree t@(Tree { treeInfo = Base { gitId = Stored _ } }) = return t-writeTree t = fst <$> doWriteTree t--doWriteTree :: Tree -> IO (Tree, COid)-doWriteTree t = alloca $ \ptr ->-  withForeignPtr (repoObj (gitRepo (treeInfo t))) $ \repoPtr -> do-    r <- c'git_treebuilder_create ptr nullPtr-    when (r < 0) $ throwIO TreeBuilderCreateFailed-    builder <- peek ptr--    -- jww (2012-10-14): With the loose object backend, there should be no-    -- race conditions here as there will never be a request to access the-    -- same file by multiple threads.  If that ever does happen, or if this-    -- code is changed to write to the packed object backend, simply change-    -- the function 'parallel' to 'sequence' here.-    oids <- parallel $-           flip map (M.toList (treeContents t)) $ \(k, v) ->-             case v of-               BlobEntry bl exe ->-                 withObject bl t $ \bl' -> do-                   bl'' <- update bl'-                   (Oid coid) <- objectId bl''-                   return (k, BlobEntry (ObjRef bl'') exe, coid,-                           if exe then 0o100755 else 0o100644)-               TreeEntry tr ->-                 withObject tr t $ \tr' -> do-                   tr'' <- update tr'-                   (Oid coid) <- objectId tr''-                   return (k, TreeEntry (ObjRef tr''), coid, 0o040000)--    newList <- for oids $ \(k, entry, coid, flags) -> do-                insertObject builder k coid flags-                return (k, entry)--    coid <- mallocForeignPtr-    withForeignPtr coid $ \coid' -> do-      r3 <- c'git_treebuilder_write coid' repoPtr builder-      when (r3 < 0) $ throwIO TreeBuilderWriteFailed--    return (t { treeInfo     = (treeInfo t) { gitId = Stored (COid coid) }-              , treeContents = M.fromList newList }, COid coid)--  where-    insertObject :: (CStringable a)-                 => Ptr C'git_treebuilder -> a -> COid -> CUInt -> IO ()-    insertObject builder key (COid coid) attrs =-      withForeignPtr coid $ \coid' ->-        withCStringable key $ \name -> do-          r2 <- c'git_treebuilder_insert nullPtr builder name coid' attrs-          when (r2 < 0) $ throwIO TreeBuilderInsertFailed--doModifyTree-  :: [Text] -> (Maybe TreeEntry -> Either a (Maybe TreeEntry)) -> Bool-  -> Tree -> IO (Either a Tree)-doModifyTree [] _ _ _     = throw TreeLookupFailed-doModifyTree (name:names) f createIfNotExist t = do-  -- Lookup the current name in this tree.  If it doesn't exist, and there are-  -- more names in the path and 'createIfNotExist' is True, create a new Tree-  -- and descend into it.  Otherwise, if it exists we'll have @Just (TreeEntry-  -- {})@, and if not we'll have Nothing.-  y <- case M.lookup name (treeContents t) of-    Nothing ->-      return $-        if createIfNotExist && not (null names)-        then Just . TreeEntry . ObjRef . createTree-             $ gitRepo (treeInfo t)-        else Nothing-    Just j -> case j of-      BlobEntry b mode -> do-        bl <- loadObject b t-        for bl $ \x -> return $ BlobEntry (ObjRef x) mode-      TreeEntry t' -> do-        tr <- loadObject t' t-        for tr $ \x -> return $ TreeEntry (ObjRef x)--  if null names-    then do-      -- If there are no further names in the path, call the transformer-      -- function, f.  It receives a @Maybe TreeEntry@ to indicate if there-      -- was a previous entry at this path.  It should return a 'Left' value-      -- to propagate out a user-defined error, or a @Maybe TreeEntry@ to-      -- indicate whether the entry at this path should be deleted or-      -- replaced with something new.-      ---      -- NOTE: There is no provision for leaving the entry unchanged!  It is-      -- assumed to always be changed, as we have no reliable method of-      -- testing object equality that is not O(n).-    let ze = f y-    case ze of-      Left err -> return $ Left err-      Right z ->-        return $ Right $-          t { treeInfo     = newTreeBase t-            , treeContents =-              case z of-                Nothing -> M.delete name (treeContents t)-                Just z' -> M.insert name z' (treeContents t) }--    else-      -- If there are further names in the path, descend them now.  If-      -- 'createIfNotExist' was False and there is no 'Tree' under the-      -- current name, or if we encountered a 'Blob' when a 'Tree' was-      -- required, throw an exception to avoid colliding with user-defined-      -- 'Left' values.-      case y of-        Just (BlobEntry {}) -> throw TreeCannotTraverseBlob-        Just (TreeEntry (ObjRef t')) -> do-          st <- doModifyTree names f createIfNotExist t'-          case st of-            err@(Left _) -> return err-            Right st' ->-              return $ Right $-                t { treeInfo     = newTreeBase t-                  , treeContents =-                    if M.null (treeContents st')-                    then M.delete name (treeContents t)-                    else M.insert name (TreeEntry (ObjRef st'))-                                  (treeContents t) }-        _ -> throw TreeLookupFailed--modifyTree-  :: FilePath -> (Maybe TreeEntry -> Either a (Maybe TreeEntry)) -> Bool-  -> Tree -> IO (Either a Tree)-modifyTree = doModifyTree . splitPath--doUpdateTree :: Tree -> [Text] -> TreeEntry -> IO Tree-doUpdateTree t xs item = do-  t' <- doModifyTree xs (const (Right (Just item))) True t-  case t' of-    Right tr -> return tr-    _ -> throwIO TreeUpdateFailed--updateTree :: Tree -> FilePath -> TreeEntry -> IO Tree-updateTree tr = doUpdateTree tr . splitPath--removeFromTree :: FilePath -> Tree -> IO Tree-removeFromTree p tr = do-  t' <- modifyTree p (const (Right Nothing)) False tr-  case t' of-    Right tr' -> return tr'-    _ -> throwIO TreeUpdateFailed--splitPath :: FilePath -> [Text]-splitPath path = T.splitOn "/" text-  where text = case F.toText path of-                 Left x  -> error $ "Invalid path: " ++ T.unpack x-                 Right y -> y---- Tree.hs

@@ -1,87 +0,0 @@-{-| This module provides a brief introductory tutorial in the \"Introduction\"-    section followed by a lengthy discussion of the library's design and idioms.--}--module Data.Git.Tutorial-       (-         -- * Introduction-         -- $intro--         -- * Repositories-         -- $repositories--         -- * References-         -- $references--         -- * Commits-         -- $commits-       ) where--{- $intro--   The @gitlib@ library provides high-level types for working with the-   @libgit2@ C library (<http://libgit2.github.com>).  The intention is to-   make @libgit2@ easier and more type-safe, while using laziness to avoid-   unnecessary work.--}--{- $repositories--   Every use of @gitlib@ must begin with a 'Data.Git.Repository' object.  At-   the moment each 'Repository' must be associated with a local directory,-   even if the Git objects are kept elsewhere via a custom backend (see-   <https://github.com/libgit2/libgit2/issues/1213>).--   If no 'Repository' exists yet, use 'Data.Git.Repository.createRepository';-   if one does exist, use 'Data.Git.Repository.openRepository'; or, you can-   use 'Data.Git.Repository.openOrCreateRepository'.  For example:--> repo <- openOrCreateRepository path False -- False here means "not bare"-> ... make use of the repository ...--   Note that the 'path' variable here is of type 'Filesystem.Path.FilePath',-   since @gitlib@ almost never uses the 'String' type.--}--{- $references--   If you are working with an existing repository, probably the first thing-   you'll want to do is resolve a reference so that you can lookup a commit:--> repo   <- openOrCreateRepository path False-> ref    <- resolveRef repo "HEAD"-> commit <- maybe (return Nothing) (lookupCommit repo) ref--   'resolveRef' works for both symbolic and specific refs.  Further, this-   pattern is rather common, so there is a shortcut called-   'Data.Git.Commit.lookupRefCommit'.  Or, if you have a SHA string, you can-   use 'Data.Git.Commit.lookupCommit' with 'Data.Git.Oid.parseOid'.--> repo          <- openOrCreateRepository path False-> commitFromRef <- lookupRefCommit repo "HEAD"             :: Maybe Commit-> commitFromSHA <- lookupCommit repo (parseOid "f7acdbed") :: Maybe Commit---}--{- $commits--   If you don't have a commit object, the recommend way to create one is by-   creating a 'Data.Git.Common.Signature' and using it to modify the return-   value from 'Data.Git.Commit.create'.  This requires a 'Repository' object:--> now <- getCurrentTime-> let sig = Signature {->               signatureName  = "John Smith"->             , signatureEmail = "johnsmith@nowhere.org"->             , signatureWhen  = now }->     c   = (createCommit repo) {->             , commitAuthor    = sig->             , commitCommitter = sig }->             --   Load a 'Data.Git.Commit.Commit', and thereafter its history through its-      parents, or load a 'Data.Git.Tree.Tree' or 'Data.Git.Blob.Blob' from-      its contents.--   3. Construct a new commit--}

@@ -0,0 +1,577 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-}++-- | Interface for working with Git repositories.+module Git where++import           Control.Applicative+import qualified Control.Exception.Lifted as Exc+import           Control.Failure+import           Control.Monad+import           Control.Monad.IO.Class+import           Control.Monad.Trans.Class+import           Data.ByteString (ByteString)+import           Data.Conduit+import           Data.Default+import           Data.Map (Map)+import           Data.Maybe+import           Data.Tagged+import           Data.Text (Text)+import qualified Data.Text as T+import           Data.Time+import           Data.Typeable+import           Filesystem.Path.CurrentOS+import           Prelude hiding (FilePath)+import           System.Mem (performGC)++{- $repositories -}+data RepositoryFacts = RepositoryFacts+    { hasSymbolicReferences :: !Bool+    } deriving Show++type MonadGit m = (Failure Git.GitException m, Applicative m,+                   MonadIO m, MonadBaseControl IO m)++-- | 'Repository' is the central point of contact between user code and+-- Git data objects.  Every object must belong to some repository.+class (Applicative m, Monad m, Failure GitException m,+       Eq (Oid m), Ord (Oid m), Show (Oid m)) => Repository m where+    data Oid m+    data TreeData m+    data Options m++    facts :: m RepositoryFacts++    parseOid  :: Text -> m (Oid m)+    renderOid :: Oid m -> Text+    renderOid = renderObjOid . Tagged+    renderObjOid :: Tagged a (Oid m) -> Text+    renderObjOid = renderOid . unTagged++    -- References+    createRef  :: Text -> RefTarget m (Commit m) -> m (Reference m (Commit m))+    createRef_ :: Text -> RefTarget m (Commit m) -> m ()+    createRef_ = (void .) . createRef+    lookupRef  :: Text -> m (Maybe (Reference m (Commit m)))+    updateRef  :: Text -> RefTarget m (Commit m) -> m (Reference m (Commit m))+    updateRef_ :: Text -> RefTarget m (Commit m) -> m ()+    updateRef_ = (void .) . updateRef+    deleteRef  :: Text -> m ()++    allRefs :: m [Reference m (Commit m)]+    allRefs = catMaybes <$> (mapM lookupRef =<< allRefNames)++    allRefNames :: m [Text]+    allRefNames = map refName <$> allRefs++    resolveRef :: Text -> m (Maybe (CommitRef m))+    resolveRef name = lookupRef name >>= referenceToRef (Just name)++    -- Lookup+    lookupCommit :: CommitOid m -> m (Commit m)+    lookupTree   :: TreeOid m -> m (Tree m)+    lookupBlob   :: BlobOid m -> m (Blob m)+    lookupTag    :: TagOid m -> m (Tag m)++    lookupObject :: Text -> m (Object m)+    existsObject :: Oid m -> m Bool++    traverseObjects :: forall a.+                       (Object m -> m a) -> Maybe (CommitName m) -> m [a]+    traverseObjects_ :: (Object m -> m ()) -> Maybe (CommitName m) -> m ()+    traverseObjects_ = (void .) . traverseObjects++    pushCommit :: (MonadTrans t, MonadGit m, MonadGit (t m),+                   Repository m, Repository (t m))+               => CommitName m -> Maybe Text -> Text+               -> t m (CommitRef (t m))++    traverseCommits :: forall a.+                       (CommitRef m -> m a) -> CommitName m -> m [a]+    traverseCommits_ :: (CommitRef m -> m ()) -> CommitName m -> m ()+    traverseCommits_ = (void .) . traverseCommits++    missingObjects :: Maybe (CommitName m) -- ^ A commit we may already have+                   -> CommitName m         -- ^ The commit we need+                   -> m [Object m]         -- ^ All the objects in between++    -- Object creation+    newTree :: m (Tree m)+    hashContents :: BlobContents m -> m (BlobOid m)+    createBlob   :: BlobContents m -> m (BlobOid m)+    createCommit :: [CommitRef m] -> TreeRef m+                 -> Signature -> Signature -> Text -> Maybe Text -> m (Commit m)+    createTag :: CommitOid m -> Signature -> Text -> Text -> m (Tag m)++    deleteRepository :: m ()++    -- Pack files+    buildPackFile :: FilePath -> [Either (CommitOid m) (TreeOid m)]+                  -> m FilePath+    buildPackFile _ _ =+        failure (BackendError "Backend does not support building pack files")++    buildPackIndex :: FilePath -> ByteString -> m (Text, FilePath, FilePath)+    buildPackIndex _ _ =+        failure (BackendError "Backend does not support building pack indexes")++    writePackFile :: FilePath -> m ()+    writePackFile _ =+        failure (BackendError "Backend does not support writing  pack files")++    -- Git remotes+    remoteFetch :: Text {- URI -} -> Text {- fetch spec -} -> m ()++{- $exceptions -}+-- | There is a separate 'GitException' for each possible failure when+--   interacting with the Git repository.+data GitException = BackendError Text+                  | GitError Text+                  | RepositoryNotExist+                  | RepositoryInvalid+                  | RepositoryCannotAccess Text+                  | BlobCreateFailed+                  | BlobEmptyCreateFailed+                  | BlobEncodingUnknown Text+                  | BlobLookupFailed+                  | PushNotFastForward Text+                  | TranslationException Text+                  | TreeCreateFailed Text+                  | TreeBuilderCreateFailed+                  | TreeBuilderInsertFailed Text+                  | TreeBuilderRemoveFailed Text+                  | TreeBuilderWriteFailed Text+                  | TreeLookupFailed+                  | TreeCannotTraverseBlob+                  | TreeCannotTraverseCommit+                  | TreeEntryLookupFailed FilePath+                  | TreeUpdateFailed+                  | TreeWalkFailed+                  | CommitCreateFailed+                  | CommitLookupFailed Text+                  | ReferenceCreateFailed+                  | ReferenceDeleteFailed Text+                  | RefCannotCreateFromPartialOid+                  | ReferenceListingFailed+                  | ReferenceLookupFailed Text+                  | ObjectLookupFailed Text Int+                  | ObjectRefRequiresFullOid+                  | OidCopyFailed+                  | OidParseFailed Text+                  | QuotaHardLimitExceeded Int Int+                  deriving (Eq, Show, Typeable)++-- jww (2013-02-11): Create a BackendException data constructor of forall+-- e. Exception e => BackendException e, so that each can throw a derived+-- exception.+instance Exc.Exception GitException++{- $oids -}+type BlobOid m   = Tagged (Blob m) (Oid m)+type TreeOid m   = Tagged (Tree m) (Oid m)+type CommitOid m = Tagged (Commit m) (Oid m)+type TagOid m    = Tagged (Tag m) (Oid m)++{- $references -}+data RefTarget m a = RefObj !(ObjRef m a) | RefSymbolic !Text++data Reference m a = Reference+    { refName   :: !Text+    , refTarget :: !(RefTarget m a) }++data CommitName m = CommitObjectId !(CommitOid m)+                  | CommitRefName !Text+                  | CommitReference !(Reference m (Commit m))++instance Repository m => Show (CommitName m) where+    show (CommitObjectId coid) = T.unpack (renderObjOid coid)+    show (CommitRefName name)  = show name+    show (CommitReference ref) = show (refName ref)++nameOfCommit :: Commit m -> CommitName m+nameOfCommit = CommitObjectId . commitOid++commitNameToRef :: Repository m => CommitName m -> m (Maybe (CommitRef m))+commitNameToRef (CommitObjectId coid) = return (Just (ByOid coid))+commitNameToRef (CommitRefName name)  = resolveRef name+commitNameToRef (CommitReference ref) = referenceToRef Nothing (Just ref)++renderCommitName :: Repository m => CommitName m -> Text+renderCommitName (CommitObjectId coid) = renderObjOid coid+renderCommitName (CommitRefName name)  = name+renderCommitName (CommitReference ref) = refName ref++copyOid :: (Repository m, MonadGit m, Repository n, MonadGit n)+        => Oid m -> n (Oid n)+copyOid = parseOid . renderOid++copyCommitOid :: (Repository m, MonadGit m, Repository n, MonadGit n)+              => CommitOid m -> n (CommitOid n)+copyCommitOid coid = do+    ncoid <- parseOid (renderObjOid coid)+    return (Tagged ncoid)++copyCommitName :: (Repository m, MonadGit m, Repository n, MonadGit n)+               => CommitName m -> n (Maybe (CommitName n))+copyCommitName (CommitObjectId coid) =+    Just . CommitObjectId . Tagged <$> parseOid (renderObjOid coid)+copyCommitName (CommitRefName name) = return (Just (CommitRefName name))+copyCommitName (CommitReference ref) =+    fmap CommitReference <$> lookupRef (refName ref)++{- $objects -}+data ObjRef m a = ByOid !(Tagged a (Oid m)) | Known !a++type BlobRef m   = ObjRef m (Blob m)+type TreeRef m   = ObjRef m (Tree m)+type CommitRef m = ObjRef m (Commit m)+type TagRef m    = ObjRef m (Tag m)++data Object m = BlobObj      !(BlobRef m)+              | TreeObj      !(TreeRef m)+              | CommitObj    !(CommitRef m)+              | TagObj       !(TagRef m)++objectOid :: Repository m => Object m -> m (Oid m)+objectOid (BlobObj ref)   = return . unTagged $ blobRefOid ref+objectOid (TreeObj ref)   = unTagged <$> treeRefOid ref+objectOid (CommitObj ref) = return . unTagged $ commitRefOid ref+objectOid (TagObj ref)    = return . unTagged $ tagRefOid ref++{- $blobs -}+data Blob m = Blob { blobOid      :: !(BlobOid m)+                   , blobContents :: !(BlobContents m) }++blobRefOid :: Repository m => BlobRef m -> BlobOid m+blobRefOid (ByOid oid) = oid+blobRefOid (Known (Blob {..})) = blobOid++resolveBlobRef :: Repository m => BlobRef m -> m (Blob m)+resolveBlobRef (ByOid oid) = lookupBlob oid+resolveBlobRef (Known obj) = return obj++type ByteSource m = Producer m ByteString++data BlobContents m = BlobString !ByteString+                    | BlobStream !(ByteSource m)+                    | BlobSizedStream !(ByteSource m) !Int++data BlobKind = PlainBlob | ExecutableBlob | SymlinkBlob | UnknownBlob+              deriving (Show, Eq, Enum)++instance Eq (BlobContents m) where+  BlobString str1 == BlobString str2 = str1 == str2+  _ == _ = False++{- $trees -}+data TreeEntry m = BlobEntry   { blobEntryOid   :: !(BlobOid m)+                               , blobEntryKind  :: !BlobKind }+                 | TreeEntry   { treeEntryRef   :: !(TreeRef m) }+                 | CommitEntry { commitEntryRef :: !(CommitOid m) }++treeEntryOid :: Repository m => TreeEntry m -> m (Oid m)+treeEntryOid (BlobEntry boid _) = return $ unTagged boid+treeEntryOid (TreeEntry tref)   = unTagged <$> treeRefOid tref+treeEntryOid (CommitEntry coid) = return $ unTagged coid++blobEntry :: Repository m => BlobOid m -> BlobKind -> TreeEntry m+blobEntry = BlobEntry++treeEntry :: Repository m => Tree m -> TreeEntry m+treeEntry = TreeEntry . treeRef++commitEntry :: Repository m => Commit m -> TreeEntry m+commitEntry = CommitEntry . commitOid++data ModifyTreeResult m = TreeEntryNotFound+                        | TreeEntryDeleted+                        | TreeEntryPersistent (TreeEntry m)+                        | TreeEntryMutated (TreeEntry m)++fromModifyTreeResult :: ModifyTreeResult m -> Maybe (TreeEntry m)+fromModifyTreeResult TreeEntryNotFound = Nothing+fromModifyTreeResult TreeEntryDeleted = Nothing+fromModifyTreeResult (TreeEntryPersistent x) = Just x+fromModifyTreeResult (TreeEntryMutated x) = Just x++toModifyTreeResult :: (TreeEntry m -> ModifyTreeResult m)+                   -> Maybe (TreeEntry m)+                   -> ModifyTreeResult m+toModifyTreeResult _ Nothing  = TreeEntryNotFound+toModifyTreeResult f (Just x) = f x++-- | A 'Tree' is anything that is "treeish".+--+-- Minimal complete definition: 'modifyTree'.  Note that for some treeish+-- things, like Tags, it should always be an error to attempt to modify the+-- tree in any way.+data Tree m = Tree+    { modifyTree :: FilePath    -- path within the tree+                 -> Bool        -- create subtree's leading up to path?+                 -> (Maybe (TreeEntry m) -> m (ModifyTreeResult m))+                 -> m (Maybe (TreeEntry m))++    , lookupEntry      :: FilePath -> m (Maybe (TreeEntry m))+    , putTreeEntry     :: FilePath -> TreeEntry m -> m ()+    , putBlob'         :: FilePath -> BlobOid m -> BlobKind -> m ()+    , putBlob          :: FilePath -> BlobOid m -> m ()+    , putTree          :: FilePath -> TreeRef m -> m ()+    , putCommit        :: FilePath -> CommitOid m -> m ()+    , dropFromTree     :: FilePath -> m ()+    , writeTree        :: m (TreeOid m)+    , traverseEntries  :: forall a. (FilePath -> TreeEntry m -> m a) -> m [a]+    , traverseEntries_ :: (FilePath -> TreeEntry m -> m ()) -> m ()+    , getTreeData      :: !(TreeData m)+    }++mkTree :: Repository m+       => (Tree m+           -> FilePath           -- path within the tree+           -> Bool               -- create subtree's leading up to path?+           -> (Maybe (TreeEntry m) -> m (ModifyTreeResult m))+           -> m (Maybe (TreeEntry m)))+       -> (Tree m -> m (TreeOid m))+       -> (forall a. Tree m -> (FilePath -> TreeEntry m -> m a) -> m [a])+       -> TreeData m+       -> Tree m+mkTree modifyTree' writeTree' traverseEntries' treeData = tr+  where+    tr = Tree+        { modifyTree       = modifyTree' tr+        , lookupEntry      =+            \path -> modifyTree' tr path False+                     (return . toModifyTreeResult TreeEntryPersistent)+        , putTreeEntry     = \path ent ->+                                 void $ modifyTree' tr path True+                                     (const (return (TreeEntryMutated ent)))+        , putBlob'         = \path b kind ->+                                 putTreeEntry tr path (BlobEntry b kind)+        , putBlob          = \path b   -> putBlob' tr path b PlainBlob+        , putTree          = \path tr' -> putTreeEntry tr path (TreeEntry tr')+        , putCommit        = \path c   -> putTreeEntry tr path (CommitEntry c)+        , dropFromTree     = \path ->+                                 void $ modifyTree' tr path False+                                     (const (return TreeEntryDeleted))+        , writeTree        = writeTree' tr+        , traverseEntries  = traverseEntries' tr+        , traverseEntries_ = void . traverseEntries' tr+        , getTreeData      = treeData+        }++treeRef :: Tree m -> TreeRef m+treeRef = Known++treeRefOid :: Repository m => TreeRef m -> m (TreeOid m)+treeRefOid (ByOid x) = return x+treeRefOid (Known x) = writeTree x++resolveTreeRef :: Repository m => TreeRef m -> m (Tree m)+resolveTreeRef (ByOid oid) = lookupTree oid+resolveTreeRef (Known obj) = return obj++{- $commits -}+data Signature = Signature+    { signatureName  :: !Text+    , signatureEmail :: !Text+    , signatureWhen  :: !ZonedTime+    } deriving Show++instance Default Signature where+    def = Signature+        { signatureName  = T.empty+        , signatureEmail = T.empty+        , signatureWhen  = ZonedTime+            { zonedTimeToLocalTime = LocalTime+                { localDay = ModifiedJulianDay 0+                , localTimeOfDay = TimeOfDay 0 0 0+                }+            , zonedTimeZone = utc+            }+        }++data Commit m = Commit+    { commitOid       :: !(CommitOid m)+    , commitParents   :: ![CommitRef m]+    , commitTree      :: !(TreeRef m)+    , commitAuthor    :: !Signature+    , commitCommitter :: !Signature+    , commitLog       :: !Text+    , commitEncoding  :: !Text+    }++commitRef :: Commit m -> CommitRef m+commitRef = Known++commitRefTarget :: Commit c -> RefTarget m (Commit c)+commitRefTarget = RefObj . Known++commitRefOid :: Repository m => CommitRef m -> CommitOid m+commitRefOid (ByOid x) = x+commitRefOid (Known x) = commitOid x++resolveCommitRef :: Repository m => CommitRef m -> m (Commit m)+resolveCommitRef (ByOid oid) = lookupCommit oid+resolveCommitRef (Known obj) = return obj++referenceToRef :: Repository m+               => Maybe Text -> Maybe (Reference m (Commit m))+               -> m (Maybe (CommitRef m))+referenceToRef mname mref =+    case mref of+        Nothing -> return Nothing+        Just (Reference { refTarget = RefObj x }) ->+            return (Just x)+        Just ref@(Reference { refTarget = RefSymbolic name' }) ->+            if fromMaybe name' mname /= name'+            then resolveRef name'+            else failure (ReferenceLookupFailed (refName ref))++{- $tags -}++data Tag m = Tag+    { tagOid    :: !(TagOid m)+    , tagCommit :: !(CommitRef m)+    }++tagRefOid :: Repository m => TagRef m -> TagOid m+tagRefOid (ByOid x) = x+tagRefOid (Known x) = tagOid x++{- $merges -}++data ModificationKind = Unchanged | Modified | Added | Deleted | TypeChanged+                      deriving (Eq, Ord, Enum, Show, Read)++data MergeStatus+    = NoConflict+    | BothModified+    | LeftModifiedRightDeleted+    | LeftDeletedRightModified+    | BothAdded+    | LeftModifiedRightTypeChanged+    | LeftTypeChangedRightModified+    | LeftDeletedRightTypeChanged+    | LeftTypeChangedRightDeleted+    | BothTypeChanged+    deriving (Eq, Ord, Enum, Show, Read)++mergeStatus :: ModificationKind -> ModificationKind -> MergeStatus+mergeStatus Unchanged Unchanged     = NoConflict+mergeStatus Unchanged Modified      = NoConflict+mergeStatus Unchanged Added         = undefined+mergeStatus Unchanged Deleted       = NoConflict+mergeStatus Unchanged TypeChanged   = NoConflict++mergeStatus Modified Unchanged      = NoConflict+mergeStatus Modified Modified       = BothModified+mergeStatus Modified Added          = undefined+mergeStatus Modified Deleted        = LeftModifiedRightDeleted+mergeStatus Modified TypeChanged    = LeftModifiedRightTypeChanged++mergeStatus Added Unchanged         = undefined+mergeStatus Added Modified          = undefined+mergeStatus Added Added             = BothAdded+mergeStatus Added Deleted           = undefined+mergeStatus Added TypeChanged       = undefined++mergeStatus Deleted Unchanged       = NoConflict+mergeStatus Deleted Modified        = LeftDeletedRightModified+mergeStatus Deleted Added           = undefined+mergeStatus Deleted Deleted         = NoConflict+mergeStatus Deleted TypeChanged     = LeftDeletedRightTypeChanged++mergeStatus TypeChanged Unchanged   = NoConflict+mergeStatus TypeChanged Modified    = LeftTypeChangedRightModified+mergeStatus TypeChanged Added       = undefined+mergeStatus TypeChanged Deleted     = LeftTypeChangedRightDeleted+mergeStatus TypeChanged TypeChanged = BothTypeChanged++data MergeResult m+    = MergeSuccess+        { mergeCommit    :: CommitOid m+        }+    | MergeConflicted+        { mergeCommit    :: CommitOid m+        , mergeHeadLeft  :: CommitOid m+        , mergeHeadRight :: CommitOid m+        , mergeConflicts :: Map FilePath (ModificationKind, ModificationKind)+        }++instance Repository m => Show (MergeResult m) where+    show (MergeSuccess mc) = "MergeSuccess (" ++ show mc ++ ")"+    show (MergeConflicted mc hl hr cs) =+        "MergeResult"+     ++ "\n    { mergeCommit    = " ++ show mc+     ++ "\n    , mergeHeadLeft  = " ++ show hl+     ++ "\n    , mergeHeadRight = " ++ show hr+     ++ "\n    , mergeConflicts = " ++ show cs+     ++ "\n    }"++copyConflict :: (Repository m, MonadGit m, Repository n, MonadGit n)+             => MergeResult m -> n (MergeResult n)+copyConflict (MergeSuccess mc) =+    MergeSuccess <$> (Tagged <$> parseOid (renderObjOid mc))+copyConflict (MergeConflicted hl hr mc cs) =+    MergeConflicted <$> (Tagged <$> parseOid (renderObjOid hl))+                    <*> (Tagged <$> parseOid (renderObjOid hr))+                    <*> (Tagged <$> parseOid (renderObjOid mc))+                    <*> pure cs++{- $miscellaneous -}++data RepositoryOptions = RepositoryOptions+    { repoPath       :: !FilePath+    , repoIsBare     :: !Bool+    , repoAutoCreate :: !Bool+    }++instance Default RepositoryOptions where+    def = RepositoryOptions "" True True++data RepositoryFactory t m c = RepositoryFactory+    { openRepository  :: RepositoryOptions -> m c+    , runRepository   :: forall a. c -> t m a -> m a+    , closeRepository :: c -> m ()+    , getRepository   :: t m c+    , defaultOptions  :: !RepositoryOptions+    , startupBackend  :: m ()+    , shutdownBackend :: m ()+    }++withBackendDo :: (MonadIO m, MonadBaseControl IO m)+              => RepositoryFactory t m a -> m b -> m b+withBackendDo fact f = do+    startupBackend fact+    Exc.finally f (liftIO performGC >> shutdownBackend fact)++withRepository' :: (Repository (t m), MonadTrans t,+                    MonadBaseControl IO m, MonadIO m)+                => RepositoryFactory t m c+                -> RepositoryOptions+                -> t m a+                -> m a+withRepository' factory opts action =+    Exc.bracket+        (openRepository factory opts)+        (closeRepository factory)+        (flip (runRepository factory) action)++withRepository :: (Repository (t m), MonadTrans t,+                   MonadBaseControl IO m, MonadIO m)+               => RepositoryFactory t m c+               -> FilePath+               -> t m a+               -> m a+withRepository factory path =+    withRepository' factory+        (defaultOptions factory) { repoPath = path }++-- Git.hs

@@ -0,0 +1,87 @@+{-| This module provides a brief introductory tutorial in the \"Introduction\"+    section followed by a lengthy discussion of the library's design and idioms.+-}++module Git.Tutorial+       (+         -- * Introduction+         -- $intro++         -- * Repositories+         -- $repositories++         -- * References+         -- $references++         -- * Commits+         -- $commits+       ) where++{- $intro++   The @gitlib@ library provides high-level types for working with the+   @libgit2@ C library (<http://libgit2.github.com>).  The intention is to+   make @libgit2@ easier and more type-safe, while using laziness to avoid+   unnecessary work.+-}++{- $repositories++   Every use of @gitlib@ must begin with a 'Git.Libgit2.Repository' object.  At+   the moment each 'Repository' must be associated with a local directory,+   even if the Git objects are kept elsewhere via a custom backend (see+   <https://github.com/libgit2/libgit2/issues/1213>).++   If no 'Repository' exists yet, use 'Git.Libgit2.Repository.createRepository';+   if one does exist, use 'Git.Libgit2.Repository.openRepository'; or, you can+   use 'Git.Libgit2.Repository.openOrCreateRepository'.  For example:++> repo <- openOrCreateRepository path False -- False here means "not bare"+> ... make use of the repository ...++   Note that the 'path' variable here is of type 'Filesystem.Path.FilePath',+   since @gitlib@ almost never uses the 'String' type.+-}++{- $references++   If you are working with an existing repository, probably the first thing+   you'll want to do is resolve a reference so that you can lookup a commit:++> repo   <- openOrCreateRepository path False+> ref    <- resolveRef repo "HEAD"+> commit <- maybe (return Nothing) (lookupCommit repo) ref++   'resolveRef' works for both symbolic and specific refs.  Further, this+   pattern is rather common, so there is a shortcut called+   'Git.Libgit2.Commit.lookupRefCommit'.  Or, if you have a SHA string, you can+   use 'Git.Libgit2.Commit.lookupCommit' with 'Git.Libgit2.Oid.parseOid'.++> repo          <- openOrCreateRepository path False+> commitFromRef <- lookupRefCommit repo "HEAD"             :: Maybe Commit+> commitFromSHA <- lookupCommit repo (parseOid "f7acdbed") :: Maybe Commit++-}++{- $commits++   If you don't have a commit object, the recommend way to create one is by+   creating a 'Git.Libgit2.Common.Signature' and using it to modify the return+   value from 'Git.Libgit2.Commit.create'.  This requires a 'Repository' object:++> now <- getCurrentTime+> let sig = Signature {+>               signatureName  = "John Smith"+>             , signatureEmail = "johnsmith@nowhere.org"+>             , signatureWhen  = now }+>     c   = (createCommit repo) {+>             , commitAuthor    = sig+>             , commitCommitter = sig }+>             ++   Load a 'Git.Libgit2.Commit.Commit', and thereafter its history through its+      parents, or load a 'Git.Libgit2.Tree.Tree' or 'Git.Libgit2.Blob.Blob' from+      its contents.++   3. Construct a new commit+-}

@@ -1,6 +1,6 @@ Name:                gitlib-Version:             0.7.0-Synopsis:            Higher-level types for working with hlibgit2+Version:             1.0.1+Synopsis:            API library for working with Git repositories License-file:        LICENSE License:             MIT Author:              John Wiegley@@ -9,80 +9,48 @@ Cabal-Version:       >=1.10 Category:            FFI Description:-  @gitlib@ is a high-level, lazy and conduit-aware type wrapper around the-  libgit2 C library (<http://libgit2.github.com>).  The aim is both-  type-safety and convenience of use for Haskell users, combined with high-  performance and minimal memory footprint by taking advantage of Haskell's-  laziness and the conduit library's deterministic resource cleanup.+  @gitlib@ is a high-level, lazy and conduit-aware set of abstractions for+  programming with Git types.  Several different backends are available,+  including one for the libgit2 C library (<http://libgit2.github.com>) (see+  @gitlib-libgit2@).  The aim is both type-safety and convenience of use for+  Haskell users, combined with high performance and minimal memory footprint+  by taking advantage of Haskell's laziness and the conduit library's+  deterministic resource cleanup.   .-  For further information, as well as typical use cases, see-  "Data.Git.Tutorial".+  For further information, as well as typical use cases, see "Git.Tutorial".  Source-repository head   type: git   location: git://github.com/fpco/gitlib.git -Test-suite smoke-  Default-language: Haskell98-  Type: exitcode-stdio-1.0-  Main-is: Smoke.hs-  Hs-source-dirs: test-  Build-depends: base >=3-    , gitlib-    , hlibgit2        >= 0.17-    , HUnit           >= 1.2.5-    , bytestring      >= 0.9.2.1-    , containers      >= 0.4.2-    , lens            >= 2.8-    , parallel-io     >= 0.3.2.1-    , stringable      >= 0.1.1-    , system-fileio   >= 0.3.9-    , system-filepath >= 0.4.7-    , text            >= 0.11.2-    , time            >= 1.4- Test-suite doctests-  Default-language: Haskell98-  Type:    exitcode-stdio-1.0-  Main-is: Doctest.hs-  Hs-source-dirs: test-  Build-depends: base == 4.*-    , directory >= 1.0 && < 1.3-    , doctest   >= 0.8 && <= 0.10-    , filepath  >= 1.3 && < 1.4+    Default-language: Haskell98+    Type:    exitcode-stdio-1.0+    Main-is: Doctest.hs+    Hs-source-dirs: test+    Build-depends:      +          base+        , directory    >= 1.0+        , doctest      >= 0.8+        , doctest-prop >= 0.1+        , filepath     >= 1.3  Library-  default-language:   Haskell98-  default-extensions: ForeignFunctionInterface-  build-depends:-      base            >= 3 && < 5-    , hlibgit2        >= 0.17-    , bytestring      >= 0.9.2.1-    , conduit         >= 0.5.5-    , containers      >= 0.4.2-    , lens            >= 2.8-    , parallel-io     >= 0.3.2.1-    , stringable      >= 0.1.1-    , system-fileio   >= 0.3.9-    , system-filepath >= 0.4.7-    , text            >= 0.11.2-    , text-icu        >= 0.6.3-    , time            >= 1.4-  exposed-modules:-    Data.Git-    Data.Git.Backend-    Data.Git.Backend.Trace-    Data.Git.Blob-    Data.Git.Commit-    Data.Git.Common-    Data.Git.Error-    Data.Git.Internal-    Data.Git.Object-    Data.Git.Oid-    Data.Git.Reference-    Data.Git.Repository-    Data.Git.Tag-    Data.Git.Tree-    Data.Git.Tutorial-  -- other-modules:-  --   Data.Git.Internal+    default-language:   Haskell98+    ghc-options: -Wall+    build-depends:+          base                 >= 3 && < 5+        , bytestring           >= 0.9.2.1+        , conduit              >= 1.0.0+        , containers           >= 0.4.2.1+        , data-default         >= 0.5.0+        , failure              >= 0.2.0.1+        , lifted-base          >= 0.2+        , system-filepath      >= 0.4.7+        , tagged               >= 0.2.3.1+        , transformers         >= 0.3.0.0+        , text                 >= 0.11.2+        , time                 >= 1.4+    exposed-modules:+        Git+        Git.Tutorial

@@ -16,11 +16,12 @@   : sources  getSources :: IO [FilePath]-getSources = filter (isSuffixOf ".hs") <$> go "Data/Git"+getSources =+    filter (\n -> ".hs" `isSuffixOf` n && n /= "./Setup.hs") <$> go "."   where     go dir = do       (dirs, files) <- getFilesAndDirectories dir-      (files ++) . concat <$> mapM go dirs+      (files ++) . concat <$> mapM go (filter (not . (== "./test")) dirs)  getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath]) getFilesAndDirectories dir = do

@@ -1,280 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}-{-# OPTIONS_GHC -fno-warn-wrong-do-bind #-}-{-# OPTIONS_GHC -fno-warn-name-shadowing #-}--module Main where--import           Bindings.Libgit2.OdbBackend-import           Control.Applicative-import           Control.Concurrent.ParallelIO-import           Control.Monad-import           Data.Git-import           Data.Git.Backend-import           Data.Git.Backend.Trace-import           Data.Maybe-import           Data.Text as T hiding (map)-import qualified Data.Text.Encoding as E-import           Data.Time.Clock.POSIX-import           Data.Traversable-import           Filesystem (removeTree, isDirectory)-import           Filesystem.Path.CurrentOS-import           Foreign.C.String-import           Foreign.Marshal.Alloc-import           Foreign.Ptr-import           Foreign.Storable-import qualified Prelude-import           Prelude (putStrLn)-import           Prelude hiding (FilePath, putStr, putStrLn)-import           System.Exit-import           Test.HUnit--default (Text)--main :: IO ()-main = do-  counts' <- runTestTT tests-  case counts' of-    Counts _ _ errors' failures' ->-      if errors' > 0 || failures' > 0-      then exitFailure-      else exitSuccess-  stopGlobalPool--catBlob :: Repository -> Text -> IO (Maybe Text)-catBlob repo sha = do-  hash <- parseOid sha-  for hash $ \hash' -> do-    obj <- lookupObject repo hash'-    case obj of-      Just (BlobObj b) -> do-        (_, contents) <- getBlobContents b-        str <- blobSourceToString contents-        case str of-          Nothing   -> return T.empty-          Just str' -> return (E.decodeUtf8 str')--      Just _  -> error "Found something else..."-      Nothing -> error "Didn't find anything :("--withRepository :: Text -> (Repository -> Assertion) -> Assertion-withRepository n f = do-  let p = fromText n-  exists <- isDirectory p-  when exists $ removeTree p--  -- we want exceptions to leave the repo behind-  f =<< createRepository p True--  removeTree p--oid :: Updatable a => a -> IO Text-oid = objectId >=> return . oidToText . Just--oidToText :: Maybe Oid -> Text-oidToText = T.pack . show . fromJust--sampleCommit :: Repository -> Tree -> Signature -> Commit-sampleCommit repo tr sig =-    (createCommit repo sig) { commitTree = ObjRef tr-                            , commitLog  = "Sample log message." }--tests :: Test-tests = test [--  "singleBlob" ~:--  withRepository "singleBlob.git" $ \repo -> do-    update_ $ createBlob repo (E.encodeUtf8 "Hello, world!\n")--    x <- catBlob repo "af5626b4a114abcb82d63db7c8082c3c4756e51b"-    x @?= Just "Hello, world!\n"--    x <- catBlob repo "af5626b"-    x @?= Just "Hello, world!\n"--    return ()--  , "singleTree" ~:--  withRepository "singleTree.git" $ \repo -> do-    let hello = createBlob repo (E.encodeUtf8 "Hello, world!\n")-    tr <- updateTree (createTree repo) "hello/world.txt" (blobRef hello)-    x  <- oid tr-    x @?= "c0c848a2737a6a8533a18e6bd4d04266225e0271"--    return()--  , "twoTrees" ~:--  withRepository "twoTrees.git" $ \repo -> do-    let hello = createBlob repo (E.encodeUtf8 "Hello, world!\n")-    tr <- updateTree (createTree repo) "hello/world.txt" (blobRef hello)-    x  <- oid tr-    x @?= "c0c848a2737a6a8533a18e6bd4d04266225e0271"--    let goodbye = createBlob repo (E.encodeUtf8 "Goodbye, world!\n")-    tr <- updateTree tr "goodbye/files/world.txt" (blobRef goodbye)-    x  <- oid tr-    x @?= "98c3f387f63c08e1ea1019121d623366ff04de7a"--    return()--  , "deleteTree" ~:--  withRepository "deleteTree.git" $ \repo -> do-    let hello = createBlob repo (E.encodeUtf8 "Hello, world!\n")-    tr <- updateTree (createTree repo) "hello/world.txt" (blobRef hello)-    x  <- oid tr-    x @?= "c0c848a2737a6a8533a18e6bd4d04266225e0271"--    let goodbye = createBlob repo (E.encodeUtf8 "Goodbye, world!\n")-    tr <- updateTree tr "goodbye/files/world.txt" (blobRef goodbye)-    x  <- oid tr-    x @?= "98c3f387f63c08e1ea1019121d623366ff04de7a"--    -- Confirm that deleting world.txt also deletes the now-empty subtree-    -- goodbye/files, which also deletes the then-empty subtree goodbye,-    -- returning us back the original tree.-    tr <- removeFromTree "goodbye/files/world.txt" tr-    x  <- oid tr-    x @?= "c0c848a2737a6a8533a18e6bd4d04266225e0271"--    return()--  , "createCommit" ~:--  withRepository "createCommit.git" $ \repo -> do-    let hello = createBlob repo (E.encodeUtf8 "Hello, world!\n")-    tr <- updateTree (createTree repo) "hello/world.txt" (blobRef hello)--    let goodbye = createBlob repo (E.encodeUtf8 "Goodbye, world!\n")-    tr <- updateTree tr "goodbye/files/world.txt" (blobRef goodbye)-    x  <- oid tr-    x @?= "98c3f387f63c08e1ea1019121d623366ff04de7a"--    -- The Oid has been cleared in tr, so this tests that it gets written as-    -- needed.-    let sig  = Signature {-            signatureName  = "John Wiegley"-          , signatureEmail = "johnw@newartisans.com"-          , signatureWhen  = posixSecondsToUTCTime 1348980883 }--    x <- oid $ sampleCommit repo tr sig-    x @?= "44381a5e564d19893d783a5d5c59f9c745155b56"--    return()--  , "createTwoCommits" ~:--  withRepository "createTwoCommits.git" $ \repo -> alloca $ \loosePtr -> do-    withCString "createTwoCommits.git/objects" $ \objectsDir -> do-      r <- c'git_odb_backend_loose loosePtr objectsDir (-1) 0-      when (r < 0) $ error "Failed to create loose objects backend"-    loosePtr' <- peek loosePtr-    backend   <- traceBackend loosePtr'-    odbBackendAdd repo backend 3--    let hello = createBlob repo (E.encodeUtf8 "Hello, world!\n")-    tr <- updateTree (createTree repo) "hello/world.txt" (blobRef hello)--    let goodbye = createBlob repo (E.encodeUtf8 "Goodbye, world!\n")-    tr <- updateTree tr "goodbye/files/world.txt" (blobRef goodbye)-    tr <- update tr-    x  <- oid tr-    x @?= "98c3f387f63c08e1ea1019121d623366ff04de7a"--    -- The Oid has been cleared in tr, so this tests that it gets written as-    -- needed.-    let sig = Signature {-            signatureName  = "John Wiegley"-          , signatureEmail = "johnw@newartisans.com"-          , signatureWhen  = posixSecondsToUTCTime 1348980883 }-        c   = sampleCommit repo tr sig-    c <- update c-    x <- oid c-    x @?= "44381a5e564d19893d783a5d5c59f9c745155b56"--    let goodbye2 = createBlob repo (E.encodeUtf8 "Goodbye, world again!\n")-    tr <- updateTree tr "goodbye/files/world.txt" (blobRef goodbye2)-    tr <- update tr-    x  <- oid tr-    x @?= "f2b42168651a45a4b7ce98464f09c7ec7c06d706"--    let sig = Signature {-            signatureName  = "John Wiegley"-          , signatureEmail = "johnw@newartisans.com"-          , signatureWhen  = posixSecondsToUTCTime 1348981883 }-        c2  = (sampleCommit repo tr sig) {-                  commitLog       = "Second sample log message."-                , commitParents   = [ObjRef c] }-    x <- oid c2-    x @?= "2506e7fcc2dbfe4c083e2bd741871e2e14126603"--    c2 <- update c2-    cid <- objectId c2-    writeRef $ createRef repo "refs/heads/master" (RefTargetId cid)-    writeRef $ createRef repo "HEAD" (RefTargetSymbolic "refs/heads/master")--    x <- oidToText <$> resolveRef repo "refs/heads/master"-    x @?= "2506e7fcc2dbfe4c083e2bd741871e2e14126603"--    mapAllRefs repo (\name -> Prelude.putStrLn $ "Ref: " ++ unpack name)--    ehist <- commitHistoryFirstParent c2-    Prelude.putStrLn $ "ehist: " ++ show ehist--    ehist2 <- commitEntryHistory c2 "goodbye/files/world.txt"-    Prelude.putStrLn $ "ehist2: " ++ show ehist2--    -- oid <- parseOid ("2506e7fc" :: Text)-    -- c3 <- lookupCommit (fromJust oid) repo-    -- ehist3 <- commitEntryHistory "goodbye/files/world.txt" (fromJust c3)-    -- Prelude.putStrLn $ "ehist3: " ++ show ehist3--    oid <- parseOid ("2506e7fc" :: Text)-    c4 <- lookupCommit repo (fromJust oid)-    c5 <- maybe (return Nothing) (lookupCommit repo) oid-    c6 <- lookupCommit repo (fromJust oid)-    ehist4 <- commitEntryHistory (fromJust c4) "goodbye/files/world.txt"-    Prelude.putStrLn $ "ehist4: " ++ show (Prelude.head ehist4)--  , "smallTest1" ~:--  withRepository "smallTest1.git" $ \repo -> do-    let blob =-          createBlob repo "# Auto-created repository for tutorial contents\n"-        masterRef = "refs/heads/master"-        sig = Signature { signatureName   = "First Name"-                        , signatureEmail = "user1@email.org"-                        , signatureWhen  = posixSecondsToUTCTime 1348981883 }-    tree <- updateTree (createTree repo) "README.md" (blobRef blob)-    commit <- writeCommit (createCommit repo sig)-            { commitLog       = "Initial commit"-            , commitTree      = ObjRef tree-            } (Just masterRef)-    c1id <- objectId commit-    print $ "commit1 sha = " ++ show c1id--    let sig2 = Signature { signatureName   = "Second Name"-                         , signatureEmail = "user2@email.org"-                         , signatureWhen  = posixSecondsToUTCTime 1348982883 }-    blob <- writeBlob $ createBlob repo "This is some content."-    blobOID <- objectId blob-    commit' <- updateCommit commit {-          commitAuthor = sig-        , commitCommitter = sig-        , commitLog = "This is another log message."-        , commitParents = [ObjRef commit]-        } "foo.txt" (blobRef blob)-    commitOID <- objectId commit'-    print $ "commit2 sha = " ++ show commitOID-    writeRef_ $ createRef repo masterRef $ RefTargetId commitOID--    True @?= True--    return ()--  ]---- Main.hs ends here