diff --git a/Git/CmdLine.hs b/Git/CmdLine.hs --- a/Git/CmdLine.hs +++ b/Git/CmdLine.hs @@ -107,8 +107,8 @@ lookupCommit = cliLookupCommit lookupTree = cliLookupTree lookupBlob = cliLookupBlob - lookupTag = error "Not defined CmdLineRepository.cliLookupTag" - lookupObject = error "Not defined CmdLineRepository.cliLookupObject" + lookupTag = error "Not defined cliLookupTag" + lookupObject = error "Not defined cliLookupObject" existsObject = cliExistsObject sourceObjects = cliSourceObjects newTreeBuilder = Pure.newPureTreeBuilder cliReadTree cliWriteTree @@ -126,12 +126,14 @@ cliGet >>= liftIO . removeDirectoryRecursive . Git.repoPath . repoOptions + diffContentsWithTree = error "Not defined cliDiffContentsWithTree" + 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 +shaToRef = fmap (Git.RefObj . untag) . mkOid parseCliTime :: String -> ZonedTime parseCliTime = fromJust . parseTime defaultTimeLocale "%s %z" @@ -210,7 +212,7 @@ mcref <- Git.resolveReference remoteRefName case mcref of Nothing -> failure (Git.BackendError $ "git push failed") - Just cref -> return cref + Just cref -> return (Tagged cref) Just err -> failure err cliResetHard :: Git.MonadGit m => Text -> CmdLineRepository m () @@ -227,7 +229,7 @@ (Git.MergeResult (CmdLineRepository m)) cliPullCommit remoteNameOrURI remoteRefName user email msshCmd = do repo <- cliGet - leftHead <- cliResolveRef "HEAD" + leftHead <- fmap Tagged <$> cliResolveRef "HEAD" eres <- shellyNoDir $ silently $ errExit False $ do for_ msshCmd $ \sshCmd -> @@ -254,7 +256,7 @@ Left err -> failure err Right r -> if r == 0 - then Git.MergeSuccess <$> getOid "HEAD" + then Git.MergeSuccess <$> (Tagged <$> getOid "HEAD") else case leftHead of Nothing -> failure (Git.BackendError @@ -264,7 +266,7 @@ -- jww (2013-05-15): This function should not overwrite head, but simply -- create a detached commit and return its id. recordMerge repo leftHead = do - rightHead <- getOid "MERGE_HEAD" + rightHead <- Tagged <$> getOid "MERGE_HEAD" xs <- shellyNoDir $ silently $ errExit False $ do xs <- returnConflict . TL.init <$> git [ "--git-dir", repoPath repo @@ -274,7 +276,7 @@ , "commit", "-F", ".git/MERGE_MSG" ] return xs Git.MergeConflicted - <$> getOid "HEAD" + <$> (Tagged <$> getOid "HEAD") <*> pure leftHead <*> pure rightHead <*> pure (Map.filter isConflict xs) @@ -360,7 +362,7 @@ bs if r == ExitSuccess then mkOid . fromStrict . T.init . T.decodeUtf8 $ out - else failure Git.BlobCreateFailed + else failure $ Git.BlobCreateFailed "Failed to create blob" cliHashContents :: Git.MonadGit m => Git.BlobContents (CmdLineRepository m) @@ -383,7 +385,7 @@ cliSourceObjects :: Git.MonadGit m => Maybe (CommitOid m) -> CommitOid m -> Bool - -> Source (CmdLineRepository m) (ObjectOid m) + -> Producer (CmdLineRepository m) (ObjectOid m) cliSourceObjects mhave need alsoTrees = do shas <- lift $ doRunGit run ([ "--no-pager", "log", "--format=%H %T" ] @@ -585,7 +587,8 @@ , Git.commitEncoding = "utf-8" } when (isJust ref) $ - void $ cliUpdateRef (fromJust ref) (Git.RefObj (Git.commitOid commit)) + void $ cliUpdateRef (fromJust ref) + (Git.RefObj (untag (Git.commitOid commit))) return commit @@ -626,7 +629,7 @@ cliUpdateRef :: Git.MonadGit m => Text -> Git.RefTarget (CmdLineRepository m) -> CmdLineRepository m () -cliUpdateRef refName (Git.RefObj (Git.renderObjOid -> sha)) = +cliUpdateRef refName (Git.RefObj (Git.renderOid -> sha)) = runGit_ ["update-ref", fromStrict refName, fromStrict sha] cliUpdateRef refName (Git.RefSymbolic targetName) = @@ -644,7 +647,8 @@ Just xs -> map (toStrict . fst) xs cliResolveRef :: Git.MonadGit m - => Text -> CmdLineRepository m (Maybe (CommitOid m)) + => Text + -> CmdLineRepository m (Maybe (Git.Oid (CmdLineRepository m))) cliResolveRef refName = do repo <- cliGet (rev, ec) <- shellyNoDir $ silently $ errExit False $ do @@ -654,7 +658,7 @@ ec <- lastExitCode return (rev, ec) if ec == 0 - then Just <$> mkOid (TL.init rev) + then Just <$> Git.textToSha (toStrict (TL.init rev)) else return Nothing -- cliLookupTag :: TagOid -> CmdLineRepository Tag @@ -733,7 +737,7 @@ cliGet = CmdLineRepository ask cliFactory :: Git.MonadGit m - => Git.RepositoryFactory CmdLineRepository m Repository + => Git.RepositoryFactory (CmdLineRepository m) m Repository cliFactory = Git.RepositoryFactory { Git.openRepository = openCliRepository , Git.runRepository = runCliRepository diff --git a/gitlib-cmdline.cabal b/gitlib-cmdline.cabal --- a/gitlib-cmdline.cabal +++ b/gitlib-cmdline.cabal @@ -1,5 +1,5 @@ Name: gitlib-cmdline -Version: 2.1.0.0 +Version: 2.2.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 >= 2.1.0.0 + , gitlib >= 2.2.0.0 , bytestring >= 0.9.2.1 , conduit >= 0.5.5 , containers >= 0.4.2.1 @@ -31,7 +31,6 @@ , parsec >= 3.1.3 , process-extras >= 0.2.0 , shelly >= 0.14 - , system-fileio >= 0.3.11 , system-filepath >= 0.4.7 , tagged >= 0.4.4 , time >= 1.4 @@ -50,10 +49,9 @@ hs-source-dirs: test build-depends: base >=3 - , gitlib >= 2.1.0.0 - , gitlib-test >= 2.1.0.0 - , gitlib-cmdline >= 2.1.0.0 - , HUnit >= 1.2.5 + , gitlib >= 2.2.0.0 + , gitlib-test >= 2.2.0.0 + , gitlib-cmdline >= 2.2.0.0 , hspec >= 1.4.4 , hspec-expectations >= 0.3 , system-filepath >= 0.4.7