Commit fafec426 authored by Andrey Mokhov's avatar Andrey Mokhov
Browse files

Fix detectWay and way parsing.

parent 83cd6c55
...@@ -29,7 +29,7 @@ data WayUnit = Threaded ...@@ -29,7 +29,7 @@ data WayUnit = Threaded
| Dynamic | Dynamic
| Parallel | Parallel
| GranSim | GranSim
deriving Enum deriving (Eq, Enum)
instance Show WayUnit where instance Show WayUnit where
show unit = case unit of show unit = case unit of
...@@ -61,10 +61,15 @@ instance Show Way where ...@@ -61,10 +61,15 @@ instance Show Way where
tag = intercalate "_" . map show . wayToUnits $ way tag = intercalate "_" . map show . wayToUnits $ way
instance Read Way where instance Read Way where
readsPrec _ s = readsPrec _ s = if s == "v" then [(vanilla, "")] else result
if s == "v" where
then [(vanilla, "")] uniqueReads token = case reads token of
else [(wayFromUnits . map read . words . replaceEq '_' ' ' $ s, "")] [(unit, "")] -> Just unit
_ -> Nothing
units = map uniqueReads . words . replaceEq '_' ' ' $ s
result = if Nothing `elem` units
then []
else [(wayFromUnits . map fromJust $ units, "")]
instance Eq Way where instance Eq Way where
Way a == Way b = a == b Way a == Way b = a == b
...@@ -128,7 +133,7 @@ libsuf way @ (Way set) = ...@@ -128,7 +133,7 @@ libsuf way @ (Way set) =
-- Detect way from a given filename. Returns Nothing if there is no match: -- Detect way from a given filename. Returns Nothing if there is no match:
-- * detectWay "foo/bar.hi" == Just vanilla -- * detectWay "foo/bar.hi" == Just vanilla
-- * detectWay "baz.thr_p_o" == Just threadedProfiling -- * detectWay "baz.thr_p_o" == Just threadedProfiling
-- * detectWay "qwe.phi" == Nothing (expected "qwe.p_hi") -- * detectWay "qwe.ph_i" == Nothing (expected "qwe.p_hi")
-- * detectWay "xru.p_ghc7.11.20141222.dll" == Just profiling -- * detectWay "xru.p_ghc7.11.20141222.dll" == Just profiling
detectWay :: FilePath -> Maybe Way detectWay :: FilePath -> Maybe Way
detectWay file = case reads prefix of detectWay file = case reads prefix of
...@@ -136,11 +141,11 @@ detectWay file = case reads prefix of ...@@ -136,11 +141,11 @@ detectWay file = case reads prefix of
_ -> Nothing _ -> Nothing
where where
extension = takeExtension file extension = takeExtension file
prefixed = if extension `notElem` ["so", "dll", "dynlib"] prefixed = if extension `notElem` [".so", ".dll", ".dynlib"]
then extension then extension
else takeExtension . dropExtension . else takeExtension . dropExtension .
dropExtension . dropExtension $ file dropExtension . dropExtension $ file
prefix = dropWhileEnd (== '_') . dropWhileEnd (/= '_') $ prefixed prefix = drop 1 . dropWhileEnd (== '_') . dropWhileEnd (/= '_') $ prefixed
-- Given a path, an extension suffix, and a file name check if the latter: -- Given a path, an extension suffix, and a file name check if the latter:
-- 1) conforms to pattern 'path//*suffix' -- 1) conforms to pattern 'path//*suffix'
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment