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
|
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Main where
-- base
import Control.Monad
( forM, forM_, unless, when )
import Data.List
( partition )
import Data.Maybe
( mapMaybe )
import System.Environment
( getArgs )
import System.Exit
( ExitCode(..), exitWith )
-- text
import qualified Data.Text as T
import qualified Data.Text.IO as T
( putStrLn )
-- linters-common
import Linters.Common
( GitType(..)
, gitBranchesContain, gitCatCommit, gitDiffTree, gitNormCid
)
--------------------------------------------------------------------------------
main :: IO ()
main = do
dir:refs <- getArgs >>= \case
[] -> fail "usage: lint-submodule-refs <git-repo> [<commit-id>+]"
x -> return x
forM_ (map T.pack refs) $ \ref -> do
(cid,deltas) <- gitDiffTree dir ref
let smDeltas = [ (smPath, smCid) | (_, (GitTypeGitLink, smCid), smPath) <- deltas ]
unless (null smDeltas) $ do
T.putStrLn $ "Submodule update(s) detected in " <> cid <> ":"
(_, msg) <- gitCatCommit dir cid
unless ("submodule" `T.isInfixOf` msg) $ do
T.putStrLn "*FAIL* commit message does not contain magic 'submodule' word."
T.putStrLn "This lint avoids accidental changes to git submodules."
T.putStrLn "Include the word 'submodule' in your commit message to silence this warning, e.g. 'Update submodule'."
exitWith (ExitFailure 1)
bad <- fmap or $ forM smDeltas $ \(smPath,smCid) -> do
T.putStrLn $ " - " <> smPath <> " => " <> smCid
let smAbsPath = dir ++ "/" ++ T.unpack smPath
remoteBranches <- gitBranchesContain smAbsPath smCid
let (wip, nonWip) = partition ("wip/" `T.isPrefixOf`) originBranches
originBranches = mapMaybe isOriginTracking remoteBranches
isOriginTracking = T.stripPrefix "origin/"
let bad = null nonWip
when bad $ do
T.putStrLn $ " *FAIL* commit not found in submodule repo"
T.putStrLn " or not reachable from persistent branches"
T.putStrLn ""
when (not $ null wip) $ do
T.putStrLn " Found the following non-mirrored WIP branches:"
forM_ wip $ \branch -> do
commit <- gitNormCid smAbsPath branch
T.putStrLn $ " - " <> branch <> " -> " <> commit
T.putStrLn ""
pure bad
if bad
then exitWith (ExitFailure 1)
else T.putStrLn " OK"
|
