diff options
author | Andreas Klebinger <klebinger.andreas@gmx.at> | 2019-10-20 21:48:12 +0200 |
---|---|---|
committer | Andreas Klebinger <klebinger.andreas@gmx.at> | 2019-10-21 15:53:03 +0200 |
commit | f0b5a2043ff6c527e55fab228d37ee698ce87262 (patch) | |
tree | 7fd7356541db76edab028e3dbbc89b8dc05c1600 /haddock-api | |
parent | a7c42a29f7c33f5fdbb04acc3866ec907c2e00f3 (diff) |
Refactor for withTiming changes.
Diffstat (limited to 'haddock-api')
-rw-r--r-- | haddock-api/src/Haddock.hs | 10 | ||||
-rw-r--r-- | haddock-api/src/Haddock/Interface.hs | 8 |
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 |