2 module FilenameDescr where
11 -- We can't just compare plain filenames, because versions numbers of GHC
12 -- and the libaries will vary. So we use FilenameDescr instead, which
13 -- abstracts out the version numbers.
14 type FilenameDescr = [FilenameDescrBit]
15 data FilenameDescrBit = VersionOf String
19 deriving (Show, Eq, Ord)
21 normalise :: FilenameDescr -> FilenameDescr
24 normalise (FP x1 : FP x2 : xs) = normalise (FP (x1 ++ x2) : xs)
25 normalise (x : xs) = x : normalise xs
27 -- Sanity check that the FilenameDescr matches the filename in the tar line
28 checkContent :: BuildInfo -> (FilenameDescr, TarLine) -> Errors
29 checkContent buildInfo (fd, tl)
30 = let fn = tlFileName tl
31 in case flattenFilenameDescr buildInfo fd of
35 else ["checkContent: Can't happen: filename mismatch: " ++ show fn]
39 flattenFilenameDescr :: BuildInfo -> FilenameDescr
40 -> Either Errors FilePath
41 flattenFilenameDescr buildInfo fd = case partitionEithers (map f fd) of
42 ([], strs) -> Right (concat strs)
43 (errs, _) -> Left (concat errs)
44 where f (FP fp) = Right fp
46 = case lookup thing (biThingVersionMap buildInfo) of
48 Nothing -> Left ["Can't happen: thing has no version in mapping"]
50 = case lookup thing (biThingHashMap buildInfo) of
52 Nothing -> Left ["Can't happen: thing has no hash in mapping"]
53 f Ways = case biMaybeWays buildInfo of
54 Just ways -> Right $ intercalate "-" ways
55 Nothing -> Left ["Can't happen: No ways, but Ways is used"]