[commit: haddock] master: Print missing documentation. Fixes #258. (9db420f)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/haddock

On branch  : master
Link       : http://git.haskell.org/haddock.git/commitdiff/9db420f74a0fd4d1abc0d8cee91b2e7877e5a2e7

>---------------------------------------------------------------

commit 9db420f74a0fd4d1abc0d8cee91b2e7877e5a2e7
Author: Mateusz Kowalczyk <fuuzetsu at fuuzetsu.co.uk>
Date:   Sat Sep 7 05:21:03 2013 +0100

    Print missing documentation. Fixes #258.


>---------------------------------------------------------------

9db420f74a0fd4d1abc0d8cee91b2e7877e5a2e7
 src/Haddock/Interface.hs |   32 ++++++++++++++++++++++++++++----
 src/Haddock/Options.hs   |    5 ++++-
 2 files changed, 32 insertions(+), 5 deletions(-)

diff --git a/src/Haddock/Interface.hs b/src/Haddock/Interface.hs
index ea1f42e..24d4791 100644
--- a/src/Haddock/Interface.hs
+++ b/src/Haddock/Interface.hs
@@ -1,8 +1,9 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Haddock.Interface
--- Copyright   :  (c) Simon Marlow 2003-2006,
---                    David Waern  2006-2010
+-- Copyright   :  (c) Simon Marlow      2003-2006,
+--                    David Waern       2006-2010,
+--                    Mateusz Kowalczyk 2013
 -- License     :  BSD-like
 --
 -- Maintainer  :  haddock at projects.haskell.org
@@ -54,7 +55,7 @@ import DynFlags hiding (verbosity)
 import Exception
 import GHC hiding (verbosity)
 import HscTypes
-
+import FastString (unpackFS)
 
 -- | Create 'Interface's and a link environment by typechecking the list of
 -- modules using the GHC API and processing the resulting syntax trees.
@@ -169,11 +170,35 @@ processModule verbosity modsum flags modMap instIfaceMap = do
     out verbosity verbose "Creating interface..."
     (interface, msg) <- runWriterGhc $ createInterface tm flags modMap instIfaceMap
     liftIO $ mapM_ putStrLn msg
+    dflags <- getDynFlags
     let (haddockable, haddocked) = ifaceHaddockCoverage interface
         percentage = round (fromIntegral haddocked * 100 / fromIntegral haddockable :: Double) :: Int
         modString = moduleString (ifaceMod interface)
         coverageMsg = printf " %3d%% (%3d /%3d) in '%s'" percentage haddocked haddockable modString
+        header = case ifaceDoc interface of
+          Documentation Nothing _ -> False
+          _ -> True
+        undocumentedExports = [ formatName s n | ExportDecl { expItemDecl = L s n
+                                                            , expItemMbDoc = (Documentation Nothing _, _)
+                                                            } <- ifaceExportItems interface ]
+          where
+            formatName :: SrcSpan -> HsDecl Name -> String
+            formatName loc n = p (getMainDeclBinder n) ++ case loc of
+              RealSrcSpan rss -> " (" ++ unpackFS (srcSpanFile rss) ++ ":" ++ show (srcSpanStartLine rss) ++ ")"
+              _ -> ""
+
+            p [] = ""
+            p (x:_) = let n = pretty dflags x
+                          ms = modString ++ "."
+                      in if ms `isPrefixOf` n
+                         then drop (length ms) n
+                         else n
+
     out verbosity normal coverageMsg
+    when (Flag_PrintMissingDocs `elem` flags && (header || not (null undocumentedExports))) $ do
+      out verbosity normal "  Missing documentation for:"
+      unless header $ out verbosity normal "    Module header"
+      mapM_ (out verbosity normal . ("    " ++)) undocumentedExports
     interface' <- liftIO $ evaluate interface
     return (Just interface')
   else
@@ -216,4 +241,3 @@ buildHomeLinks ifaces = foldl upd Map.empty (reverse ifaces)
 withTempDir :: (ExceptionMonad m, MonadIO m) => FilePath -> m a -> m a
 withTempDir dir = gbracket_ (liftIO $ createDirectory dir)
                             (liftIO $ removeDirectoryRecursive dir)
-
diff --git a/src/Haddock/Options.hs b/src/Haddock/Options.hs
index a362fd0..751812d 100644
--- a/src/Haddock/Options.hs
+++ b/src/Haddock/Options.hs
@@ -80,6 +80,7 @@ data Flag
   | Flag_NoTmpCompDir
   | Flag_Qualification String
   | Flag_PrettyHtml
+  | Flag_PrintMissingDocs
   deriving (Eq)
 
 
@@ -162,7 +163,9 @@ options backwardsCompat =
     Option [] ["no-tmp-comp-dir"] (NoArg Flag_NoTmpCompDir)
       "do not re-direct compilation output to a temporary directory",
     Option [] ["pretty-html"] (NoArg Flag_PrettyHtml)
-      "generate html with newlines and indenting (for use with --html)"
+      "generate html with newlines and indenting (for use with --html)",
+    Option [] ["print-missing-docs"] (NoArg Flag_PrintMissingDocs)
+      "print information about any undocumented entities"
   ]