Bindist comparison tool: Handle differences in the library ways nicely

[ghc-hetmet.git] / distrib / compare / FilenameDescr.hs

diff --git a/distrib/compare/FilenameDescr.hs b/distrib/compare/FilenameDescr.hs
index 5952058..4b5898e 100644 (file)
--- a/distrib/compare/FilenameDescr.hs
+++ b/distrib/compare/FilenameDescr.hs
@@ -2,7 +2,9 @@
 module FilenameDescr where
 
 import Data.Either
+import Data.List
 
+import BuildInfo
 import Utils
 import Tar
 
@@ -12,6 +14,7 @@ import Tar
 type FilenameDescr = [FilenameDescrBit]
 data FilenameDescrBit = VersionOf String
                       | FP String
+                      | Ways
     deriving (Show, Eq, Ord)
 
 normalise :: FilenameDescr -> FilenameDescr
@@ -20,24 +23,11 @@ normalise [x] = [x]
 normalise (FP x1 : FP x2 : xs) = normalise (FP (x1 ++ x2) : xs)
 normalise (x : xs) = x : normalise xs
 
--- Mapping from thing (e.g. "Cabal") to version (e.g. "1.10.0.0")
-type ThingVersionMap = [(String, String)]
-
-addThingVersion :: ThingVersionMap -> String -> String -> Maybe ThingVersionMap
-addThingVersion mapping thing version
- = case lookup thing mapping of
-   Just version' ->
-       if version == version'
-       then Just mapping
-       else Nothing
-   Nothing ->
-       Just ((thing, version) : mapping)
-
 -- Sanity check that the FilenameDescr matches the filename in the tar line
-checkContent :: ThingVersionMap -> (FilenameDescr, TarLine) -> Errors
-checkContent mapping (fd, tl)
+checkContent :: BuildInfo -> (FilenameDescr, TarLine) -> Errors
+checkContent buildInfo (fd, tl)
  = let fn = tlFileName tl
-   in case flattenFilenameDescr mapping fd of
+   in case flattenFilenameDescr buildInfo fd of
       Right fn' ->
           if fn' == fn
           then []
@@ -45,14 +35,15 @@ checkContent mapping (fd, tl)
       Left errs ->
           errs
 
-flattenFilenameDescr :: ThingVersionMap -> FilenameDescr
+flattenFilenameDescr :: BuildInfo -> FilenameDescr
                      -> Either Errors FilePath
-flattenFilenameDescr mapping fd = case partitionEithers (map f fd) of
-                                  ([], strs) -> Right (concat strs)
-                                  (errs, _) -> Left (concat errs)
+flattenFilenameDescr buildInfo fd = case partitionEithers (map f fd) of
+                                    ([], strs) -> Right (concat strs)
+                                    (errs, _) -> Left (concat errs)
     where f (FP fp) = Right fp
           f (VersionOf thing)
-           = case lookup thing mapping of
+           = case lookup thing (biThingVersionMap buildInfo) of
              Just v -> Right v
              Nothing -> Left ["Can't happen: thing has no version in mapping"]
+          f Ways = Right $ intercalate "-" $ biWays buildInfo