-----------------------------------------------------------------------------
-- |
-- Module      :  Main (HaddockCoverage)
  Copyright    :   ( C ) 2015  
-- License     :  BSD-style (see the file LICENSE)
  Maintainer   :     <  >
-- Stability   :  provisional
-- Portability :  portable
--
-- Copyright notice: This file borrows code
-- -4.7/src/tests/doctests.hsc
-- which is itself licensed BSD-style as well.
--
-- Run haddock on a source tree and report if anything in any
-- module is not documented.
-----------------------------------------------------------------------------
module Main where

import Control.Applicative
import Control.Monad
import Data.List
import System.Directory
import System.Exit
import System.FilePath
import System.IO
import System.Process
import Text.Regex.Posix

main :: IO ()
main = do
  -- Find haskell modules
  -- TODO: Ideally cabal should do this (provide us with the
  -- list of modules). An alternative would be to use cabal haddock
  -- but that would need a --no-html argument or something like that.
  -- Alternatively, we could use cabal haddock with additional arguments.
  --
  -- See:
  -studios/haddock/commit/d5d752943c4e5c6c9ffcdde4dc136fcee967c495
  -- #issuecomment-150811929
  files <- getSources

  let haddockArgs = [ "--no-warnings" ] ++ files
  let cabalArgs   = [ "exec", "--", "haddock" ] ++ haddockArgs
  (code, out, _err) <- readProcessWithExitCode "cabal" cabalArgs ""

  -- Filter out coverage lines, and find those that denote undocumented
  -- modules.
  --
  -- TODO: is there a way to annotate a function as self-documenting,
  in the same way we do with  for hlint ?
  let isIncompleteModule :: String -> Bool
      isIncompleteModule line = isCoverageLine line && not (line =~ "^ *100%")
        where isCoverageLine :: String -> Bool
              isCoverageLine line = line =~ "^ *[0-9]+%"

  let incompleteModules :: [String]
      incompleteModules = filter isIncompleteModule $ lines out

  -- Based on the result of haddock, report errors and exit.
  Note that ,   , this script does not
  -- output anything to stdout. It uses stderr instead
  -- (as it should).
  case (code, incompleteModules) of
    (ExitSuccess  , []) -> return ()
    (ExitFailure _, _)  -> exitFailure
    (_            , _)  -> do
      hPutStrLn stderr "The following modules are not fully documented:"
      mapM_ (hPutStrLn stderr) incompleteModules
      exitFailure

getSources :: IO [FilePath]
getSources = filter isHaskellFile <$> go "src"
  where
    go dir = do
      (dirs, files) <- getFilesAndDirectories dir
      (files ++) . concat <$> mapM go dirs

    isHaskellFile fp = isSuffixOf ".hs" fp || isSuffixOf ".lhs" fp

getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath])
getFilesAndDirectories dir = do
  c <- map (dir </>) . filter (`notElem` ["..", "."]) <$> getDirectoryContents dir
  (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c

-- find-based implementation (not portable)
--
  getSources : : IO [ FilePath ]
  getSources = fmap lines $ readProcess " find " [ " src/ " , " -iname " , " * hs " ] " "

---------------------------------------------------------------------------
 |
 Module      :  Main (HaddockCoverage)
 License     :  BSD-style (see the file LICENSE)
 Stability   :  provisional
 Portability :  portable

 Copyright notice: This file borrows code
 -4.7/src/tests/doctests.hsc
 which is itself licensed BSD-style as well.

 Run haddock on a source tree and report if anything in any
 module is not documented.
---------------------------------------------------------------------------
 Find haskell modules
 TODO: Ideally cabal should do this (provide us with the
 list of modules). An alternative would be to use cabal haddock
 but that would need a --no-html argument or something like that.
 Alternatively, we could use cabal haddock with additional arguments.

 See:
 #issuecomment-150811929
 Filter out coverage lines, and find those that denote undocumented
 modules.

 TODO: is there a way to annotate a function as self-documenting,
 Based on the result of haddock, report errors and exit.
 output anything to stdout. It uses stderr instead
 (as it should).
 find-based implementation (not portable)

  Copyright    :   ( C ) 2015  
  Maintainer   :     <  >
module Main where

import Control.Applicative
import Control.Monad
import Data.List
import System.Directory
import System.Exit
import System.FilePath
import System.IO
import System.Process
import Text.Regex.Posix

main :: IO ()
main = do
  -studios/haddock/commit/d5d752943c4e5c6c9ffcdde4dc136fcee967c495
  files <- getSources

  let haddockArgs = [ "--no-warnings" ] ++ files
  let cabalArgs   = [ "exec", "--", "haddock" ] ++ haddockArgs
  (code, out, _err) <- readProcessWithExitCode "cabal" cabalArgs ""

  in the same way we do with  for hlint ?
  let isIncompleteModule :: String -> Bool
      isIncompleteModule line = isCoverageLine line && not (line =~ "^ *100%")
        where isCoverageLine :: String -> Bool
              isCoverageLine line = line =~ "^ *[0-9]+%"

  let incompleteModules :: [String]
      incompleteModules = filter isIncompleteModule $ lines out

  Note that ,   , this script does not
  case (code, incompleteModules) of
    (ExitSuccess  , []) -> return ()
    (ExitFailure _, _)  -> exitFailure
    (_            , _)  -> do
      hPutStrLn stderr "The following modules are not fully documented:"
      mapM_ (hPutStrLn stderr) incompleteModules
      exitFailure

getSources :: IO [FilePath]
getSources = filter isHaskellFile <$> go "src"
  where
    go dir = do
      (dirs, files) <- getFilesAndDirectories dir
      (files ++) . concat <$> mapM go dirs

    isHaskellFile fp = isSuffixOf ".hs" fp || isSuffixOf ".lhs" fp

getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath])
getFilesAndDirectories dir = do
  c <- map (dir </>) . filter (`notElem` ["..", "."]) <$> getDirectoryContents dir
  (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c

  getSources : : IO [ FilePath ]
  getSources = fmap lines $ readProcess " find " [ " src/ " , " -iname " , " * hs " ] " "
