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
18 deriving (Show, Eq, Ord)
20 normalise :: FilenameDescr -> FilenameDescr
23 normalise (FP x1 : FP x2 : xs) = normalise (FP (x1 ++ x2) : xs)
24 normalise (x : xs) = x : normalise xs
26 -- Sanity check that the FilenameDescr matches the filename in the tar line
27 checkContent :: BuildInfo -> (FilenameDescr, TarLine) -> Errors
28 checkContent buildInfo (fd, tl)
29 = let fn = tlFileName tl
30 in case flattenFilenameDescr buildInfo fd of
34 else ["checkContent: Can't happen: filename mismatch: " ++ show fn]
38 flattenFilenameDescr :: BuildInfo -> FilenameDescr
39 -> Either Errors FilePath
40 flattenFilenameDescr buildInfo fd = case partitionEithers (map f fd) of
41 ([], strs) -> Right (concat strs)
42 (errs, _) -> Left (concat errs)
43 where f (FP fp) = Right fp
45 = case lookup thing (biThingVersionMap buildInfo) of
47 Nothing -> Left ["Can't happen: thing has no version in mapping"]
48 f Ways = Right $ intercalate "-" $ biWays buildInfo