dead-code-detection-0.1: src/Run.hs

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}

module Run where

import           Control.Exception
import           Control.Monad
import           Data.Version
import           Development.GitRev
import           GHC
import qualified GHC.Generics
import           System.Console.GetOpt.Generics
import           System.Exit

import           Ast
import           Files
import           GHC.Show
import           Graph
import qualified Paths_dead_code_detection as Paths

data Options
  = Options {
    sourceDirs :: [FilePath],
    root :: [String],
    version :: Bool
  }
  deriving (Show, Eq, GHC.Generics.Generic)

instance Generic Options
instance HasDatatypeInfo Options

run :: IO ()
run = do
  options <- modifiedGetArguments $
    AddShortOption "sourceDirs" 'i' :
  --  UseForPositionalArguments "root" "ROOT" :
    []
  when (options == Options [] [] False) $
    die "missing option: --root=STRING"
  when (version options) $ do
    putStrLn versionOutput
    throwIO ExitSuccess
  files <- findHaskellFiles (sourceDirs options)
  deadNames <- deadNamesFromFiles files (map mkModuleName (root options))
  case deadNames of
    [] -> return ()
    _ -> do
      forM_ deadNames putStrLn
      exitWith $ ExitFailure 1

versionOutput :: String
versionOutput =
  "version: " ++ full
  where
    isInGit = $(gitHash) /= "UNKNOWN"
    full = if isInGit
      then "version: " ++ showVersion Paths.version ++ "\n" ++
           "rev: " ++ $(gitHash) ++ (if $(gitDirty) then " (dirty)" else "") ++ "\n" ++
           "branch: " ++ $(gitBranch)
      else "version: " ++ showVersion Paths.version

deadNamesFromFiles :: [FilePath] -> [ModuleName] -> IO [String]
deadNamesFromFiles files roots = do
  ast <- parse files
  case ast of
    Left err -> die err
    Right ast -> case findExports ast roots of
      Left err -> die err
      Right rootExports -> do
        let graph = usedTopLevelNames ast
        return $ fmap formatName $ deadNames graph rootExports