diff --git a/hadrian/src/Hadrian/Utilities.hs b/hadrian/src/Hadrian/Utilities.hs index 7d901c460233c4081260645f906ae00bff5a181d..ef06209b946c4bddf47d3443f6e0b7dff851b07d 100644 --- a/hadrian/src/Hadrian/Utilities.hs +++ b/hadrian/src/Hadrian/Utilities.hs @@ -138,7 +138,10 @@ unifyPath = toStandard . normaliseEx -- | Combine paths with a forward slash regardless of platform. (-/-) :: FilePath -> FilePath -> FilePath -_ -/- b | isAbsolute b && not (isAbsolute $ tail b) = b +_ -/- b + | isAbsolute b + , _:b' <- b + , not (isAbsolute b') = b "" -/- b = b a -/- b | last a == '/' = a ++ b @@ -615,7 +618,8 @@ renderLibrary name lib synopsis = renderBox $ -- | ipsum | -- \----------/ renderBox :: [String] -> String -renderBox ls = tail $ concatMap ('\n' :) (boxTop : map renderLine ls ++ [boxBot]) +renderBox ls = + drop 1 $ concatMap ('\n' :) (boxTop : map renderLine ls ++ [boxBot]) where -- Minimum total width of the box in characters minimumBoxWidth = 32 diff --git a/hadrian/src/Oracles/ModuleFiles.hs b/hadrian/src/Oracles/ModuleFiles.hs index 41a3141f6529d087d3c2c06269ff43beebe226d2..f42de97af090acb8222c9d33d2b043dec9cebf21 100644 --- a/hadrian/src/Oracles/ModuleFiles.hs +++ b/hadrian/src/Oracles/ModuleFiles.hs @@ -170,10 +170,12 @@ moduleFilesOracle = void $ do let pairs = sort $ mainpairs ++ [ (encodeModule d f, f) | (fs, d) <- result, f <- fs ] multi = [ (m, f1, f2) | (m, f1):(n, f2):_ <- tails pairs, m == n ] - unless (null multi) $ do - let (m, f1, f2) = head multi - error $ "Module " ++ m ++ " has more than one source file: " - ++ f1 ++ " and " ++ f2 ++ "." + + case multi of + [] -> return () + (m, f1, f2) : _ -> + fail $ "Module " ++ m ++ " has more than one source file: " + ++ f1 ++ " and " ++ f2 ++ "." return $ lookupAll modules pairs -- Optimisation: we discard Haskell files here, because they are never used diff --git a/hadrian/src/Settings/Parser.hs b/hadrian/src/Settings/Parser.hs index d93f71ae06e3abfe5cfa0d4438147430ef1194cd..f1493cd60d9ac7aba837c3a02e6c906dc4a83c65 100644 --- a/hadrian/src/Settings/Parser.hs +++ b/hadrian/src/Settings/Parser.hs @@ -184,14 +184,11 @@ instance Match SettingsM where matchStringSettingsM :: String -> SettingsM () matchStringSettingsM s = do ks <- State.get - if null ks - then throwError $ "expected " ++ show s ++ ", got nothing" - else go (head ks) - - where go k - | k == s = State.modify tail - | otherwise = throwError $ - "expected " ++ show s ++ ", got " ++ show k + case ks of + [] -> throwError $ "expected " ++ show s ++ ", got nothing" + k:_ + | k == s -> State.modify (drop 1) + | otherwise -> throwError $ "expected " ++ show s ++ ", got " ++ show k matchOneOfSettingsM :: [SettingsM a] -> SettingsM a matchOneOfSettingsM acts = StateT $ \k -> do