Skip to content
Snippets Groups Projects
Forked from Glasgow Haskell Compiler / GHC
11377 commits behind, 6 commits ahead of the upstream repository.
  • Alexey Kuleshevich's avatar
    ef8a08e0
    hpc: Fix encoding issues. Add test for and fix #17073 · ef8a08e0
    Alexey Kuleshevich authored and Marge Bot's avatar Marge Bot committed
    
    * Make sure files are being read/written in UTF-8. Set encoding while writing
      HTML output. Also set encoding while writing and reading .tix files although
      we don't yet have a ticket complaining that this poses problems.
    * Set encoding in html header to utf8
    * Upgrade to new version of 'hpc' library and reuse `readFileUtf8`
      and `writeFileUtf8` functions
    * Update git submodule for `hpc`
    * Bump up `hpc` executable version
    
    Co-authored-by: default avatarBen Gamari <ben@smart-cactus.org>
    ef8a08e0
    History
    hpc: Fix encoding issues. Add test for and fix #17073
    Alexey Kuleshevich authored and Marge Bot's avatar Marge Bot committed
    
    * Make sure files are being read/written in UTF-8. Set encoding while writing
      HTML output. Also set encoding while writing and reading .tix files although
      we don't yet have a ticket complaining that this poses problems.
    * Set encoding in html header to utf8
    * Upgrade to new version of 'hpc' library and reuse `readFileUtf8`
      and `writeFileUtf8` functions
    * Update git submodule for `hpc`
    * Bump up `hpc` executable version
    
    Co-authored-by: default avatarBen Gamari <ben@smart-cactus.org>
Code owners
Assign users and groups as approvers for specific file changes. Learn more.
HpcUtils.hs 1.42 KiB
module HpcUtils where

import Trace.Hpc.Util (catchIO, HpcPos, fromHpcPos, readFileUtf8)
import qualified Data.Map as Map
import System.FilePath

dropWhileEndLE :: (a -> Bool) -> [a] -> [a]
-- Spec: dropWhileEndLE p = reverse . dropWhile p . reverse
dropWhileEndLE p = foldr (\x r -> if null r && p x then [] else x:r) []

-- turns \n into ' '
-- | grab's the text behind a HpcPos; 
grabHpcPos :: Map.Map Int String -> HpcPos -> String
grabHpcPos hsMap srcspan = 
         case lns of
           [ln] -> (take ((c2 - c1) + 1) $ drop (c1 - 1) ln)
           _ -> let lns1 = drop (c1 -1) (head lns) : tail lns
                    lns2 = init lns1 ++ [take (c2 + 1) (last lns1) ]
                 in foldl1 (\ xs ys -> xs ++ "\n" ++ ys) lns2
  where (l1,c1,l2,c2) = fromHpcPos srcspan
        lns = map (\ n -> case Map.lookup n hsMap of
                           Just ln -> ln
                           Nothing -> error $ "bad line number : " ++ show n
                  ) [l1..l2]


readFileFromPath :: (String -> IO String) -> String -> [String] -> IO String
readFileFromPath _ filename@('/':_) _ = readFileUtf8 filename
readFileFromPath err filename path0 = readTheFile path0
  where
        readTheFile [] = err $ "could not find " ++ show filename
                                 ++ " in path " ++ show path0
        readTheFile (dir:dirs) =
                catchIO (readFileUtf8 (dir </> filename))
                        (\ _ -> readTheFile dirs)