module FilenameDescr where
import Data.Either
+import Data.List
+import BuildInfo
import Utils
import Tar
-- abstracts out the version numbers.
type FilenameDescr = [FilenameDescrBit]
data FilenameDescrBit = VersionOf String
+ | HashOf String
| FP String
+ | Ways
deriving (Show, Eq, Ord)
normalise :: FilenameDescr -> FilenameDescr
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 []
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 (HashOf thing)
+ = case lookup thing (biThingHashMap buildInfo) of
+ Just v -> Right v
+ Nothing -> Left ["Can't happen: thing has no hash in mapping"]
+ f Ways = case biMaybeWays buildInfo of
+ Just ways -> Right $ intercalate "-" ways
+ Nothing -> Left ["Can't happen: No ways, but Ways is used"]