X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=utils%2Fhpc%2FHpcDraft.hs;h=36256fc261f353a67898bf58b69d90c2d8a00c4d;hb=4799dfb37be922c17451f8e0f7c8d765a7a7eaab;hp=bf672133a10376598aa8c859646c6057c5879e52;hpb=a966047ca5c407f336a633d716d3d7b5ed29d231;p=ghc-hetmet.git diff --git a/utils/hpc/HpcDraft.hs b/utils/hpc/HpcDraft.hs index bf67213..36256fc 100644 --- a/utils/hpc/HpcDraft.hs +++ b/utils/hpc/HpcDraft.hs @@ -14,8 +14,12 @@ import HpcUtils import Data.Tree ------------------------------------------------------------------------------ -draft_options = - [ excludeOpt,includeOpt,hpcDirOpt,hsDirOpt,outputOpt ] +draft_options + = excludeOpt + . includeOpt + . srcDirOpt + . hpcDirOpt + . outputOpt draft_plugin = Plugin { name = "draft" , usage = "[OPTION] .. " @@ -55,7 +59,7 @@ makeDraft hpcflags tix = do hash = tixModuleHash tix tixs = tixModuleTixs tix - mix@(Mix filepath timestamp hash tabstop entries) <- readMix (hpcDirs hpcflags) mod + mix@(Mix filepath timestamp hash tabstop entries) <- readMixWithFlags hpcflags mod let forest = createMixEntryDom [ (span,(box,v > 0)) @@ -67,7 +71,7 @@ makeDraft hpcflags tix = do let non_ticked = findNotTickedFromList forest - hs <- readFileFromPath filepath (hsDirs hpcflags) + hs <- readFileFromPath filepath (srcDirs hpcflags) let hsMap :: Map.Map Int String hsMap = Map.fromList (zip [1..] $ lines hs) @@ -80,10 +84,10 @@ makeDraft hpcflags tix = do let showPleaseTick :: Int -> PleaseTick -> String showPleaseTick d (TickFun str pos) = - spaces d ++ "tick function \"" ++ head str ++ "\" " + spaces d ++ "tick function \"" ++ last str ++ "\" " ++ "on line " ++ show (firstLine pos) ++ ";" showPleaseTick d (TickExp pos) = - spaces d ++ "tick expression " + spaces d ++ "tick " ++ if '\n' `elem` txt then "at position " ++ show pos ++ ";" else quoteString txt ++ " " ++ "on line " ++ show (firstLine pos) ++ ";" @@ -92,7 +96,7 @@ makeDraft hpcflags tix = do txt = grabHpcPos hsMap pos showPleaseTick d (TickInside [str] pos pleases) = - spaces d ++ "function \"" ++ str ++ "\" {\n" ++ + spaces d ++ "inside \"" ++ str ++ "\" {\n" ++ showPleaseTicks (d + 2) pleases ++ spaces d ++ "}"