testsuite/haddock: strip version identifiers and unit hashes from html tests

(cherry picked from commit fbf0889e)

utils/haddock/haddock-test/src/Test/Haddock/Xhtml.hs

@@ -8,6 +8,7 @@ module Test.Haddock.Xhtml
   , stripIdsWhen
   , stripFooter
   , fixAttrValueWhen
+  , stripVersions
   ) where
 
 {-
@@ -22,7 +23,7 @@ and since the `xhtml` library already handles the pretty-printing aspect,
 this would appear to be a reasonable compromise for now.
 -}
 
-import Data.Char (isSpace)
+import Data.Char (isSpace, isAlphaNum)
 import Data.List (isPrefixOf, stripPrefix)
 
 -- | Simple wrapper around the pretty-printed HTML source
@@ -142,3 +143,18 @@ stripFooter (Xml body) = Xml (findDiv body)
           Just valRest''
       | otherwise =
           dropToDiv cs
+
+-- | Strip strings of the form <pkg>-<version>-<hash>
+-- to just <pkg>
+stripVersions :: [String] -> Xml -> Xml
+stripVersions xs (Xml body) = Xml $ foldr id body $ map go xs
+  where
+    go pkg "" = ""
+    go pkg body@(x:body') = case stripPrefix pkg body of
+      Just ('-':rest)
+        | (version,'-':rest') <- span (/= '-') rest
+        , all (`elem` ('.':['0'..'9'])) version
+        , let (hash, rest'') = span isAlphaNum rest'
+        -> pkg ++ go pkg rest''
+      _ -> x:go pkg body'
+

utils/haddock/html-test/Main.hs

@@ -42,7 +42,7 @@ main = do
 
 stripIfRequired :: String -> Xml -> Xml
 stripIfRequired mdl =
-    stripLinks' . stripFooter
+    stripLinks' . stripFooter . stripVersions ["base"]
   where
     stripLinks'
         | mdl `elem` preserveLinksModules = id

utils/haddock/html-test/ref/Bug1004.html

@@ -210,7 +210,7 @@
 				  >D1</a
 				  > ('<a href="#" title="GHC.Generics"
 				  >MetaData</a
-				  > &quot;Product&quot; &quot;Data.Functor.Product&quot; &quot;base-4.20.0.0-inplace&quot; '<a href="#" title="Data.Bool"
+				  > &quot;Product&quot; &quot;Data.Functor.Product&quot; &quot;base&quot; '<a href="#" title="Data.Bool"
 				  >False</a
 				  >) (<a href="#" title="GHC.Generics"
 				  >C1</a
@@ -2037,7 +2037,7 @@
 				  >D1</a
 				  > ('<a href="#" title="GHC.Generics"
 				  >MetaData</a
-				  > &quot;Product&quot; &quot;Data.Functor.Product&quot; &quot;base-4.20.0.0-inplace&quot; '<a href="#" title="Data.Bool"
+				  > &quot;Product&quot; &quot;Data.Functor.Product&quot; &quot;base&quot; '<a href="#" title="Data.Bool"
 				  >False</a
 				  >) (<a href="#" title="GHC.Generics"
 				  >C1</a
@@ -2510,7 +2510,7 @@
 			>D1</a
 			> ('<a href="#" title="GHC.Generics"
 			>MetaData</a
-			> &quot;Product&quot; &quot;Data.Functor.Product&quot; &quot;base-4.20.0.0-inplace&quot; '<a href="#" title="Data.Bool"
+			> &quot;Product&quot; &quot;Data.Functor.Product&quot; &quot;base&quot; '<a href="#" title="Data.Bool"
 			>False</a
 			>) (<a href="#" title="GHC.Generics"
 			>C1</a
@@ -2604,7 +2604,7 @@
 			>D1</a
 			> ('<a href="#" title="GHC.Generics"
 			>MetaData</a
-			> &quot;Product&quot; &quot;Data.Functor.Product&quot; &quot;base-4.20.0.0-inplace&quot; '<a href="#" title="Data.Bool"
+			> &quot;Product&quot; &quot;Data.Functor.Product&quot; &quot;base&quot; '<a href="#" title="Data.Bool"
 			>False</a
 			>) (<a href="#" title="GHC.Generics"
 			>C1</a

utils/haddock/html-test/ref/Bug548.html

@@ -186,7 +186,7 @@
 				  >D1</a
 				  > ('<a href="#" title="GHC.Generics"
 				  >MetaData</a
-				  > &quot;WrappedArrow&quot; &quot;Control.Applicative&quot; &quot;base-4.20.0.0-inplace&quot; '<a href="#" title="Data.Bool"
+				  > &quot;WrappedArrow&quot; &quot;Control.Applicative&quot; &quot;base&quot; '<a href="#" title="Data.Bool"
 				  >True</a
 				  >) (<a href="#" title="GHC.Generics"
 				  >C1</a
@@ -792,7 +792,7 @@
 				  >D1</a
 				  > ('<a href="#" title="GHC.Generics"
 				  >MetaData</a
-				  > &quot;WrappedArrow&quot; &quot;Control.Applicative&quot; &quot;base-4.20.0.0-inplace&quot; '<a href="#" title="Data.Bool"
+				  > &quot;WrappedArrow&quot; &quot;Control.Applicative&quot; &quot;base&quot; '<a href="#" title="Data.Bool"
 				  >True</a
 				  >) (<a href="#" title="GHC.Generics"
 				  >C1</a
@@ -903,7 +903,7 @@
 			>D1</a
 			> ('<a href="#" title="GHC.Generics"
 			>MetaData</a
-			> &quot;WrappedArrow&quot; &quot;Control.Applicative&quot; &quot;base-4.20.0.0-inplace&quot; '<a href="#" title="Data.Bool"
+			> &quot;WrappedArrow&quot; &quot;Control.Applicative&quot; &quot;base&quot; '<a href="#" title="Data.Bool"
 			>True</a
 			>) (<a href="#" title="GHC.Generics"
 			>C1</a
@@ -973,7 +973,7 @@
 			>D1</a
 			> ('<a href="#" title="GHC.Generics"
 			>MetaData</a
-			> &quot;WrappedArrow&quot; &quot;Control.Applicative&quot; &quot;base-4.20.0.0-inplace&quot; '<a href="#" title="Data.Bool"
+			> &quot;WrappedArrow&quot; &quot;Control.Applicative&quot; &quot;base&quot; '<a href="#" title="Data.Bool"
 			>True</a
 			>) (<a href="#" title="GHC.Generics"
 			>C1</a