Check if commit message mentions submodule name

Author: thomie

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 <> ")"