From c2792423039fc62d809bb56a5f9f57494d05176b Mon Sep 17 00:00:00 2001 From: Ian Lynagh Date: Thu, 3 Dec 2009 13:22:59 +0000 Subject: [PATCH] Whitespace only --- utils/hpc/HpcMarkup.hs | 378 ++++++++++++++++++++++++------------------------ 1 file changed, 189 insertions(+), 189 deletions(-) diff --git a/utils/hpc/HpcMarkup.hs b/utils/hpc/HpcMarkup.hs index 68a16fa..ea6f436 100644 --- a/utils/hpc/HpcMarkup.hs +++ b/utils/hpc/HpcMarkup.hs @@ -23,7 +23,7 @@ import qualified HpcSet as Set ------------------------------------------------------------------------------ markup_options :: FlagOptSeq -markup_options +markup_options = excludeOpt . includeOpt . srcDirOpt @@ -34,22 +34,22 @@ markup_options markup_plugin :: Plugin markup_plugin = Plugin { name = "markup" - , usage = "[OPTION] .. [ [ ..]]" - , options = markup_options - , summary = "Markup Haskell source with program coverage" - , implementation = markup_main - , init_flags = default_flags - , final_flags = default_final_flags - } + , usage = "[OPTION] .. [ [ ..]]" + , options = markup_options + , summary = "Markup Haskell source with program coverage" + , implementation = markup_main + , init_flags = default_flags + , final_flags = default_final_flags + } ------------------------------------------------------------------------------ markup_main :: Flags -> [String] -> IO () markup_main flags (prog:modNames) = do - let hpcflags1 = flags - { includeMods = Set.fromList modNames - `Set.union` - includeMods flags } + let hpcflags1 = flags + { includeMods = Set.fromList modNames + `Set.union` + includeMods flags } let Flags { funTotals = theFunTotals , altHighlight = invertOutput @@ -63,9 +63,9 @@ markup_main flags (prog:modNames) = do mods <- sequence [ genHtmlFromMod dest_dir hpcflags1 tix theFunTotals invertOutput - | tix <- tixs - , allowModule hpcflags1 (tixModuleName tix) - ] + | tix <- tixs + , allowModule hpcflags1 (tixModuleName tix) + ] let index_name = "hpc_index" index_fun = "hpc_index_fun" @@ -77,58 +77,58 @@ markup_main flags (prog:modNames) = do putStrLn $ "Writing: " ++ (filename ++ ".html") - writeFileUsing (dest_dir ++ "/" ++ filename ++ ".html") $ - "" ++ - "\n" ++ - "\n" ++ - "" ++ - "" ++ - "" ++ - "" ++ - "" ++ - "" ++ - "" ++ - "" ++ - "" ++ - "" ++ - "" ++ - "" ++ - "" ++ - "" ++ - concat [ showModuleSummary (modName,fileName,modSummary) - | (modName,fileName,modSummary) <- mods' - ] ++ - "" ++ - showTotalSummary (mconcat - [ modSummary - | (_,_,modSummary) <- mods' - ]) - ++ "
moduleTop Level DefinitionsAlternativesExpressions
%covered / total%covered / total%covered / total
\n" + writeFileUsing (dest_dir ++ "/" ++ filename ++ ".html") $ + "" ++ + "\n" ++ + "\n" ++ + "" ++ + "" ++ + "" ++ + "" ++ + "" ++ + "" ++ + "" ++ + "" ++ + "" ++ + "" ++ + "" ++ + "" ++ + "" ++ + "" ++ + concat [ showModuleSummary (modName,fileName,modSummary) + | (modName,fileName,modSummary) <- mods' + ] ++ + "" ++ + showTotalSummary (mconcat + [ modSummary + | (_,_,modSummary) <- mods' + ]) + ++ "
moduleTop Level DefinitionsAlternativesExpressions
%covered / total%covered / total%covered / total
\n" writeSummary index_name $ \ (n1,_,_) (n2,_,_) -> compare n1 n2 - - writeSummary index_fun $ \ (_,_,s1) (_,_,s2) -> + + writeSummary index_fun $ \ (_,_,s1) (_,_,s2) -> compare (percent (topFunTicked s2) (topFunTotal s2)) - (percent (topFunTicked s1) (topFunTotal s1)) + (percent (topFunTicked s1) (topFunTotal s1)) - writeSummary index_alt $ \ (_,_,s1) (_,_,s2) -> + writeSummary index_alt $ \ (_,_,s1) (_,_,s2) -> compare (percent (altTicked s2) (altTotal s2)) - (percent (altTicked s1) (altTotal s1)) + (percent (altTicked s1) (altTotal s1)) - writeSummary index_exp $ \ (_,_,s1) (_,_,s2) -> + writeSummary index_exp $ \ (_,_,s1) (_,_,s2) -> compare (percent (expTicked s2) (expTotal s2)) - (percent (expTicked s1) (expTotal s1)) + (percent (expTicked s1) (expTotal s1)) markup_main _ [] - = hpcError markup_plugin $ "no .tix file or executable name specified" + = hpcError markup_plugin $ "no .tix file or executable name specified" genHtmlFromMod :: String @@ -139,61 +139,61 @@ genHtmlFromMod -> IO (String, [Char], ModuleSummary) genHtmlFromMod dest_dir flags tix theFunTotals invertOutput = do let theHsPath = srcDirs flags - let modName0 = tixModuleName tix + let modName0 = tixModuleName tix (Mix origFile _ _ tabStop mix') <- readMixWithFlags flags (Right tix) let arr_tix :: Array Int Integer arr_tix = listArray (0,length (tixModuleTixs tix) - 1) - $ tixModuleTixs tix + $ tixModuleTixs tix let tickedWith :: Int -> Integer - tickedWith n = arr_tix ! n + tickedWith n = arr_tix ! n isTicked n = tickedWith n /= 0 let info = [ (pos,theMarkup) - | (gid,(pos,boxLabel)) <- zip [0 ..] mix' - , let binBox = case (isTicked gid,isTicked (gid+1)) of - (False,False) -> [] - (True,False) -> [TickedOnlyTrue] - (False,True) -> [TickedOnlyFalse] - (True,True) -> [] + | (gid,(pos,boxLabel)) <- zip [0 ..] mix' + , let binBox = case (isTicked gid,isTicked (gid+1)) of + (False,False) -> [] + (True,False) -> [TickedOnlyTrue] + (False,True) -> [TickedOnlyFalse] + (True,True) -> [] , let tickBox = if isTicked gid - then [IsTicked] - else [NotTicked] - , theMarkup <- case boxLabel of - ExpBox {} -> tickBox - TopLevelBox {} - -> TopLevelDecl theFunTotals (tickedWith gid) : tickBox - LocalBox {} -> tickBox - BinBox _ True -> binBox - _ -> [] + then [IsTicked] + else [NotTicked] + , theMarkup <- case boxLabel of + ExpBox {} -> tickBox + TopLevelBox {} + -> TopLevelDecl theFunTotals (tickedWith gid) : tickBox + LocalBox {} -> tickBox + BinBox _ True -> binBox + _ -> [] ] - let modSummary = foldr (.) id - [ \ st -> - case boxLabel of - ExpBox False - -> st { expTicked = ticked (expTicked st) - , expTotal = succ (expTotal st) - } - ExpBox True - -> st { expTicked = ticked (expTicked st) - , expTotal = succ (expTotal st) - , altTicked = ticked (altTicked st) - , altTotal = succ (altTotal st) - } - TopLevelBox _ -> - st { topFunTicked = ticked (topFunTicked st) - , topFunTotal = succ (topFunTotal st) - } + let modSummary = foldr (.) id + [ \ st -> + case boxLabel of + ExpBox False + -> st { expTicked = ticked (expTicked st) + , expTotal = succ (expTotal st) + } + ExpBox True + -> st { expTicked = ticked (expTicked st) + , expTotal = succ (expTotal st) + , altTicked = ticked (altTicked st) + , altTotal = succ (altTotal st) + } + TopLevelBox _ -> + st { topFunTicked = ticked (topFunTicked st) + , topFunTotal = succ (topFunTotal st) + } _ -> st - | (gid,(_pos,boxLabel)) <- zip [0 ..] mix' + | (gid,(_pos,boxLabel)) <- zip [0 ..] mix' , let ticked = if isTicked gid - then succ - else id + then succ + else id ] $ mempty -- add prefix to modName argument @@ -201,74 +201,74 @@ genHtmlFromMod dest_dir flags tix theFunTotals invertOutput = do let content' = markup tabStop info content let show' = reverse . take 5 . (++ " ") . reverse . show - let addLine n xs = "" ++ show' n ++ " " ++ xs + let addLine n xs = "" ++ show' n ++ " " ++ xs let addLines = unlines . map (uncurry addLine) . zip [1 :: Int ..] . lines let fileName = modName0 ++ ".hs.html" putStrLn $ "Writing: " ++ fileName writeFileUsing (dest_dir ++ "/" ++ fileName) $ - unlines [ "", - "
"] ++ addLines content' ++ "\n
\n\n"; + unlines [ "", + "
"] ++ addLines content' ++ "\n
\n\n"; modSummary `seq` return (modName0,fileName,modSummary) data Loc = Loc !Int !Int - deriving (Eq,Ord,Show) + deriving (Eq,Ord,Show) -data Markup - = NotTicked - | TickedOnlyTrue - | TickedOnlyFalse +data Markup + = NotTicked + | TickedOnlyTrue + | TickedOnlyFalse | IsTicked - | TopLevelDecl - Bool -- display entry totals - Integer + | TopLevelDecl + Bool -- display entry totals + Integer deriving (Eq,Show) -markup :: Int -- ^tabStop - -> [(HpcPos,Markup)] -- random list of tick location pairs - -> String -- text to mark up - -> String -markup tabStop mix str = addMarkup tabStop str (Loc 1 1) [] sortedTickLocs +markup :: Int -- ^tabStop + -> [(HpcPos,Markup)] -- random list of tick location pairs + -> String -- text to mark up + -> String +markup tabStop mix str = addMarkup tabStop str (Loc 1 1) [] sortedTickLocs where tickLocs = [ (Loc ln1 c1,Loc ln2 c2,mark) - | (pos,mark) <- mix - , let (ln1,c1,ln2,c2) = fromHpcPos pos - ] + | (pos,mark) <- mix + , let (ln1,c1,ln2,c2) = fromHpcPos pos + ] sortedTickLocs = sortBy (\(locA1,locZ1,_) (locA2,locZ2,_) -> (locA1,locZ2) `compare` (locA2,locZ1)) tickLocs -addMarkup :: Int -- tabStop - -> String -- text to mark up - -> Loc -- current location - -> [(Loc,Markup)] -- stack of open ticks, with closing location - -> [(Loc,Loc,Markup)] -- sorted list of tick location pairs - -> String +addMarkup :: Int -- tabStop + -> String -- text to mark up + -> Loc -- current location + -> [(Loc,Markup)] -- stack of open ticks, with closing location + -> [(Loc,Loc,Markup)] -- sorted list of tick location pairs + -> String -- check the pre-condition. ---addMarkup tabStop cs loc os ticks +--addMarkup tabStop cs loc os ticks -- | not (isSorted (map fst os)) = error $ "addMarkup: bad closing ordering: " ++ show os ---addMarkup tabStop cs loc os@(_:_) ticks +--addMarkup tabStop cs loc os@(_:_) ticks -- | trace (show (loc,os,take 10 ticks)) False = undefined -- close all open ticks, if we have reached the end addMarkup _ [] _loc os [] = - concatMap (const closeTick) os + concatMap (const closeTick) os addMarkup tabStop cs loc ((o,_):os) ticks | loc > o = closeTick ++ addMarkup tabStop cs loc os ticks @@ -277,23 +277,23 @@ addMarkup tabStop cs loc ((o,_):os) ticks | loc > o = addMarkup tabStop cs loc os ((t1,t2,tik0):ticks) | loc == t1 = case os of - ((_,tik'):_) - | not (allowNesting tik0 tik') + ((_,tik'):_) + | not (allowNesting tik0 tik') -> addMarkup tabStop cs loc os ticks -- already marked or bool within marked bool _ -> openTick tik0 ++ addMarkup tabStop cs loc (addTo (t2,tik0) os) ticks where addTo (t,tik) [] = [(t,tik)] addTo (t,tik) ((t',tik'):xs) | t <= t' = (t,tik):(t',tik'):xs - | otherwise = (t',tik):(t',tik'):xs + | otherwise = (t',tik):(t',tik'):xs addMarkup tabStop0 cs loc os ((t1,_t2,_tik):ticks) | loc > t1 = - -- throw away this tick, because it is from a previous place ?? - addMarkup tabStop0 cs loc os ticks + -- throw away this tick, because it is from a previous place ?? + addMarkup tabStop0 cs loc os ticks -addMarkup tabStop0 ('\n':cs) loc@(Loc ln col) os@((Loc ln2 col2,_):_) ticks - | ln == ln2 && col < col2 - = addMarkup tabStop0 (' ':'\n':cs) loc os ticks +addMarkup tabStop0 ('\n':cs) loc@(Loc ln col) os@((Loc ln2 col2,_):_) ticks + | ln == ln2 && col < col2 + = addMarkup tabStop0 (' ':'\n':cs) loc os ticks addMarkup tabStop0 (c0:cs) loc@(Loc _ p) os ticks = if c0=='\n' && os/=[] then concatMap (const closeTick) (downToTopLevel os) ++ @@ -314,42 +314,42 @@ addMarkup tabStop0 (c0:cs) loc@(Loc _ p) os ticks = escape c = [c] expand :: Int -> String -> String - expand _ "" = "" + expand _ "" = "" expand c ('\t':s) = replicate (c' - c) ' ' ++ expand c' s where c' = tabStopAfter 8 c expand c (' ':s) = ' ' : expand (c+1) s expand _ _ = error "bad character in string for expansion" - + incBy :: Char -> Loc -> Loc incBy '\n' (Loc ln _c) = Loc (succ ln) 1 incBy '\t' (Loc ln c) = Loc ln (tabStopAfter tabStop0 c) incBy _ (Loc ln c) = Loc ln (succ c) - + tabStopAfter :: Int -> Int -> Int tabStopAfter tabStop c = fromJust (find (>c) [1,(tabStop + 1)..]) - + addMarkup tabStop cs loc os ticks = "ERROR: " ++ show (take 10 cs,tabStop,loc,take 10 os,take 10 ticks) openTick :: Markup -> String -openTick NotTicked = "" -openTick IsTicked = "" -openTick TickedOnlyTrue = "" -openTick TickedOnlyFalse = "" +openTick NotTicked = "" +openTick IsTicked = "" +openTick TickedOnlyTrue = "" +openTick TickedOnlyFalse = "" openTick (TopLevelDecl False _) = openTopDecl -openTick (TopLevelDecl True 0) - = "-- never entered" ++ - openTopDecl -openTick (TopLevelDecl True 1) - = "-- entered once" ++ - openTopDecl -openTick (TopLevelDecl True n0) - = "-- entered " ++ showBigNum n0 ++ " times" ++ openTopDecl +openTick (TopLevelDecl True 0) + = "-- never entered" ++ + openTopDecl +openTick (TopLevelDecl True 1) + = "-- entered once" ++ + openTopDecl +openTick (TopLevelDecl True n0) + = "-- entered " ++ showBigNum n0 ++ " times" ++ openTopDecl where showBigNum n | n <= 9999 = show n - | otherwise = showBigNum' (n `div` 1000) ++ "," ++ showWith (n `mod` 1000) + | otherwise = showBigNum' (n `div` 1000) ++ "," ++ showWith (n `mod` 1000) showBigNum' n | n <= 999 = show n - | otherwise = showBigNum' (n `div` 1000) ++ "," ++ showWith (n `mod` 1000) + | otherwise = showBigNum' (n `div` 1000) ++ "," ++ showWith (n `mod` 1000) showWith n = take 3 $ reverse $ ("000" ++) $ reverse $ show n closeTick :: String @@ -366,17 +366,17 @@ downToTopLevel [] = [] -- build in logic for nesting bin boxes -allowNesting :: Markup -- innermost - -> Markup -- outermost - -> Bool -allowNesting n m | n == m = False -- no need to double nest +allowNesting :: Markup -- innermost + -> Markup -- outermost + -> Bool +allowNesting n m | n == m = False -- no need to double nest allowNesting IsTicked TickedOnlyFalse = False allowNesting IsTicked TickedOnlyTrue = False -allowNesting _ _ = True +allowNesting _ _ = True ------------------------------------------------------------------------------ -data ModuleSummary = ModuleSummary +data ModuleSummary = ModuleSummary { expTicked :: !Int , expTotal :: !Int , topFunTicked :: !Int @@ -389,9 +389,9 @@ data ModuleSummary = ModuleSummary showModuleSummary :: (String, String, ModuleSummary) -> String showModuleSummary (modName,fileName,modSummary) = - "\n" ++ - "  module " - ++ modName ++ "\n" ++ + "\n" ++ + "  module " + ++ modName ++ "\n" ++ showSummary (topFunTicked modSummary) (topFunTotal modSummary) ++ showSummary (altTicked modSummary) (altTotal modSummary) ++ showSummary (expTicked modSummary) (expTotal modSummary) ++ @@ -399,7 +399,7 @@ showModuleSummary (modName,fileName,modSummary) = showTotalSummary :: ModuleSummary -> String showTotalSummary modSummary = - "\n" ++ + "\n" ++ "  Program Coverage Total\n" ++ showSummary (topFunTicked modSummary) (topFunTotal modSummary) ++ showSummary (altTicked modSummary) (altTotal modSummary) ++ @@ -407,22 +407,22 @@ showTotalSummary modSummary = "\n" showSummary :: (Integral t) => t -> t -> String -showSummary ticked total = - "" ++ showP (percent ticked total) ++ "" ++ - "" ++ show ticked ++ "/" ++ show total ++ "" ++ - "" ++ - (case percent ticked total of - Nothing -> " " - Just w -> bar w "bar" - ) ++ "" +showSummary ticked total = + "" ++ showP (percent ticked total) ++ "" ++ + "" ++ show ticked ++ "/" ++ show total ++ "" ++ + "" ++ + (case percent ticked total of + Nothing -> " " + Just w -> bar w "bar" + ) ++ "" where showP Nothing = "- " showP (Just x) = show x ++ "%" bar 0 _ = bar 100 "invbar" bar w inner = "" ++ - "
" ++ - "" ++ - "
" + "" ++ + "" ++ + "
" percent :: (Integral a) => a -> a -> Maybe a percent ticked total = if total == 0 then Nothing else Just (ticked * 100 `div` total) @@ -430,15 +430,15 @@ percent ticked total = if total == 0 then Nothing else Just (ticked * 100 `div` instance Monoid ModuleSummary where mempty = ModuleSummary - { expTicked = 0 - , expTotal = 0 + { expTicked = 0 + , expTotal = 0 , topFunTicked = 0 , topFunTotal = 0 , altTicked = 0 , altTotal = 0 } mappend (ModuleSummary eTik1 eTot1 tTik1 tTot1 aTik1 aTot1) - (ModuleSummary eTik2 eTot2 tTik2 tTot2 aTik2 aTot2) + (ModuleSummary eTik2 eTot2 tTik2 tTot2 aTik2 aTot2) = ModuleSummary (eTik1 + eTik2) (eTot1 + eTot2) (tTik1 + tTik2) (tTot1 + tTot2) (aTik1 + aTik2) (aTot1 + aTot2) @@ -452,7 +452,7 @@ writeFileUsing filename text = do -- packages, and a single .tix file might contain information about -- many package. -#if __GLASGOW_HASKELL__ >= 604 +#if __GLASGOW_HASKELL__ >= 604 -- create the dest_dir if needed when (not (null dest_dir)) $ createDirectoryIfMissing True dest_dir -- 1.7.10.4