githash 0.1.3.2 → 0.1.3.3

raw patch · 4 files changed

+116/−14 lines, 4 filesPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• githash.cabal +3/−2
• src/GitHash.hs +45/−12
• test/WorktreeRepoSpec.hs +64/−0

@@ -1,5 +1,9 @@ # ChangeLog for githash +## 0.1.3.3++* Add git-worktree support [#13](https://github.com/snoyberg/githash/issues/13)+ ## 0.1.3.2  * Test suite works outside of a Git repo [#12](https://github.com/snoyberg/githash/issues/12)

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: f6bf56388f86c4e1f54aad7088b785d703df1b2563a22a762004688b69a0048f+-- hash: dad169c97d7c1d2d5d696f8ca7a5cbdce36b8b181a3c695ffb05681aaa6a226b  name:           githash-version:        0.1.3.2+version:        0.1.3.3 synopsis:       Compile git revision info into Haskell projects description:    Please see the README and documentation at <https://www.stackage.org/package/githash> category:       Development@@ -49,6 +49,7 @@       GitHashSpec       NormalRepoSpec       RepoWithASubmoduleSpec+      WorktreeRepoSpec       Paths_githash   hs-source-dirs:       test

@@ -111,16 +111,13 @@ giCommitMessage :: GitInfo -> String giCommitMessage = _giCommitMessage --- | Get the 'GitInfo' for the given root directory. Root directory--- should be the directory containing the @.git@ directory.------ @since 0.1.0.0-getGitInfo :: FilePath -> IO (Either GitHashException GitInfo)-getGitInfo root = try $ do+-- | Get a list of files from within a @.git@ directory.+getGitFilesRegular :: FilePath -> IO [FilePath]+getGitFilesRegular git = do   -- a lot of bookkeeping to record the right dependencies-  let hd         = root </> ".git" </> "HEAD"-      index      = root </> ".git" </> "index"-      packedRefs = root </> ".git" </> "packed-refs"+  let hd         = git </> "HEAD"+      index      = git </> "index"+      packedRefs = git </> "packed-refs"   ehdRef <- try $ B.readFile hd   files1 <-     case ehdRef of@@ -133,7 +130,7 @@         case B.splitAt 5 hdRef of           -- pointer to ref           ("ref: ", relRef) -> do-            let ref = root </> ".git" </> B8.unpack relRef+            let ref = git </> B8.unpack relRef             refExists <- doesFileExist ref             return $ if refExists then [ref] else []           -- detached head@@ -147,13 +144,48 @@   packedExists <- doesFileExist packedRefs   let files3 = if packedExists then [packedRefs] else [] -      _giFiles = concat [files1, files2, files3]-      run args = do+  return $ concat [files1, files2, files3]++-- | Get a list of dependent files from a @.git@ file representing a+-- git-worktree.+getGitFilesForWorktree :: FilePath -> IO [FilePath]+getGitFilesForWorktree git = do+  gitPath <- try $ B.readFile git+  case gitPath of+    Left e+      | otherwise -> throwIO $ GHECouldn'tReadFile git e+    Right rootPath ->+      -- the .git file contains the absolute path to the git+      -- directory's root.+      case B.splitAt 8 rootPath of+        -- path to root+        ("gitdir: ", gitdir) -> do+          let path = takeWhile (/= '\n') (B8.unpack gitdir)+          -- The .git file points to a .git directory which we can just+          -- treat like a non git-worktree one.+          getGitFilesRegular path+        _ -> throwIO $ GHEInvalidGitFile (B8.unpack rootPath)+++-- | Get a list of dependent git related files.+getGitFiles :: FilePath -> IO [FilePath]+getGitFiles git = do+  isDir <- doesDirectoryExist git+  if isDir then getGitFilesRegular git else getGitFilesForWorktree git++-- | Get the 'GitInfo' for the given root directory. Root directory+-- should be the directory containing the @.git@ directory.+--+-- @since 0.1.0.0+getGitInfo :: FilePath -> IO (Either GitHashException GitInfo)+getGitInfo root = try $ do+  let run args = do         eres <- runGit root args         case eres of           Left e -> throwIO e           Right str -> return $ takeWhile (/= '\n') str +  _giFiles <- getGitFiles (root </> ".git")   _giHash <- run ["rev-parse", "HEAD"]   _giBranch <- run ["rev-parse", "--abbrev-ref", "HEAD"] @@ -194,6 +226,7 @@ data GitHashException   = GHECouldn'tReadFile !FilePath !IOException   | GHEInvalidCommitCount !FilePath !String+  | GHEInvalidGitFile !String   | GHEGitRunFailed !FilePath ![String] !ExitCode !String !String   | GHEGitRunException !FilePath ![String] !IOException   deriving (Show, Eq, Typeable)

@@ -0,0 +1,64 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-}++module WorktreeRepoSpec+    ( spec+    ) where++import Control.Monad+import qualified Data.ByteString as SB+import GitHash+import System.Directory+import System.FilePath+import System.Process+import Test.Hspec+import UnliftIO.Temporary++spec :: Spec+spec =+    around setupGitRepo $ do+        describe "getGitInfo" $ do+            it "it makes sensible git info for a git-worktree repository" $ \fp -> do+                errOrGi <- getGitInfo fp+                case errOrGi of+                    Left err -> expectationFailure $ show err+                    Right gi -> do+                        length (giHash gi) `shouldNotBe` 128+                        giBranch gi `shouldBe` "worktree-branch"+                        giDirty gi `shouldBe` True+                        giCommitDate gi `shouldNotBe` []+                        giCommitCount gi `shouldBe` 1+                        giCommitMessage gi `shouldBe` "Initial commit"+        describe "getGitRoot" $ do+            it "it gets the expected git root for a git-worktree repository" $ \fp ->+                getGitRoot fp `shouldReturn` Right fp++setupGitRepo :: (FilePath -> IO ()) -> IO ()+setupGitRepo runTest =+    withSystemTempDirectory "normal" $ \fp -> do+        let fp1 = fp </> "1"+            fp2 = fp </> "2"+        createDirectoryIfMissing True fp1+        createDirectoryIfMissing True fp2+        let runGit args =+                void $ readCreateProcess ((proc "git" args) {cwd = Just fp1}) ""+        runGit ["init"]+        SB.writeFile+            (fp1 </> "README.md")+            "This is a readme, you should read it."+        runGit ["add", "README.md"]+        runGit+            [ "-c"+            , "user.name='Test User'"+            , "-c"+            , "user.email='test@example.com'"+            , "commit"+            , "-m"+            , "Initial commit"+            ]+        runGit ["branch", "worktree-branch"]+        runGit ["worktree", "add", fp2, "worktree-branch"]+        SB.writeFile+            (fp2 </> "README.md")+            "This is a readme that has been modified."+        runTest fp2