Make a little more use of DoAndIfThenElse

2 files changed, 66 insertions, 69 deletions

diff --git a/src/Haddock/Interface.hs b/src/Haddock/Interface.hs
index 865183cd..276621d2 100644
--- a/src/Haddock/Interface.hs
+++ b/src/Haddock/Interface.hs
@@ -102,12 +102,11 @@ createIfaces0 verbosity modules flags instIfaceMap =
   -- resulting ModSummaries.
   (if useTempDir then withTempOutputDir else id) $ do
     modGraph <- depAnalysis
-    if needsTemplateHaskell modGraph
-      then do
-        modGraph' <- enableCompilation modGraph
-        createIfaces verbosity flags instIfaceMap modGraph'
-      else
-        createIfaces verbosity flags instIfaceMap modGraph
+    if needsTemplateHaskell modGraph then do
+      modGraph' <- enableCompilation modGraph
+      createIfaces verbosity flags instIfaceMap modGraph'
+    else
+      createIfaces verbosity flags instIfaceMap modGraph
 
   where
     useTempDir :: Bool
@@ -157,22 +156,21 @@ processModule :: Verbosity -> ModSummary -> [Flag] -> IfaceMap -> InstIfaceMap -
 processModule verbosity modsum flags modMap instIfaceMap = do
   out verbosity verbose $ "Checking module " ++ moduleString (ms_mod modsum) ++ "..."
   tm <- loadModule =<< typecheckModule =<< parseModule modsum
-  if not $ isBootSummary modsum
-    then do
-      out verbosity verbose "Creating interface..."
-      (interface, msg) <- runWriterGhc $ createInterface tm flags modMap instIfaceMap
-      liftIO $ mapM_ putStrLn msg
-      let (haddockable, haddocked) = ifaceHaddockCoverage interface
-          percentage = round (fromIntegral haddocked * 100 / fromIntegral haddockable :: Double) :: Int
-          coveragemsg = printf "haddock coverage for %s: %7s %3d%%"
-                          (ifaceOrigFilename interface)
-                          (printf "%d/%d" haddocked haddockable ::  String)
-                          percentage
-      out verbosity normal coveragemsg
-      interface' <- liftIO $ evaluate interface
-      return (Just interface')
-    else
-      return Nothing
+  if not $ isBootSummary modsum then do
+    out verbosity verbose "Creating interface..."
+    (interface, msg) <- runWriterGhc $ createInterface tm flags modMap instIfaceMap
+    liftIO $ mapM_ putStrLn msg
+    let (haddockable, haddocked) = ifaceHaddockCoverage interface
+        percentage = round (fromIntegral haddocked * 100 / fromIntegral haddockable :: Double) :: Int
+        coveragemsg = printf "haddock coverage for %s: %7s %3d%%"
+                        (ifaceOrigFilename interface)
+                        (printf "%d/%d" haddocked haddockable ::  String)
+                        percentage
+    out verbosity normal coveragemsg
+    interface' <- liftIO $ evaluate interface
+    return (Just interface')
+  else
+    return Nothing
 
 
 --------------------------------------------------------------------------------
diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs
index db2ec05c..d651fe75 100644
--- a/src/Haddock/Interface/Create.hs
+++ b/src/Haddock/Interface/Create.hs
@@ -573,53 +573,52 @@ mkExportItems modMap this_mod gre exported_names decls declMap
               -- those exported type-inferenced values.
               isLocalAndTypeInferenced <- liftGhcToErrMsgGhc $ do
                     let mdl = nameModule t
-                    if modulePackageId mdl == thisPackage dflags
-                       then isLoaded (moduleName mdl)
-                       else return False
-
-              if isLocalAndTypeInferenced
-               then do
-                   -- I don't think there can be any subs in this case,
-                   -- currently?  But better not to rely on it.
-                   let subs = subordinatesWithNoDocs (unLoc hsdecl)
-                   return [ mkExportDecl t (hsdecl, noDocForDecl, subs) ]
-               else
-              -- We try to get the subs and docs
-              -- from the installed interface of that package.
-               case Map.lookup (nameModule t) instIfaceMap of
-                -- It's Nothing in the cases where I thought
-                -- Haddock has already warned the user: "Warning: The
-                -- documentation for the following packages are not
-                -- installed. No links will be generated to these packages:
-                -- ..."
-                -- But I guess it was Cabal creating that warning. Anyway,
-                -- this is more serious than links: it's exported decls where
-                -- we don't have the docs that they deserve!
-
-                -- We could use 'subordinates' to find the Names of the subs
-                -- (with no docs). Is that necessary? Yes it is, otherwise
-                -- e.g. classes will be shown without their exported subs.
-                Nothing -> do
-                   liftErrMsg $ tell
-                      ["Warning: Couldn't find .haddock for exported "
-                      ++ exportInfoString]
-                   let subs = subordinatesWithNoDocs (unLoc hsdecl)
-                   return [ mkExportDecl t (hsdecl, noDocForDecl, subs) ]
-                Just iface -> do
-                   let subs = case Map.lookup t (instSubMap iface) of
-                           Nothing -> []
-                           Just x -> x
-                   return [ mkExportDecl t
-                     ( hsdecl
-                     , fromMaybe noDocForDecl $
-                          Map.lookup t (instDocMap iface)
-                     , map (\subt ->
-                              ( subt ,
-                                fromMaybe noDocForDecl $
-                                   Map.lookup subt (instDocMap iface)
-                              )
-                           ) subs
-                     )]
+                    if modulePackageId mdl == thisPackage dflags then
+                      isLoaded (moduleName mdl)
+                    else return False
+
+              if isLocalAndTypeInferenced then do
+                -- I don't think there can be any subs in this case,
+                -- currently?  But better not to rely on it.
+                let subs = subordinatesWithNoDocs (unLoc hsdecl)
+                return [ mkExportDecl t (hsdecl, noDocForDecl, subs) ]
+              else
+                -- We try to get the subs and docs
+                -- from the installed interface of that package.
+                case Map.lookup (nameModule t) instIfaceMap of
+                  -- It's Nothing in the cases where I thought
+                  -- Haddock has already warned the user: "Warning: The
+                  -- documentation for the following packages are not
+                  -- installed. No links will be generated to these packages:
+                  -- ..."
+                  -- But I guess it was Cabal creating that warning. Anyway,
+                  -- this is more serious than links: it's exported decls where
+                  -- we don't have the docs that they deserve!
+
+                  -- We could use 'subordinates' to find the Names of the subs
+                  -- (with no docs). Is that necessary? Yes it is, otherwise
+                  -- e.g. classes will be shown without their exported subs.
+                  Nothing -> do
+                     liftErrMsg $ tell
+                        ["Warning: Couldn't find .haddock for exported "
+                        ++ exportInfoString]
+                     let subs = subordinatesWithNoDocs (unLoc hsdecl)
+                     return [ mkExportDecl t (hsdecl, noDocForDecl, subs) ]
+                  Just iface -> do
+                     let subs = case Map.lookup t (instSubMap iface) of
+                             Nothing -> []
+                             Just x -> x
+                     return [ mkExportDecl t
+                       ( hsdecl
+                       , fromMaybe noDocForDecl $
+                            Map.lookup t (instDocMap iface)
+                       , map (\subt ->
+                                ( subt ,
+                                  fromMaybe noDocForDecl $
+                                     Map.lookup subt (instDocMap iface)
+                                )
+                             ) subs
+                       )]
 
 
     mkExportDecl :: Name -> DeclInfo -> ExportItem Name