diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,9 @@ # ChangeLog for githash +## 0.1.0.1 + +* Update the test suite + ## 0.1.0.0 * Initial release diff --git a/githash.cabal b/githash.cabal --- a/githash.cabal +++ b/githash.cabal @@ -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 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 diff --git a/src/GitHash.hs b/src/GitHash.hs --- a/src/GitHash.hs +++ b/src/GitHash.hs @@ -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 diff --git a/test/GitHashSpec.hs b/test/GitHashSpec.hs --- a/test/GitHashSpec.hs +++ b/test/GitHashSpec.hs @@ -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) diff --git a/test/NormalRepoSpec.hs b/test/NormalRepoSpec.hs new file mode 100644 --- /dev/null +++ b/test/NormalRepoSpec.hs @@ -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 diff --git a/test/RepoWithASubmoduleSpec.hs b/test/RepoWithASubmoduleSpec.hs new file mode 100644 --- /dev/null +++ b/test/RepoWithASubmoduleSpec.hs @@ -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)