packages feed

gitlib-cmdline 1.4.0 → 2.0.0.0

raw patch · 2 files changed

+128/−200 lines, 2 filesdep ~gitlibdep ~gitlib-cmdlinedep ~gitlib-test

Dependency ranges changed: gitlib, gitlib-cmdline, gitlib-test

Files

Git/CmdLine.hs view
@@ -5,6 +5,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE TupleSections #-}@@ -25,7 +26,6 @@ import qualified Data.ByteString as B import           Data.Conduit hiding (MonadBaseControl) import           Data.Function-import           Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap import           Data.List as L import qualified Data.Map as Map@@ -45,6 +45,8 @@ import qualified Filesystem as F import qualified Filesystem.Path.CurrentOS as F import qualified Git+import qualified Git.Commit.Push as Git+import qualified Git.Tree.Builder.Pure as Pure import           Prelude hiding (FilePath) import           Shelly hiding (trace) import           System.Exit@@ -82,10 +84,9 @@ type Commit m          = Git.Commit (CmdLineRepository m) type Tag m             = Git.Tag (CmdLineRepository m) -type CommitName m      = Git.CommitName (CmdLineRepository m)-type Reference m       = Git.Reference (CmdLineRepository m) type Object m          = Git.Object (CmdLineRepository m) type ObjectOid m       = Git.ObjectOid (CmdLineRepository m)+type RefTarget m       = Git.RefTarget (CmdLineRepository m)  type TreeBuilder m     = Git.TreeBuilder (CmdLineRepository m) type ModifiedBuilder m = Git.ModifiedBuilder (CmdLineRepository m)@@ -104,8 +105,7 @@     createReference  = cliUpdateRef     updateReference  = cliUpdateRef     deleteReference  = cliDeleteRef-    resolveReference = cliResolveRef-    allReferences    = cliAllRefs+    listReferences   = cliListRefs     lookupCommit     = cliLookupCommit     lookupTree       = cliLookupTree     lookupBlob       = cliLookupBlob@@ -113,12 +113,10 @@     lookupObject     = error "Not defined CmdLineRepository.cliLookupObject"     existsObject     = cliExistsObject     pushCommit       = \name _ rrefname -> Git.genericPushCommit name rrefname-    traverseCommits  = cliTraverseCommits-    missingObjects   = cliMissingObjects-    traverseObjects  = error "Not defined: CmdLineRepository.traverseObjects"-    newTreeBuilder   = cliNewTreeBuilder-    getTreeEntry     = cliTreeEntry-    traverseEntries  = cliTraverseEntries+    listObjects      = cliListObjects+    newTreeBuilder   = Pure.newPureTreeBuilder cliReadTree cliWriteTree+    treeEntry        = cliTreeEntry+    listTreeEntries  = cliListTreeEntries     treeOid          = \(CmdLineTree toid) -> toid     hashContents     = cliHashContents     createBlob       = cliCreateBlob@@ -128,6 +126,22 @@     deleteRepository =         cliGet >>= liftIO . F.removeTree . Git.repoPath . repoOptions +mkOid :: Git.MonadGit m+      => forall o. TL.Text -> CmdLineRepository m (Tagged o Git.SHA)+mkOid = fmap Tagged <$> Git.textToSha . toStrict++shaToRef :: Git.MonadGit m => TL.Text -> CmdLineRepository m (RefTarget m)+shaToRef = fmap Git.RefObj . mkOid++parseCliTime :: String -> ZonedTime+parseCliTime = fromJust . parseTime defaultTimeLocale "%s %z"++formatCliTime :: ZonedTime -> Text+formatCliTime = T.pack . formatTime defaultTimeLocale "%s %z"++lexer :: TokenParser u+lexer = makeTokenParser haskellDef+ git :: [TL.Text] -> Sh TL.Text git = run "git" @@ -167,10 +181,10 @@         . liftIO         . F.canonicalizePath -cliPushCommitDirectly :: Git.MonadGit m-                      => CommitName m -> Text -> Text -> Maybe FilePath-                      -> CmdLineRepository m (CommitOid m)-cliPushCommitDirectly cname remoteNameOrURI remoteRefName msshCmd = do+cliPushCommit :: Git.MonadGit m+              => CommitOid m -> Text -> Text -> Maybe FilePath+              -> CmdLineRepository m (CommitOid m)+cliPushCommit cname remoteNameOrURI remoteRefName msshCmd = do     repo <- cliGet     merr <- shellyNoDir $ silently $ errExit False $ do         case msshCmd of@@ -184,7 +198,7 @@             Right () -> do                 git_ $ [ "--git-dir", repoPath repo ]                     <> [ "push", fromStrict remoteNameOrURI-                       , TL.concat [ fromStrict (Git.renderCommitName cname)+                       , TL.concat [ fromStrict (Git.renderObjOid cname)                                    , ":", fromStrict remoteRefName ] ]                 r <- lastExitCode                 if r == 0@@ -208,17 +222,17 @@ cliResetHard refname =     doRunGit run_ [ "reset", "--hard", fromStrict refname ] $ return () -cliPullCommitDirectly :: Git.MonadGit m-                      => Text-                      -> Text-                      -> Text-                      -> Text-                      -> Maybe FilePath-                      -> CmdLineRepository m-                          (Git.MergeResult (CmdLineRepository m))-cliPullCommitDirectly remoteNameOrURI remoteRefName user email msshCmd = do+cliPullCommit :: Git.MonadGit m+              => Text+              -> Text+              -> Text+              -> Text+              -> Maybe FilePath+              -> CmdLineRepository m+                  (Git.MergeResult (CmdLineRepository m))+cliPullCommit remoteNameOrURI remoteRefName user email msshCmd = do     repo     <- cliGet-    leftHead <- Git.resolveReference "HEAD"+    leftHead <- cliResolveRef "HEAD"      eres <- shellyNoDir $ silently $ errExit False $ do         case msshCmd of@@ -279,14 +293,14 @@     isConflict _                          = True      handleFile repo fp (Git.Deleted, Git.Deleted) =-        git_ [ "--git-dir", repoPath repo, "rm", "--cached", toTextIgnore fp ]+        git_ [ "--git-dir", repoPath repo, "rm", "--cached", fromStrict fp ]     handleFile repo fp (Git.Unchanged, Git.Deleted) =-        git_ [ "--git-dir", repoPath repo, "rm", "--cached", toTextIgnore fp ]+        git_ [ "--git-dir", repoPath repo, "rm", "--cached", fromStrict fp ]     handleFile repo fp (_, _) =-        git_ [ "--git-dir", repoPath repo, "add", toTextIgnore fp ]+        git_ [ "--git-dir", repoPath repo, "add", fromStrict fp ]      getOid name = do-        mref <- Git.resolveReference name+        mref <- cliResolveRef name         case mref of             Nothing  -> failure (Git.BackendError $                                  T.append "Reference missing: " name)@@ -302,7 +316,7 @@         Map.fromList             . map (\(f, (l, r)) -> (f, getModKinds l r))             . filter (\(_, (l, r)) -> ((&&) `on` isJust) l r)-            . map (\l -> (fromText $ TL.drop 3 l,+            . map (\l -> (toStrict $ TL.drop 3 l,                           (charToModKind (TL.index l 0),                            charToModKind (TL.index l 1))))             . init@@ -320,20 +334,14 @@         (Just x, Just y)     -> (x, y)         (Nothing, Nothing)   -> error "Both merge items cannot be Unchanged" -mkOid :: Monad m => TL.Text -> m Git.SHA-mkOid = Git.textToSha . toStrict--getOid :: Git.SHA -> TL.Text-getOid = fromStrict . Git.shaToText- cliLookupBlob :: Git.MonadGit m               => BlobOid m -> CmdLineRepository m (Blob m)-cliLookupBlob oid@(Tagged (getOid -> sha)) = do+cliLookupBlob oid@(Git.renderObjOid -> sha) = do     repo <- cliGet     (r,out,_) <-         liftIO $ readProcessWithExitCode "git"             [ "--git-dir", TL.unpack (repoPath repo)-            , "cat-file", "-p", TL.unpack sha ]+            , "cat-file", "-p", TL.unpack (fromStrict sha) ]             B.empty     if r == ExitSuccess         then return (Git.Blob oid (Git.BlobString out))@@ -351,7 +359,7 @@              <> ["-w" | persist] <> ["--stdin"])             bs     if r == ExitSuccess-        then Tagged <$> (mkOid . fromStrict . T.init . T.decodeUtf8 $ out)+        then mkOid . fromStrict . T.init . T.decodeUtf8 $ out         else failure Git.BlobCreateFailed  cliHashContents :: Git.MonadGit m@@ -364,31 +372,21 @@               -> CmdLineRepository m (BlobOid m) cliCreateBlob b = cliDoCreateBlob b True -cliExistsObject :: Git.MonadGit m => Git.SHA -> CmdLineRepository m Bool-cliExistsObject (getOid -> sha) = do+cliExistsObject :: Git.MonadGit m+                => Git.SHA -> CmdLineRepository m Bool+cliExistsObject (Git.shaToText -> sha) = do     repo <- cliGet     shellyNoDir $ silently $ errExit False $ do-        git_ [ "--git-dir", repoPath repo, "cat-file", "-e", sha ]+        git_ [ "--git-dir", repoPath repo, "cat-file", "-e", fromStrict sha ]         ec <- lastExitCode         return (ec == 0) -cliTraverseCommits :: Git.MonadGit m-                   => (CommitOid m -> CmdLineRepository m a)-                   -> CommitOid m-                   -> CmdLineRepository m [a]-cliTraverseCommits f coid = do-    shas <- doRunGit run [ "--no-pager", "log", "--format=%H"-                         , fromStrict (Git.renderObjOid coid) ]-            $ return ()-    mapM (\sha -> f =<< (Tagged <$> Git.parseOid (toStrict sha)))-        (TL.lines shas)--cliMissingObjects :: Git.MonadGit m-                  => Maybe (CommitOid m) -> CommitOid m-                  -> CmdLineRepository m [ObjectOid m]-cliMissingObjects mhave need = do+cliListObjects :: Git.MonadGit m+               => Maybe (CommitOid m) -> CommitOid m -> Bool+               -> CmdLineRepository m [ObjectOid m]+cliListObjects mhave need alsoTrees = do     shas <- doRunGit run-            ([ "--no-pager", "log", "--format=%H %T", "-z"]+            ([ "--no-pager", "log", "--format=%H %T" ]              <> (case mhave of                       Nothing   -> [ fromStrict (Git.renderObjOid need) ]                       Just have ->@@ -401,45 +399,19 @@     go [csha,tsha] = do         coid <- Git.parseObjOid csha         toid <- Git.parseObjOid tsha-        return [Git.CommitObjOid coid, Git.TreeObjOid toid]+        return $ [Git.CommitObjOid coid] <> [Git.TreeObjOid toid | alsoTrees]     go x = failure (Git.BackendError $                     "Unexpected output from git-log: " <> T.pack (show x)) -type EntryHashMap m = HashMap Text (TreeEntry m)--cliMakeTree :: Git.MonadGit m-            => EntryHashMap m -> TreeBuilder m-cliMakeTree entMap = mempty <> Git.TreeBuilder-    { Git.mtbBaseTreeOid    = Nothing-    , Git.mtbPendingUpdates = mempty-    , Git.mtbNewBuilder    = cliNewTreeBuilder-    , Git.mtbWriteContents = \tb -> (,) <$> pure (Git.BuilderUnchanged tb)-                                        <*> cliWriteBuilder entMap-    , Git.mtbLookupEntry   = cliLookupBuilderEntry entMap-    , Git.mtbEntryCount    = cliBuilderEntryCount entMap-    , Git.mtbPutEntry      = flip cliPutEntry entMap-    , Git.mtbDropEntry     = flip cliDropEntry entMap-    }---- | Create a new, empty tree.------   Since empty trees cannot exist in Git, attempting to write out an empty---   tree is a no-op.-cliNewTreeBuilder :: Git.MonadGit m-                  => Maybe (Tree m) -> CmdLineRepository m (TreeBuilder m)-cliNewTreeBuilder mtree = do-    entMap <- case mtree of-        Nothing   -> return HashMap.empty-        Just tree -> go (Git.treeOid tree)-    return $ (cliMakeTree entMap) { Git.mtbBaseTreeOid = Git.treeOid <$> mtree }--  where-    go (Tagged (getOid -> sha)) = do-        contents <- runGit ["ls-tree", "-z", sha]-        -- Even though the tree entries are separated by \NUL, for whatever-        -- reason @git ls-tree@ also outputs a newline at the end.-        HashMap.fromList-            <$> mapM cliParseLsTree (L.init (TL.splitOn "\NUL" contents))+cliReadTree :: Git.MonadGit m+            => Tree m+            -> CmdLineRepository m (Pure.EntryHashMap (CmdLineRepository m))+cliReadTree (CmdLineTree (Git.renderObjOid -> sha)) = do+    contents <- runGit ["ls-tree", "-z", fromStrict sha]+    -- Even though the tree entries are separated by \NUL, for whatever+    -- reason @git ls-tree@ also outputs a newline at the end.+    HashMap.fromList+        <$> mapM cliParseLsTree (L.init (TL.splitOn "\NUL" contents))  cliParseLsTree :: Git.MonadGit m                => TL.Text -> CmdLineRepository m (Text, TreeEntry m)@@ -448,61 +420,33 @@         [mode,kind,sha] = TL.words prefix     in liftM2 (,) (return (toStrict path)) $ case kind of         "blob"   -> do-            oid <- Tagged <$> mkOid sha+            oid <- mkOid sha             return $ Git.BlobEntry oid $ case mode of                 "100644" -> Git.PlainBlob                 "100755" -> Git.ExecutableBlob                 "120000" -> Git.SymlinkBlob                 _        -> Git.UnknownBlob-        "commit" -> Git.CommitEntry . Tagged <$> mkOid sha-        "tree"   -> Git.TreeEntry . Tagged <$> mkOid sha+        "commit" -> Git.CommitEntry <$> mkOid sha+        "tree"   -> Git.TreeEntry <$> mkOid sha         _ -> failure (Git.BackendError "This cannot happen") -cliPutEntry :: Git.MonadGit m-            => TreeBuilder m -> EntryHashMap m -> Text -> TreeEntry m-            -> CmdLineRepository m (ModifiedBuilder m)-cliPutEntry tb entMap key ent =-    return . Git.ModifiedBuilder $-        tb <> cliMakeTree (HashMap.insert key ent entMap)--cliDropEntry :: Git.MonadGit m-             => TreeBuilder m -> EntryHashMap m -> Text-             -> CmdLineRepository m (ModifiedBuilder m)-cliDropEntry tb entMap key =-    return . Git.ModifiedBuilder $-        tb <> cliMakeTree (HashMap.delete key entMap)--cliLookupBuilderEntry :: Git.MonadGit m-                      => EntryHashMap m -> Text-                      -> CmdLineRepository m (Maybe (TreeEntry m))-cliLookupBuilderEntry entMap key = return $ HashMap.lookup key entMap--cliBuilderEntryCount :: Git.MonadGit m-                     => EntryHashMap m -> CmdLineRepository m Int-cliBuilderEntryCount entMap = return $ HashMap.size entMap--cliTreeEntryCount :: Git.MonadGit m => Tree m -> CmdLineRepository m Int-cliTreeEntryCount t =-    L.length . L.init . TL.splitOn "\NUL"-        <$> runGit [ "ls-tree", "-z"-                   , fromStrict (Git.renderObjOid (Git.treeOid t)) ]--cliWriteBuilder :: Git.MonadGit m-                => EntryHashMap m-                -> CmdLineRepository m (TreeOid m)-cliWriteBuilder entMap = do+cliWriteTree :: Git.MonadGit m+             => Pure.EntryHashMap (CmdLineRepository m)+             -> CmdLineRepository m (TreeOid m)+cliWriteTree entMap = do     rendered <- mapM renderLine (HashMap.toList entMap)+    when (null rendered) $ failure Git.TreeEmptyCreateFailed     oid      <- doRunGit run ["mktree", "-z", "--missing"]                 $ setStdin $ TL.append (TL.intercalate "\NUL" rendered) "\NUL"-    Tagged <$> mkOid (TL.init oid)+    mkOid (TL.init oid)   where-    renderLine (path, Git.BlobEntry (Tagged (getOid -> sha)) kind) =+    renderLine (path, Git.BlobEntry (Git.renderObjOid -> sha) kind) =         return $ TL.concat [ case kind of                                   Git.PlainBlob      -> "100644"                                   Git.ExecutableBlob -> "100755"                                   Git.SymlinkBlob    -> "120000"                                   Git.UnknownBlob    -> "100000"-                           , " blob ", sha, "\t", fromStrict path ]+                           , " blob ", fromStrict sha, "\t", fromStrict path ]     renderLine (path, Git.CommitEntry coid) = do         return $ TL.concat [ "160000 commit "                            , fromStrict (Git.renderObjOid coid), "\t"@@ -514,16 +458,16 @@             , fromStrict path ]  cliLookupTree :: Git.MonadGit m => TreeOid m -> CmdLineRepository m (Tree m)-cliLookupTree oid@(Tagged (getOid -> sha)) = do+cliLookupTree oid@(Git.renderObjOid -> sha) = do     repo <- cliGet     ec <- shellyNoDir $ silently $ errExit False $ do-        git_ $ [ "--git-dir", repoPath repo, "cat-file", "-t", sha ]+        git_ $ [ "--git-dir", repoPath repo, "cat-file", "-t", fromStrict sha ]         lastExitCode     if ec == 0         then return $ CmdLineTree oid-        else failure (Git.ObjectLookupFailed (toStrict sha) 40)+        else failure (Git.ObjectLookupFailed sha 40) -cliTreeEntry :: Git.MonadGit m => Tree m -> FilePath+cliTreeEntry :: Git.MonadGit m => Tree m -> Text              -> CmdLineRepository m (Maybe (TreeEntry m)) cliTreeEntry tree fp = do     repo <- cliGet@@ -531,7 +475,7 @@         contents <- git $ [ "--git-dir", repoPath repo                           , "ls-tree", "-z"                           , fromStrict (Git.renderObjOid (Git.treeOid tree))-                          , "--", toTextIgnore fp ]+                          , "--", fromStrict fp ]         ec <- lastExitCode         return $ if ec == 0                  then Just $ L.init (TL.splitOn "\NUL" contents)@@ -544,37 +488,24 @@                 []        -> Nothing                 ((_,x):_) -> Just x -cliTraverseEntries :: Git.MonadGit m-                   => (FilePath -> TreeEntry m -> CmdLineRepository m b)-                   -> Tree m-                   -> CmdLineRepository m [b]-cliTraverseEntries f tree = do+cliListTreeEntries :: Git.MonadGit m+                   => Tree m+                   -> CmdLineRepository m [(Text, TreeEntry m)]+cliListTreeEntries tree = do     contents <- runGit [ "ls-tree", "-t", "-r", "-z"                        , fromStrict (Git.renderObjOid (Git.treeOid tree)) ]-    mapM (uncurry go <=< cliParseLsTree) (L.init (TL.splitOn "\NUL" contents))- where-   go = f . fromText . fromStrict+    mapM cliParseLsTree (L.init (TL.splitOn "\NUL" contents)) -parseCliTime :: String -> ZonedTime-parseCliTime = fromJust . parseTime defaultTimeLocale "%s %z"--formatCliTime :: ZonedTime -> Text-formatCliTime = T.pack . formatTime defaultTimeLocale "%s %z"--lexer :: TokenParser u-lexer = makeTokenParser haskellDef- cliLookupCommit :: Git.MonadGit m                 => CommitOid m -> CmdLineRepository m (Commit m)-cliLookupCommit (Tagged (getOid -> sha)) = do+cliLookupCommit (Git.renderObjOid -> sha) = do     output <- doRunGit run ["cat-file", "--batch"]-                  $ setStdin (TL.append sha "\n")+                  $ setStdin (TL.append (fromStrict sha) "\n")     result <- runParserT parseOutput () "" (TL.unpack output)     case result of         Left e  -> failure $ Git.CommitLookupFailed (T.pack (show e))         Right c -> return c   where-    parseOutput :: Monad m => ParsecT String () (CmdLineRepository m) (Commit a)     parseOutput = do         coid       <- manyTill alphaNum space         _          <- string "commit " *> manyTill digit newline@@ -584,9 +515,9 @@         committer  <- parseSignature "committer"         message    <- newline *> many anyChar -        coid'  <- lift $ Tagged `liftM` mkOid (TL.pack coid)-        toid'  <- lift $ Tagged `liftM` mkOid (TL.pack treeOid)-        poids' <- lift $ mapM (liftM Tagged . mkOid . TL.pack) parentOids+        coid'  <- lift $ mkOid (TL.pack coid)+        toid'  <- lift $ mkOid (TL.pack treeOid)+        poids' <- lift $ mapM (mkOid . TL.pack) parentOids          return Git.Commit             { Git.commitOid       = coid'@@ -631,7 +562,7 @@                       ]                 setStdin (fromStrict message) -    coid <- Tagged <$> mkOid (TL.init oid)+    coid <- mkOid (TL.init oid)     let commit = Git.Commit             { Git.commitOid       = coid             , Git.commitAuthor    = author@@ -667,55 +598,52 @@                            $ TL.lines rev                  else Nothing -nameAndShaToRef :: Git.MonadGit m-                => TL.Text -> TL.Text -> CmdLineRepository m (Reference m)-nameAndShaToRef name sha =-    Git.Reference <$> pure (toStrict name)-                  <*> (Git.RefObj . Tagged <$> mkOid sha)- cliLookupRef :: Git.MonadGit m-             => Text -> CmdLineRepository m (Maybe (Reference m))+             => Text -> CmdLineRepository m (Maybe (RefTarget m)) cliLookupRef refName = do-    xs <- cliShowRef (Just refName)-    let name = fromStrict refName-        ref  = maybe Nothing (lookup name) xs-    maybe (return Nothing)-        (fmap Just . uncurry nameAndShaToRef . \sha -> (name,sha)) ref+    repo <- cliGet+    (ec,rev) <- shellyNoDir $ silently $ errExit False $ do+        rev <- git $ [ "--git-dir", repoPath repo+                     , "symbolic-ref", fromStrict refName ]+        ec  <- lastExitCode+        return (ec,rev)+    if ec == 0+        then return . Just . Git.RefSymbolic . toStrict . TL.init $ rev+        else fmap Git.RefObj <$> cliResolveRef refName  cliUpdateRef :: Git.MonadGit m              => Text -> Git.RefTarget (CmdLineRepository m)-             -> CmdLineRepository m (Reference m)-cliUpdateRef refName refObj@(Git.RefObj (Tagged (getOid -> sha))) = do-    runGit_ ["update-ref", fromStrict refName, sha]-    return (Git.Reference refName refObj)+             -> CmdLineRepository m ()+cliUpdateRef refName (Git.RefObj (Git.renderObjOid -> sha)) =+    runGit_ ["update-ref", fromStrict refName, fromStrict sha] -cliUpdateRef refName refObj@(Git.RefSymbolic targetName) = do+cliUpdateRef refName (Git.RefSymbolic targetName) =     runGit_ ["symbolic-ref", fromStrict refName, fromStrict targetName]-    return (Git.Reference refName refObj)  cliDeleteRef :: Git.MonadGit m => Text -> CmdLineRepository m () cliDeleteRef refName = runGit_ ["update-ref", "-d", fromStrict refName] -cliAllRefs :: Git.MonadGit m-           => CmdLineRepository m [Reference m]-cliAllRefs = do+cliListRefs :: Git.MonadGit m+            => CmdLineRepository m [Text]+cliListRefs = do     mxs <- cliShowRef Nothing-    case mxs of-        Nothing -> return []-        Just xs -> mapM (uncurry nameAndShaToRef) xs+    return $ case mxs of+        Nothing -> []+        Just xs -> map (toStrict . fst) xs  cliResolveRef :: Git.MonadGit m               => Text -> CmdLineRepository m (Maybe (CommitOid m)) cliResolveRef refName = do     repo <- cliGet-    shellyNoDir $ silently $ errExit False $ do+    (rev, ec) <- shellyNoDir $ silently $ errExit False $ do         rev <- git [ "--git-dir", repoPath repo                    , "rev-parse", "--quiet", "--verify"                    , fromStrict refName ]-        ec  <- lastExitCode-        if ec == 0-            then Just . Tagged <$> mkOid (TL.init rev)-            else return Nothing+        ec <- lastExitCode+        return (rev, ec)+    if ec == 0+        then Just <$> mkOid (TL.init rev)+        else return Nothing  -- cliLookupTag :: TagOid -> CmdLineRepository Tag -- cliLookupTag oid = undefined@@ -723,9 +651,9 @@ cliCreateTag :: Git.MonadGit m              => CommitOid m -> Git.Signature -> Text -> Text              -> CmdLineRepository m (Tag m)-cliCreateTag oid@(Tagged (getOid -> sha)) tagger msg name = do+cliCreateTag oid@(Git.renderObjOid -> sha) tagger msg name = do     tsha <- doRunGit run ["mktag"] $ setStdin $ TL.unlines $-        [ "object " <> sha+        [ "object " <> fromStrict sha         , "type commit"         , "tag " <> fromStrict name         , "tagger " <> fromStrict (Git.signatureName tagger)@@ -733,7 +661,7 @@           <> TL.pack (formatTime defaultTimeLocale "%s %z"                       (Git.signatureWhen tagger))         , ""] <> TL.lines (fromStrict msg)-    Git.Tag <$> (Tagged <$> mkOid (TL.init tsha)) <*> pure oid+    Git.Tag <$> mkOid (TL.init tsha) <*> pure oid  data Repository = Repository     { repoOptions :: Git.RepositoryOptions
gitlib-cmdline.cabal view
@@ -1,5 +1,5 @@ Name:                gitlib-cmdline-Version:             1.4.0+Version:             2.0.0.0 Synopsis:            Gitlib repository backend that uses the git command-line tool. Description:         Gitlib repository backend that uses the git command-line tool. License-file:        LICENSE@@ -20,7 +20,7 @@   ghc-options: -Wall   build-depends:       base >= 3 && < 5-    , gitlib               >= 1.4.0+    , gitlib               >= 2.0.0.0     , bytestring           >= 0.9.2.1     , conduit              >= 0.5.5     , containers           >= 0.4.2.1@@ -49,9 +49,9 @@   hs-source-dirs: test   build-depends:       base >=3-    , gitlib             >= 1.4.0-    , gitlib-test        >= 1.4.0-    , gitlib-cmdline     >= 1.4.0+    , gitlib             >= 2.0.0.0+    , gitlib-test        >= 2.0.0.0+    , gitlib-cmdline     >= 2.0.0.0     , HUnit              >= 1.2.5     , hspec              >= 1.4.4     , hspec-expectations >= 0.3