githash 0.1.0.0 → 0.1.0.1

raw patch · 6 files changed

+158/−9 lines, 6 filesdep +unliftioPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

Dependencies added: unliftio

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• githash.cabal +8/−4
• src/GitHash.hs +4/−2
• test/GitHashSpec.hs +8/−3
• test/NormalRepoSpec.hs +56/−0
• test/RepoWithASubmoduleSpec.hs +78/−0

@@ -1,5 +1,9 @@ # ChangeLog for githash +## 0.1.0.1++* Update the test suite+ ## 0.1.0.0  * Initial release

@@ -1,11 +1,13 @@--- This file has been generated from package.yaml by hpack version 0.28.2.+cabal-version: >= 1.10++-- This file has been generated from package.yaml by hpack version 0.29.0. -- -- see: https://github.com/sol/hpack ----- hash: 391f23a7714fa5cdd1e4919cca1972387f65d007ebba0047608a34231d283619+-- hash: c672737e59eb8b5ab055f12dee75b9283b13f55d02e13201c846689414798949  name:           githash-version:        0.1.0.0+version:        0.1.0.1 synopsis:       Compile git revision info into Haskell projects description:    Please see the README and documentation at <https://www.stackage.org/package/githash> category:       Development@@ -16,7 +18,6 @@ license:        BSD3 license-file:   LICENSE build-type:     Simple-cabal-version:  >= 1.10 extra-source-files:     ChangeLog.md     README.md@@ -46,6 +47,8 @@   main-is: Spec.hs   other-modules:       GitHashSpec+      NormalRepoSpec+      RepoWithASubmoduleSpec       Paths_githash   hs-source-dirs:       test@@ -59,4 +62,5 @@     , process     , template-haskell     , temporary+    , unliftio   default-language: Haskell2010

@@ -32,6 +32,8 @@ -- > % stack runghc Example.hs -- > Example.hs: [panic master@2ae047ba5e4a6f0f3e705a43615363ac006099c1 (Mon Jan 11 11:50:59 2016 -0800) (14 commits in HEAD) (uncommitted files present)] oh no! --+-- WARNING: None of this will work in a git repository without any commits.+-- -- @since 0.1.0.0 module GitHash   ( -- * Types@@ -165,7 +167,7 @@ -- -- @since 0.1.0.0 getGitRoot :: FilePath -> IO (Either GitHashException FilePath)-getGitRoot dir = fmap (takeWhile (/= '\n')) `fmap` (runGit dir ["rev-parse", "--show-toplevel"])+getGitRoot dir = fmap (normalise . takeWhile (/= '\n')) `fmap` (runGit dir ["rev-parse", "--show-toplevel"])  runGit root args = do   let cp = (proc "git" args) { cwd = Just root }@@ -181,7 +183,7 @@   = GHECouldn'tReadFile !FilePath !IOException   | GHEInvalidCommitCount !FilePath !String   | GHEGitRunFailed !FilePath ![String] !ExitCode !String !String-  deriving (Show, Typeable)+  deriving (Show, Eq, Typeable) instance Exception GitHashException  -- | Load up the 'GitInfo' value at compile time for the given

@@ -8,6 +8,11 @@  spec :: Spec spec = do-  it "sanity" $ do-    let gi = $$tGitInfoCwd-    giCommitCount gi `shouldSatisfy` (>= 1)+  describe "tGitInfoCwd" $ do+    it "makes vaguely sane git info for this repository" $ do+        let gi = $$tGitInfoCwd+        length (giHash gi)`shouldNotBe` 128+        giBranch gi `shouldNotBe` []+        seq (giDirty gi) () `shouldBe` ()+        giCommitDate gi `shouldNotBe` []+        giCommitCount gi `shouldSatisfy` (>= 1)

@@ -0,0 +1,56 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-}++module NormalRepoSpec+    ( spec+    ) where++import Control.Exception+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 regular git 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` "master"+                        giDirty gi `shouldBe` False+                        giCommitDate gi `shouldNotBe` []+                        giCommitCount gi `shouldBe` 1+        describe "getGitRoot" $ do+            it "it gets the expected git root for a regular git repository" $ \fp ->+                getGitRoot fp `shouldReturn` Right fp++setupGitRepo :: (FilePath -> IO ()) -> IO ()+setupGitRepo runTest =+    withSystemTempDirectory "normal" $ \fp -> do+        createDirectoryIfMissing True fp+        let runGit args =+                void $ readCreateProcess ((proc "git" args) {cwd = Just fp}) ""+        runGit ["init"]+        SB.writeFile+            (fp </> "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"+            ]+        runTest fp

@@ -0,0 +1,78 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-}++module RepoWithASubmoduleSpec+    ( spec+    ) where++import Control.Exception+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 both the parent and the child module" $ \(fp1, fp2) -> do+                let sensible fp = do+                        errOrGi <- getGitInfo fp+                        case errOrGi of+                            Left err -> expectationFailure $ show err+                            Right gi -> do+                                length (giHash gi) `shouldNotBe` 128+                                giBranch gi `shouldBe` "master"+                                giDirty gi `shouldBe` False+                                giCommitDate gi `shouldNotBe` []+                                giCommitCount gi `shouldBe` 1+                sensible fp1+                sensible fp2+        describe "getGitRoot" $ do+            it+                "it gets the expected git root for a both the parent and the child module" $ \(fp1, fp2) -> do+                getGitRoot fp1 `shouldReturn` Right fp1+                getGitRoot fp2 `shouldReturn` Right fp2++setupGitRepo :: ((FilePath, FilePath) -> IO ()) -> IO ()+setupGitRepo runTest =+    withSystemTempDirectory "with-submodule" $ \fp -> do+        let fp1 = fp </> "1"+            fp2 = fp </> "2"+        createDirectoryIfMissing True fp1+        createDirectoryIfMissing True fp2+        let runGitIn d args =+                void $ readCreateProcess ((proc "git" args) {cwd = Just d}) ""+            runGit1 = runGitIn fp1+            runGit2 = runGitIn fp2+        runGit1 ["init"]+        runGit2 ["init"]+        SB.writeFile+            (fp2 </> "README.md")+            "This is a readme, you should read it."+        runGit2 ["add", "README.md"]+        runGit2+            [ "-c"+            , "user.name='Test User'"+            , "-c"+            , "user.email='test@example.com'"+            , "commit"+            , "-m"+            , "Initial commit"+            ]+        runGit1 ["submodule", "add", fp2, "2"]+        runGit1+            [ "-c"+            , "user.name='Test User'"+            , "-c"+            , "user.email='test@example.com'"+            , "commit"+            , "-m"+            , "Initial commit"+            ]+        runTest (fp1, fp2)