Check if commit message mentions submodule name

git-haskell-org-hooks.cabal

@@ -16,7 +16,7 @@ executable submodchecker
   other-modules: Common
 
   build-depends:
-    base    >=4.5  && <4.9,
+    base    >=4.5  && <4.10,
     deepseq >=1.1  && <1.5,
     shelly  >=1.6  && <1.7,
     text    >=0.11 && <1.3
@@ -30,7 +30,7 @@ executable validate-commit-msg
   main-is:             validate-commit-msg.hs
 
   build-depends:
-    base    >=4.5  && <4.9,
+    base    >=4.5  && <4.10,
     deepseq >=1.1  && <1.5,
     mtl     >=2.1  && <2.3,
     shelly  >=1.6  && <1.7,
@@ -44,7 +44,7 @@ executable validate-whitespace
   main-is:             validate-whitespace.hs
 
   build-depends:
-    base    >=4.5  && <4.9,
+    base    >=4.5  && <4.10,
     deepseq >=1.1  && <1.5,
     mtl     >=2.1  && <2.3,
     shelly  >=1.6  && <1.7,

src/Common.hs

@@ -82,7 +82,7 @@ gitBranchesContain d ref = do
 
 
 
--- | returns @[(path, (url, key))]@
+-- | returns @[(path, (url, name))]@
 --
 -- may throw exception
 getModules :: FilePath -> GitRef -> Sh [(Text, (Text, Text))]
@@ -99,8 +99,9 @@ getModules d ref = do
               , let (_,key1) = T.break (=='.') (T.init key')
               ]
 
-        ms' = [ (path', (url, k))
+        ms' = [ (path', (url, name))
               | es@((k,_):_) <- groupBy ((==) `on` fst) ms
+              , let (_,name) = T.breakOnEnd "/" k
               , let props = map snd es
               , let url = fromMaybe (error "getModules1") (lookup "url" props)
               , let path' = fromMaybe (error "getModules2") (lookup "path" props)

src/validate-submod-refs.hs

@@ -35,16 +35,21 @@ main = do
           echo $ "Submodule update(s) detected in " <> cid <> ":"
 
           (_, msg) <- gitCatCommit dir cid
+          let msg' = T.toLower msg
 
-          unless ("submodule" `T.isInfixOf` msg) $ do
+          unless ("submodule" `T.isInfixOf` msg') $ do
               echo "*FAIL* commit message does not contain magic 'submodule' word"
               quietExit 1
 
           modMapping <- getModules dir ref
           forM_ smDeltas $ \(smPath,smCid) -> do
               echo $ " " <> smPath <> " => " <> smCid
-              (smUrl,_) <- maybe (fail "failed to lookup repo-url") return $
-                           lookup smPath modMapping
+              (smUrl,name) <- maybe (fail "failed to lookup repo-url") return $
+                              lookup smPath modMapping
+
+              unless (T.toLower name `T.isInfixOf` msg') $ do
+                  echo $ "*FAIL* commit message does not mention '" <> name <> "'"
+                  quietExit 1
 
               if not ("." `T.isPrefixOf` smUrl)
                then echo $ "skipping non-relative Git url (" <> smUrl <> ")"