fix haddock submodule pointer
[ghc-hetmet.git] / utils / hpc / HpcUtils.hs
1 module HpcUtils where
2
3 import Trace.Hpc.Util
4 import qualified Data.Map as Map
5
6 -- turns \n into ' '
7 -- | grab's the text behind a HpcPos; 
8 grabHpcPos :: Map.Map Int String -> HpcPos -> String
9 grabHpcPos hsMap srcspan = 
10          case lns of
11            [ln] -> (take ((c2 - c1) + 1) $ drop (c1 - 1) ln)
12            _ -> let lns1 = drop (c1 -1) (head lns) : tail lns
13                     lns2 = init lns1 ++ [take (c2 + 1) (last lns1) ]
14                  in foldl1 (\ xs ys -> xs ++ "\n" ++ ys) lns2
15   where (l1,c1,l2,c2) = fromHpcPos srcspan
16         lns = map (\ n -> case Map.lookup n hsMap of
17                            Just ln -> ln
18                            Nothing -> error $ "bad line number : " ++ show n
19                   ) [l1..l2]
20
21
22 readFileFromPath :: (String -> IO String) -> String -> [String] -> IO String
23 readFileFromPath _ filename@('/':_) _ = readFile filename
24 readFileFromPath err filename path0 = readTheFile path0
25   where
26         readTheFile [] = err $ "could not find " ++ show filename
27                                  ++ " in path " ++ show path0
28         readTheFile (dir:dirs) =
29                 catchIO (do str <- readFile (dir ++ "/" ++ filename)
30                             return str)
31                         (\ _ -> readTheFile dirs)