aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBen Gamari <ben@smart-cactus.org>2019-10-22 09:36:37 -0400
committerGitHub <noreply@github.com>2019-10-22 09:36:37 -0400
commit08b5533323201342b96987379c374be53ca7541a (patch)
tree7fd7356541db76edab028e3dbbc89b8dc05c1600
parenta7c42a29f7c33f5fdbb04acc3866ec907c2e00f3 (diff)
parentf0b5a2043ff6c527e55fab228d37ee698ce87262 (diff)
Merge pull request #1101 from AndreasPK/withTimingRefactor
Refactor for withTiming changes.
-rw-r--r--haddock-api/src/Haddock.hs10
-rw-r--r--haddock-api/src/Haddock/Interface.hs8
2 files changed, 9 insertions, 9 deletions
diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs
index c8390894..68392ab3 100644
--- a/haddock-api/src/Haddock.hs
+++ b/haddock-api/src/Haddock.hs
@@ -361,7 +361,7 @@ render dflags flags sinceQual qual ifaces installedIfaces extSrcMap = do
let withQuickjump = Flag_QuickJumpIndex `elem` flags
when (Flag_GenIndex `elem` flags) $ do
- withTiming (pure dflags') "ppHtmlIndex" (const ()) $ do
+ withTiming dflags' "ppHtmlIndex" (const ()) $ do
_ <- {-# SCC ppHtmlIndex #-}
ppHtmlIndex odir title pkgStr
themes opt_mathjax opt_contents_url sourceUrls' opt_wiki_urls
@@ -371,7 +371,7 @@ render dflags flags sinceQual qual ifaces installedIfaces extSrcMap = do
copyHtmlBits odir libDir themes withQuickjump
when (Flag_GenContents `elem` flags) $ do
- withTiming (pure dflags') "ppHtmlContents" (const ()) $ do
+ withTiming dflags' "ppHtmlContents" (const ()) $ do
_ <- {-# SCC ppHtmlContents #-}
ppHtmlContents dflags' odir title pkgStr
themes opt_mathjax opt_index_url sourceUrls' opt_wiki_urls
@@ -381,7 +381,7 @@ render dflags flags sinceQual qual ifaces installedIfaces extSrcMap = do
copyHtmlBits odir libDir themes withQuickjump
when (Flag_Html `elem` flags) $ do
- withTiming (pure dflags') "ppHtml" (const ()) $ do
+ withTiming dflags' "ppHtml" (const ()) $ do
_ <- {-# SCC ppHtml #-}
ppHtml dflags' title pkgStr visibleIfaces reexportedIfaces odir
prologue
@@ -416,14 +416,14 @@ render dflags flags sinceQual qual ifaces installedIfaces extSrcMap = do
]
when (Flag_LaTeX `elem` flags) $ do
- withTiming (pure dflags') "ppLatex" (const ()) $ do
+ withTiming dflags' "ppLatex" (const ()) $ do
_ <- {-# SCC ppLatex #-}
ppLaTeX title pkgStr visibleIfaces odir (fmap _doc prologue) opt_latex_style
libDir
return ()
when (Flag_HyperlinkedSource `elem` flags && not (null ifaces)) $ do
- withTiming (pure dflags') "ppHyperlinkedSource" (const ()) $ do
+ withTiming dflags' "ppHyperlinkedSource" (const ()) $ do
_ <- {-# SCC ppHyperlinkedSource #-}
ppHyperlinkedSource odir libDir opt_source_css pretty srcMap ifaces
return ()
diff --git a/haddock-api/src/Haddock/Interface.hs b/haddock-api/src/Haddock/Interface.hs
index f1b2d45e..998116f4 100644
--- a/haddock-api/src/Haddock/Interface.hs
+++ b/haddock-api/src/Haddock/Interface.hs
@@ -60,7 +60,7 @@ import TcRnTypes (tcg_rdr_env)
import Name (nameIsFromExternalPackage, nameOccName)
import OccName (isTcOcc)
import RdrName (unQualOK, gre_name, globalRdrEnvElts)
-import ErrUtils (withTiming)
+import ErrUtils (withTimingD)
#if defined(mingw32_HOST_OS)
import System.IO
@@ -96,7 +96,7 @@ processModules verbosity modules flags extIfaces = do
mods = Set.fromList $ map ifaceMod interfaces
out verbosity verbose "Attaching instances..."
interfaces' <- {-# SCC attachInstances #-}
- withTiming getDynFlags "attachInstances" (const ()) $ do
+ withTimingD "attachInstances" (const ()) $ do
attachInstances (exportedNames, mods) interfaces instIfaceMap ms
out verbosity verbose "Building cross-linking environment..."
@@ -136,7 +136,7 @@ createIfaces verbosity modules flags instIfaceMap = do
where
f (ifaces, ifaceMap, !ms) modSummary = do
x <- {-# SCC processModule #-}
- withTiming getDynFlags "processModule" (const ()) $ do
+ withTimingD "processModule" (const ()) $ do
processModule verbosity modSummary flags ifaceMap instIfaceMap
return $ case x of
Just (iface, ms') -> ( iface:ifaces
@@ -155,7 +155,7 @@ processModule verbosity modsum flags modMap instIfaceMap = do
if not $ isBootSummary modsum then do
out verbosity verbose "Creating interface..."
(interface, msgs) <- {-# SCC createIterface #-}
- withTiming getDynFlags "createInterface" (const ()) $ do
+ withTimingD "createInterface" (const ()) $ do
runWriterGhc $ createInterface tm flags modMap instIfaceMap
-- We need to keep track of which modules were somehow in scope so that when