diff options
author | David Feuer <David.Feuer@gmail.com> | 2014-10-01 23:34:29 +0200 |
---|---|---|
committer | Joachim Breitner <mail@joachim-breitner.de> | 2014-10-02 22:13:29 +0200 |
commit | 9bf5228fdc1937f44901a945553eea3cb0f14faa (patch) | |
tree | 243925bae6f8869cca1df8595c17c0467b9d5998 /utils/hpc/HpcMarkup.hs | |
parent | d6d5c127b86dc186b25add2843cb83fc12e72a85 (diff) | |
download | haskell-9bf5228fdc1937f44901a945553eea3cb0f14faa.tar.gz |
Use dropWhileEndLE p instead of reverse . dropWhile p . reverse
Summary: Using `dropWhileEndLE` tends to be faster and easier to read
than the `reverse . dropWhile p . reverse` idiom. This also cleans up
some other, nearby, messes. Fix #9616 (incorrect number formatting
potentially leading to incorrect numbers in output).
Test Plan: Run validate
Reviewers: thomie, rwbarton, nomeata, austin
Reviewed By: nomeata, austin
Subscribers: simonmar, ezyang, carter, thomie
Projects: #ghc
Differential Revision: https://phabricator.haskell.org/D259
GHC Trac Issues: #9623, #9616
Conflicts:
compiler/basicTypes/OccName.lhs
Diffstat (limited to 'utils/hpc/HpcMarkup.hs')
-rw-r--r-- | utils/hpc/HpcMarkup.hs | 25 |
1 files changed, 19 insertions, 6 deletions
diff --git a/utils/hpc/HpcMarkup.hs b/utils/hpc/HpcMarkup.hs index 8fd9e4226c..c294b6a94e 100644 --- a/utils/hpc/HpcMarkup.hs +++ b/utils/hpc/HpcMarkup.hs @@ -140,6 +140,16 @@ charEncodingTag = "<meta http-equiv=\"Content-Type\" " ++ "content=\"text/html; " ++ "charset=" ++ show localeEncoding ++ "\">" +-- Add characters to the left of a string until it is at least as +-- large as requested. +padLeft :: Int -> Char -> String -> String +padLeft n c str = go n str + where + -- If the string is already long enough, stop traversing it. + go 0 _ = str + go k [] = replicate k c ++ str + go k (_:xs) = go (k-1) xs + genHtmlFromMod :: String -> Flags @@ -210,8 +220,7 @@ genHtmlFromMod dest_dir flags tix theFunTotals invertOutput = do content <- readFileFromPath (hpcError markup_plugin) origFile theHsPath let content' = markup tabStop info content - let show' = reverse . take 5 . (++ " ") . reverse . show - let addLine n xs = "<span class=\"lineno\">" ++ show' n ++ " </span>" ++ xs + let addLine n xs = "<span class=\"lineno\">" ++ padLeft 5 ' ' (show n) ++ " </span>" ++ xs let addLines = unlines . map (uncurry addLine) . zip [1 :: Int ..] . lines let fileName = modName0 ++ ".hs.html" putStrLn $ "Writing: " ++ fileName @@ -363,10 +372,14 @@ openTick (TopLevelDecl True 1) openTick (TopLevelDecl True n0) = "<span class=\"funcount\">-- entered " ++ showBigNum n0 ++ " times</span>" ++ openTopDecl where showBigNum n | n <= 9999 = show n - | otherwise = showBigNum' (n `div` 1000) ++ "," ++ showWith (n `mod` 1000) + | otherwise = case n `quotRem` 1000 of + (q, r) -> showBigNum' q ++ "," ++ showWith r showBigNum' n | n <= 999 = show n - | otherwise = showBigNum' (n `div` 1000) ++ "," ++ showWith (n `mod` 1000) - showWith n = take 3 $ reverse $ ("000" ++) $ reverse $ show n + | otherwise = case n `quotRem` 1000 of + (q, r) -> showBigNum' q ++ "," ++ showWith r + showWith n = padLeft 3 '0' $ show n + + closeTick :: String closeTick = "</span>" @@ -462,7 +475,7 @@ instance Monoid ModuleSummary where writeFileUsing :: String -> String -> IO () writeFileUsing filename text = do - let dest_dir = reverse . dropWhile (\ x -> x /= '/') . reverse $ filename + let dest_dir = dropWhileEndLE (\ x -> x /= '/') $ filename -- We need to check for the dest_dir each time, because we use sub-dirs for -- packages, and a single .tix file might contain information about |