HpcUtils.hs 1.42 KB
Newer Older
andy@galois.com's avatar
andy@galois.com committed
1 2
module HpcUtils where

3
import Trace.Hpc.Util (catchIO, HpcPos, fromHpcPos, readFileUtf8)
4
import qualified Data.Map as Map
5
import System.FilePath
andy@galois.com's avatar
andy@galois.com committed
6

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

andy@galois.com's avatar
andy@galois.com committed
11 12 13
-- turns \n into ' '
-- | grab's the text behind a HpcPos; 
grabHpcPos :: Map.Map Int String -> HpcPos -> String
Ian Lynagh's avatar
Ian Lynagh committed
14
grabHpcPos hsMap srcspan = 
andy@galois.com's avatar
andy@galois.com committed
15 16 17 18 19
         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
Ian Lynagh's avatar
Ian Lynagh committed
20
  where (l1,c1,l2,c2) = fromHpcPos srcspan
andy@galois.com's avatar
andy@galois.com committed
21 22 23 24 25
        lns = map (\ n -> case Map.lookup n hsMap of
                           Just ln -> ln
                           Nothing -> error $ "bad line number : " ++ show n
                  ) [l1..l2]

andy@galois.com's avatar
andy@galois.com committed
26 27

readFileFromPath :: (String -> IO String) -> String -> [String] -> IO String
28
readFileFromPath _ filename@('/':_) _ = readFileUtf8 filename
andy@galois.com's avatar
andy@galois.com committed
29 30
readFileFromPath err filename path0 = readTheFile path0
  where
31 32 33
        readTheFile [] = err $ "could not find " ++ show filename
                                 ++ " in path " ++ show path0
        readTheFile (dir:dirs) =
34
                catchIO (readFileUtf8 (dir </> filename))
35
                        (\ _ -> readTheFile dirs)