import Control.Monad
import qualified HpcSet as Set
import qualified HpcMap as Map
-import System.Environment
import HpcUtils
import Data.Tree
------------------------------------------------------------------------------
+draft_options :: FlagOptSeq
draft_options
= excludeOpt
. includeOpt
. hpcDirOpt
. outputOpt
+draft_plugin :: Plugin
draft_plugin = Plugin { name = "draft"
, usage = "[OPTION] .. <TIX_FILE>"
, options = draft_options
------------------------------------------------------------------------------
draft_main :: Flags -> [String] -> IO ()
+draft_main _ [] = error "draft_main: unhandled case: []"
draft_main hpcflags (progName:mods) = do
let hpcflags1 = hpcflags
{ includeMods = Set.fromList mods
makeDraft :: Flags -> TixModule -> IO String
makeDraft hpcflags tix = do
- let mod = tixModuleName tix
- hash = tixModuleHash tix
+ let modu = tixModuleName tix
tixs = tixModuleTixs tix
- mix@(Mix filepath timestamp hash tabstop entries) <- readMixWithFlags hpcflags tix
+ (Mix filepath _ _ _ entries) <- readMixWithFlags hpcflags (Right tix)
let forest = createMixEntryDom
- [ (span,(box,v > 0))
- | ((span,box),v) <- zip entries tixs
+ [ (srcspan,(box,v > 0))
+ | ((srcspan,box),v) <- zip entries tixs
]
-- let show' (span,stuff) = show (span,stuff,grabHpcPos hsMap span)
let non_ticked = findNotTickedFromList forest
- hs <- readFileFromPath filepath (srcDirs hpcflags)
+ hs <- readFileFromPath (hpcError draft_plugin) filepath (srcDirs hpcflags)
let hsMap :: Map.Map Int String
hsMap = Map.fromList (zip [1..] $ lines hs)
where
txt = grabHpcPos hsMap pos
- showPleaseTick d (TickInside [str] pos pleases) =
+ showPleaseTick d (TickInside [str] _ pleases) =
spaces d ++ "inside \"" ++ str ++ "\" {\n" ++
showPleaseTicks (d + 2) pleases ++
spaces d ++ "}"
+ showPleaseTick _ (TickInside _ _ _)
+ = error "showPleaseTick: Unhandled case TickInside"
+
showPleaseTicks d pleases = unlines (map (showPleaseTick d) pleases)
spaces d = take d (repeat ' ')
- return $ "module " ++ show (fixPackageSuffix mod) ++ " {\n" ++
+ return $ "module " ++ show (fixPackageSuffix modu) ++ " {\n" ++
showPleaseTicks 2 non_ticked ++ "}"
fixPackageSuffix :: String -> String
-fixPackageSuffix mod = case span (/= '/') mod of
- (before,'/':after) -> before ++ ":" ++ after
- _ -> mod
+fixPackageSuffix modu = case span (/= '/') modu of
+ (before,'/':after) -> before ++ ":" ++ after
+ _ -> modu
data PleaseTick
= TickFun [String] HpcPos
| TickInside [String] HpcPos [PleaseTick]
deriving Show
+mkTickInside :: [String] -> HpcPos -> [PleaseTick]
+ -> [PleaseTick] -> [PleaseTick]
mkTickInside _ _ [] = id
mkTickInside nm pos inside = (TickInside nm pos inside :)
= [ TickFun nm pos ]
findNotTickedFromTree (Node (pos,(LocalBox nm,False):_) _)
= [ TickFun nm pos ]
-findNotTickedFromTree (Node (pos,(TopLevelBox nm,True):others) children)
+findNotTickedFromTree (Node (pos,(TopLevelBox nm,True):_) children)
= mkTickInside nm pos (findNotTickedFromList children) []
findNotTickedFromTree (Node (pos,_:others) children) =
findNotTickedFromTree (Node (pos,others) children)
-findNotTickedFromTree (Node (pos,[]) children) = findNotTickedFromList children
+findNotTickedFromTree (Node (_, []) children) = findNotTickedFromList children
findNotTickedFromList :: [MixEntryDom [(BoxLabel,Bool)]] -> [PleaseTick]
findNotTickedFromList = concatMap findNotTickedFromTree
-readFileFromPath :: String -> [String] -> IO String
-readFileFromPath filename@('/':_) _ = readFile filename
-readFileFromPath filename path0 = readTheFile path0
- where
- readTheFile :: [String] -> IO String
- readTheFile [] = error $ "could not find " ++ show filename
- ++ " in path " ++ show path0
- readTheFile (dir:dirs) =
- catch (do str <- readFile (dir ++ "/" ++ filename)
- return str)
- (\ _ -> readTheFile dirs)