没有因使用“writeBlob”

编程问答 2022-05-09

问题描述

我正在尝试使用 gitlib 创建一个提交，但它并没有像预期的那样工作。我被困在函数writeBlob 的应用上。这是我的源代码：

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE PartialTypeSignatures #-}

module GitOperation where

import Git
import Git.Libgit2 (lgFactory,LgRepo(..) )
import qualified Data.Text as T
import Control.Monad.Trans.Reader
import Control.Monad.Trans
import Data.ByteString.Char8 as BS
import Data.Foldable
import Data.Time.LocalTime
import Data.Time.Clock
import Data.Time.Calendar
import Control.Monad.State
import Conduit

repositoryOptions :: RepositoryOptions
repositoryOptions = RepositoryOptions { repoPath = "data",repoWorkingDir = Just "data",repoIsBare = False,repoautocreate = True}
  
main :: IO ()
main = do
  repo <- openRepository lgFactory repositoryOptions
  runReaderT (addFiletoRepository "content4.txt" "content4" "added content4 file") repo

addFiletoRepository :: TreeFilePath -> String -> CommitMessage -> ReaderT LgRepo IO ()
addFiletoRepository path content commitMessage = do
  Now <- lift getCurrentTime
  timezone <- lift getCurrentTimeZone
  treeBuilder <- newTreeBuilder nothing
  repo <- ask
  blobOid <- createBlobUtf8 $ T.pack content
  writeBlob (BS.unpack path) (BlobString $ BS.pack content)
  transf <- lift $ runReaderT (runStateT (runTreeT currentTreeOid) treeBuilder) repo 
  let (year,month,day) = toGregorian $ utctDay Now
      timeOfDay = localTimeOfDay $ utcToLocalTime timezone Now
      s = Signature {
         signatureName = "username",signatureEmail = "me@website.com",signatureWhen = ZonedTime { 
            zonedTimetoLocalTime = LocalTime {
                localDay = fromGregorian year month day,localTimeOfDay = timeOfDay                                                       
            },zonedTimeZone = TimeZone {
                timeZoneMinutes = 180,timeZonesummerOnly = False,timeZoneName = "EEST"
            }
         }
      }  in do
  lift $ print s
  ci <- case transf of 
    (oid,builder) -> do 
      newOid <- createTree $ putEntry path BlobEntry {blobEntryKind = PlainBlob,blobEntryOid = blobOid}
      createCommit [] newOid s s commitMessage nothing
  lift $ print $ commitLog ci

我收到的错误信息是：

Main.hs:125:3: error:
    • No instance for (MonadResource IO)
        arising from a use of ‘writeBlob’
    • In a stmt of a 'do' block:
        writeBlob (unpack path) (BlobString $ pack content)
      In the expression:
        do Now <- lift getCurrentTime
           timezone <- lift getCurrentTimeZone
           treeBuilder <- newTreeBuilder nothing
           repo <- ask
           ....
      In an equation for ‘addFiletoRepository’:
          addFiletoRepository path content commitMessage
            = do Now <- lift getCurrentTime
                 timezone <- lift getCurrentTimeZone
                 treeBuilder <- newTreeBuilder nothing
                 ....
    |
125 |   writeBlob (BS.unpack path) (BlobString $ BS.pack content)
    |   ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Failed,no modules loaded.

我不太明白如何使 writeBlob 成为 MonadResource IO 的实例。 gitlib 的文档相当晦涩。

如果没有 writeBlob，文件会在暂存区被 delete 标记卡住，即使 git log 说它在那里，也没有真正提交：

Projects/test/data on  master [?] 
❯ git status
 D content4.txt

Projects/test/data on  master [?] 
❯ git log
commit 90b3f8ac01ae590e5e7726046a59a5d9944ab88c (HEAD -> master)
Author: username <me@website.com>
Date:   Mon May 17 15:26:38 2021 +0300

    added content4 file

如果有人可以帮助解决这个问题并希望按预期创建提交，我将不胜感激。提前致谢。

解决方法

在 Git 方面，git status 运行两个差异：

  • 第一个差异将 HEAD 提交与 Git 的索引进行比较。此处不同的是 staged for commit（或 git status --short 中的第一个字符）。

  • 第二个差异比较 Git 的索引与工作树。此处不同的是 not staged for commit（或 git status --short 中的第二个字符）。

尽管您刚刚运行了 git status，但输出看起来与 git status --short 的输出类似（您是否 git config status.short true？）。此处的 SPACED 表示该文件存在于 Git 的索引中，但不存在于工作树中。

我将不得不将 Haskell 方面留给其他人。

,

感谢 irc.freenode.net#haskell 和用户 dminuoso，终于找到了解决方案。

addFileToRepository :: TreeFilePath -> String -> CommitMessage -> ReaderT LgRepo IO ()
addFileToRepository path content commitMessage = do
  now <- liftIO getCurrentTime
  timezone <- liftIO getCurrentTimeZone
  treeBuilder <- newTreeBuilder Nothing
  repo <- ask
  blobOid <- createBlobUtf8 $ T.pack content
  transf <- lift $ runReaderT (runStateT (runTreeT currentTreeOid) treeBuilder) repo 
  let (year,month,day) = toGregorian $ utctDay now
      timeOfDay = localTimeOfDay $ utcToLocalTime timezone now
      in do
  liftIO $ print $ s year month day timeOfDay
  case transf of 
    (oid,_) -> do 
      oid <- mutateTreeOid oid $ putBlob path blobOid
      reference <- resolveReference $ T.pack "HEAD"
      case reference of 
        Nothing -> do
          ci <- createCommit [] oid (s year month day timeOfDay) (s year month day timeOfDay) commitMessage (Just "refs/heads/master") 
          liftIO $ print $ commitLog ci
        Just reference -> do
          obj <- lookupObject reference
          case obj of 
             CommitObj headCommit -> do
              ci <- createCommit [commitOid headCommit] oid (s year month day timeOfDay) (s year month day timeOfDay) commitMessage (Just "refs/heads/master") 
              liftIO $ print $ commitLog ci

毕竟我不需要 writeBlob，只需要学习如何正确地createCommit。这要归功于在 github 上找到的 smoke tests for gitlib。

正如@torek 合理指出的那样，gitlib 不适用于工作树，仅适用于存储库内容。因此，尽管 git status 中的文件显然存在于使用 createCommit 函数的相关提交提交的存储库中，但它们似乎在暂存中丢失。

gitgitgitlibhaskellhaskell