File: RepoWithASubmoduleSpec.hs

package info (click to toggle)
haskell-githash 0.1.7.0-2
  • links: PTS
  • area: main
  • in suites: forky, sid, trixie
  • size: 96 kB
  • sloc: haskell: 395; makefile: 6
file content (82 lines) | stat: -rw-r--r-- 2,912 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}

module RepoWithASubmoduleSpec
    ( 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 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` initialBranchName
                                giDirty gi `shouldBe` False
                                giCommitDate gi `shouldNotBe` []
                                giCommitCount gi `shouldBe` 1
                                giCommitMessage gi `shouldBe` "Initial commit"
                                length (giDescribe gi) `shouldBe` 7
                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", "--initial-branch", initialBranchName]
        runGit2 ["init", "--initial-branch", initialBranchName]
        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 ["-c", "protocol.file.allow=always", "submodule", "add", fp2, "2"]
        runGit1
            [ "-c"
            , "user.name='Test User'"
            , "-c"
            , "user.email='test@example.com'"
            , "commit"
            , "-m"
            , "Initial commit"
            ]
        runTest (fp1, fp2)

initialBranchName :: String
initialBranchName = "main"