gitlib 1.0.1 → 1.1.0

raw patch · 2 files changed

+211/−73 lines, 2 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Git.hs +210/−72
• gitlib.cabal +1/−1

@@ -1,23 +1,110 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeFamilies #-}  -- | Interface for working with Git repositories.-module Git where+module Git+       ( RepositoryFacts(..)+       , Repository(..)+       , RepositoryFactory(..)+       , RepositoryOptions(..)+       , withBackendDo+       , withRepository+       , withRepository'+       , MonadGit +       , IsOid(..)+       , copyOid+       , Object(..)+       , ObjRef(..)+       , objectOid++       , Blob(..)+       , BlobOid+       , BlobContents(..)+       , BlobKind(..)+       , ByteSource+       , BlobRef+       , blobEntry+       , blobRefOid+       , resolveBlobRef++       , TreeT+       , TreeEntry(..)+       , TreeOid+       , TreeRef+       , createTree+       , withNewTree+       , mutateTree+       , withTree+       , unsafeMutateTree+       , unsafeMutateTree_+       , unsafeWithTree+       , unsafeGetTree+       , unsafePutTree+       , dropEntry+       , getEntry+       , getTreeEntry+       , putBlob+       , putBlob'+       , putCommit+       , putEntry+       , putTree+       , resolveTreeRef+       , treeEntry+       , treeEntryOid+       , treeRef+       , treeRefOid+       , ModifyTreeResult(..)+       , fromModifyTreeResult+       , toModifyTreeResult++       , Commit(..)+       , CommitOid+       , CommitName(..)+       , CommitRef+       , Signature(..)+       , commitEntry+       , commitNameToRef+       , commitRef+       , commitRefOid+       , commitRefTarget+       , copyCommitName+       , copyCommitOid+       , nameOfCommit+       , renderCommitName+       , resolveCommitRef++       , Tag(..)+       , TagOid+       , TagRef+       , tagRefOid++       , RefTarget(..)+       , Reference(..)+       , referenceToRef++       , GitException(..)+       , ModificationKind(..)+       , MergeStatus(..)+       , MergeResult(..)+       , mergeStatus+       , copyConflict+       ) where+ import           Control.Applicative import qualified Control.Exception.Lifted as Exc import           Control.Failure import           Control.Monad+import           Control.Monad.Fix import           Control.Monad.IO.Class import           Control.Monad.Trans.Class+import           Control.Monad.Trans.State import           Data.ByteString (ByteString) import           Data.Conduit import           Data.Default@@ -40,21 +127,24 @@ type MonadGit m = (Failure Git.GitException m, Applicative m,                    MonadIO m, MonadBaseControl IO m) +class (Eq o, Ord o, Show o) => IsOid o where+    renderOid :: o -> Text+    renderOid = renderObjOid . Tagged+    renderObjOid :: Tagged a o -> Text+    renderObjOid = renderOid . unTagged+ -- | '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+class (Applicative m, Monad m, Failure GitException m, IsOid (Oid m))+      => Repository m where+    type Oid m+    type Tree 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))@@ -105,6 +195,19 @@      -- Object creation     newTree :: m (Tree m)+    cloneTree :: Tree m -> m (Tree m)+    traverseEntries :: (FilePath -> TreeEntry m -> m a) -> Tree m -> m [a]+    traverseEntries_ :: (FilePath -> TreeEntry m -> m a) -> Tree m -> m ()+    traverseEntries_ = (void .) . traverseEntries+    writeTree :: Tree m -> m (TreeOid m)++    unsafeUpdateTree+        :: Tree m+        -> FilePath    -- path within the tree+        -> Bool        -- create subtree's leading up to path?+        -> (Maybe (TreeEntry m) -> ModifyTreeResult m)+        -> m (Tree m, Maybe (TreeEntry m))+     hashContents :: BlobContents m -> m (BlobOid m)     createBlob   :: BlobContents m -> m (BlobOid m)     createCommit :: [CommitRef m] -> TreeRef m@@ -272,6 +375,98 @@   _ == _ = False  {- $trees -}+newtype TreeT m a = TreeT { runTreeT :: StateT (Tree m) m a }++instance Functor m => Functor (TreeT m) where+    fmap f (TreeT t) = TreeT (fmap f t)++instance Monad m => Monad (TreeT m) where+    return x = TreeT (return x)+    TreeT x >>= f = TreeT (x >>= runTreeT . f)++instance (Functor m, Monad m) => Applicative (TreeT m) where+    pure = return+    (<*>) = ap++instance (Functor m, MonadPlus m) => Alternative (TreeT m) where+    empty = mzero+    (<|>) = mplus++instance (MonadPlus m) => MonadPlus (TreeT m) where+    mzero       = TreeT $ mzero+    m `mplus` n = TreeT $ runTreeT m `mplus` runTreeT n++instance (MonadFix m) => MonadFix (TreeT m) where+    mfix f = TreeT $ mfix $ \ ~a -> runTreeT (f a)++instance MonadTrans TreeT where+    lift m = TreeT $ lift m++instance (MonadIO m) => MonadIO (TreeT m) where+    liftIO = lift . liftIO++unsafeGetTree :: Monad m => TreeT m (Tree m)+unsafeGetTree = TreeT get++unsafePutTree :: Monad m => Tree m -> TreeT m ()+unsafePutTree = TreeT . put++getEntry :: Repository m => FilePath -> TreeT m (Maybe (TreeEntry m))+getEntry path = do+    tr <- unsafeGetTree+    snd <$> lift (unsafeUpdateTree tr path False+                  (toModifyTreeResult TreeEntryPersistent))++getTreeEntry :: Repository m => Tree m -> FilePath -> m (Maybe (TreeEntry m))+getTreeEntry tree path = fst <$> unsafeWithTree tree (getEntry path)++putEntry :: Repository m => FilePath -> TreeEntry m -> TreeT m ()+putEntry path ent = do+    tr <- unsafeGetTree+    tr' <- fst <$> lift (unsafeUpdateTree tr path True+                         (const (TreeEntryMutated ent)))+    unsafePutTree tr'++dropEntry :: Repository m => FilePath -> TreeT m ()+dropEntry path = do+    tr <- unsafeGetTree+    tr' <- fst <$> lift (unsafeUpdateTree tr path False+                         (const TreeEntryDeleted))+    unsafePutTree tr'++putBlob' :: Repository m => FilePath -> BlobOid m -> BlobKind -> TreeT m ()+putBlob' path b kind = putEntry path (BlobEntry b kind)++putBlob :: Repository m => FilePath -> BlobOid m -> TreeT m ()+putBlob path b = putBlob' path b PlainBlob++putTree :: Repository m => FilePath -> TreeRef m -> TreeT m ()+putTree path ent = putEntry path (TreeEntry ent)++putCommit :: Repository m => FilePath -> CommitOid m -> TreeT m ()+putCommit path c = putEntry path (CommitEntry c)++withNewTree :: Repository m => TreeT m a -> m (a, Tree m)+withNewTree (TreeT action) = runStateT action =<< newTree++createTree :: Repository m => TreeT m a -> m (Tree m)+createTree (TreeT action) = execStateT action =<< newTree++withTree :: Repository m => Tree m -> TreeT m a -> m (a, Tree m)+withTree tr (TreeT action) = runStateT action =<< cloneTree tr++unsafeWithTree :: Repository m => Tree m -> TreeT m a -> m (a, Tree m)+unsafeWithTree tr (TreeT action) = runStateT action tr++mutateTree :: Repository m => Tree m -> TreeT m a -> m (Tree m)+mutateTree tr (TreeT action) = execStateT action =<< cloneTree tr++unsafeMutateTree :: Repository m => Tree m -> TreeT m a -> m (Tree m)+unsafeMutateTree tr (TreeT action) = execStateT action tr++unsafeMutateTree_ :: Repository m => Tree m -> TreeT m a -> m ()+unsafeMutateTree_ = (void .) . unsafeMutateTree+ data TreeEntry m = BlobEntry   { blobEntryOid   :: !(BlobOid m)                                , blobEntryKind  :: !BlobKind }                  | TreeEntry   { treeEntryRef   :: !(TreeRef m) }@@ -297,10 +492,10 @@                         | TreeEntryMutated (TreeEntry m)  fromModifyTreeResult :: ModifyTreeResult m -> Maybe (TreeEntry m)-fromModifyTreeResult TreeEntryNotFound = Nothing-fromModifyTreeResult TreeEntryDeleted = Nothing+fromModifyTreeResult TreeEntryNotFound       = Nothing+fromModifyTreeResult TreeEntryDeleted        = Nothing fromModifyTreeResult (TreeEntryPersistent x) = Just x-fromModifyTreeResult (TreeEntryMutated x) = Just x+fromModifyTreeResult (TreeEntryMutated x)    = Just x  toModifyTreeResult :: (TreeEntry m -> ModifyTreeResult m)                    -> Maybe (TreeEntry m)@@ -309,63 +504,6 @@ 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 

@@ -1,5 +1,5 @@ Name:                gitlib-Version:             1.0.1+Version:             1.1.0 Synopsis:            API library for working with Git repositories License-file:        LICENSE License:             MIT