No instance for (MonadResource IO) arising from a use of ‘writeBlob’

user_50962 0
Viewed 81

I am trying to create a commit using gitlib, but it does not quite work as expected. What I'm stuck at is the application of function writeBlob. Here is my source code:

{-# 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

The error message I am getting is:

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.

I cannot quite understand how to make writeBlob the instance of MonadResource IO. Documentation for gitlib is quite obscure.

Without writeBlob file gets stuck with delete mark in staging area and nothing is really get committed even though git log says it is there:

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

If somebody could help with resolving this issue and hopefully make commit created as expected, I would really appreciate it. Thanks in advance.

gitlib git haskell
2 Answers

On the Git side, git status runs two diffs:

  • The first diff compares the HEAD commit to Git's index. Whatever is different here is staged for commit (or the first character in git status --short).

  • The second diff compares Git's index vs the working tree. Whatever is different here is not staged for commit (or the second character in git status --short).

Although you just ran git status, the output looks like that from git status --short (did you git config status.short true?). The SPACED here would mean that the file exists in Git's index, but not in the working tree.

I'll have to leave the Haskell side to someone else.

user_12564520

Thanks to irc.freenode.net#haskell and user dminuoso, solution is finally found.

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

I didn't need writeBlob after all, just needed to learn how to properly createCommit. This was possible thanks to smoke tests for gitlib found on github.

As @torek reasonably pointed out, gitlib does not work with working tree, only with repository contents. Therefore files in git status appear to be missing in staging even though they are apparently present in the repository submitted by relevant commit using createCommit function.

user_509620
Related