{-# LANGUAGE DeriveDataTypeable    #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE StandaloneDeriving    #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE UndecidableInstances  #-}
{-# LANGUAGE ViewPatterns          #-}
-- | Main module parsing inputs, and running analysis.
module Main (main) where

import Data.Data
import Data.List
import Control.Monad

import Language.Haskell.Exts.Syntax
import Language.Haskell.Homplexity.CodeFragment
import Language.Haskell.Homplexity.Cyclomatic
import Language.Haskell.Homplexity.Message
import Language.Haskell.Homplexity.Metric
import Language.Haskell.Homplexity.Parse
import System.Directory
import System.FilePath
import System.IO

import HFlags

-- * Command line flags
defineFlag "severity" Info (concat ["level of output verbosity (", severityOptions, ")"])
defineFlag "fakeFlag" Info "this flag is fake"

{-
numFunctions = length
             . filter isFunBind
             . getModuleDecls

testNumFunctions = (>20)

numFunctionsMsg = "More than 20 functions per module"

numFunctionsSeverity = Warning
 -}

-- * Showing metric measurements
--measureAll  :: (CodeFragment c, Metric m c) => Severity -> (Program -> [c]) -> Proxy m -> Proxy c -> Program -> Log
measureAll :: Metric m c =>Assessment m -> (a -> [c]) -> Proxy m -> Proxy c -> a -> Log
measureAll assess generator metricType fragType = mconcat
                                                . map       (warnOfMeasure assess metricType fragType)
                                                . generator

--measureTopOccurs  :: (CodeFragment c, Metric m c) => Severity -> Proxy m -> Proxy c -> Program -> Log
measureTopOccurs :: (Data from, Metric m c) =>Assessment m -> Proxy m -> Proxy c -> from -> Log
measureTopOccurs assess = measureAll assess occurs

--measureAllOccurs  :: (CodeFragment c, Metric m c) => Severity -> Proxy m -> Proxy c -> Program -> Log
measureAllOccurs :: (Data from, Metric m c) =>Assessment m -> Proxy m -> Proxy c -> from -> Log
measureAllOccurs assess = measureAll assess allOccurs

type Assessment m = m -> (Severity, String)

warnOfMeasure :: (CodeFragment c, Metric m c) => Assessment m -> Proxy m -> Proxy c -> c -> Log
warnOfMeasure assess metricType fragType c = message  severity
                                                     (        fragmentLoc  c )
                                                     (unwords [fragmentName c
                                                              ,"has"
                                                              ,show result
                                                              ,recommendation])
  where
    (severity, recommendation) = assess result
    result = measureFor metricType fragType c

assessFunctionLength :: Assessment LOC
assessFunctionLength lines | lines > 20 = (Warning,  "should be kept below 20 lines of code." )
                | lines > 40 = (Critical, "this function exceeds 50 lines of code.")
                | otherwise  = (Info,     ""                                       )

assessModuleLength :: Assessment LOC
assessModuleLength lines | lines > 500  = (Warning,  "should be kept below 500 lines of code."  )
                         | lines > 3000 = (Critical, "this function exceeds 3000 lines of code.")
                         | otherwise    = (Info,     ""                                         )

assessFunctionDepth :: Assessment Depth
assessFunctionDepth depth | depth > 4 = (Warning, "should have no more than four nested conditionals"    )
                          | depth > 8 = (Warning, "should never exceed 8 nesting levels for conditionals")
                          | otherwise = (Info,    ""                                                     )

assessFunctionCC :: Assessment Cyclomatic
assessFunctionCC cy | cy > 20   = (Warning, "should not exceed 20"  )
                    | cy > 50   = (Warning, "should never exceed 50")
                    | otherwise = (Info,    ""                      )

metrics :: [Program -> Log]
metrics  = [measureTopOccurs assessModuleLength   locT        moduleT ,
            measureTopOccurs assessFunctionLength locT        functionT,
            measureTopOccurs assessFunctionDepth  depthT      functionT,
            measureTopOccurs assessFunctionCC     cyclomaticT functionT]

-- | Report to standard error output.
report ::  String -> IO ()
report = hPutStrLn stderr

-- | Analyze single source module.
analyzeModule ::  Module -> IO ()
analyzeModule  = analyzeModules . (:[])

-- | Analyze a set of modules.
analyzeModules ::  [Module] -> IO ()
analyzeModules = putStr . concatMap show . extract flags_severity . mconcat metrics . Program

-- | Find all Haskell source files within a given path.
-- Recurse down the tree, if the path points to directory.
subTrees          :: FilePath -> IO [FilePath]
-- Recurse to . or .. only at the first level, to prevent looping:
subTrees dir      | dir `elem` [".", ".."] = concatMapM subTrees' =<< getDirectoryPaths dir
subTrees filepath                          = do
  isDir <- doesDirectoryExist filepath
  if isDir
     then subTrees' filepath
     else do
       exists <- doesFileExist filepath
       if exists
          then    return [filepath]
          else do report $ "File does not exist: " ++ filepath
                  return []

-- | Return filepath if normal file, or recurse down the directory if it is not special directory ("." or "..")
subTrees'                       :: FilePath -> IO [FilePath]
subTrees' (takeFileName -> "..") = return []
subTrees' (takeFileName -> "." ) = return []
subTrees'  fp                    = do
  isDir <- doesDirectoryExist fp
  if isDir
    then concatMapM subTrees' =<< getDirectoryPaths fp
    else return $ filter (".hs" `isSuffixOf`) [fp]

-- | Get contents of a given directory, and return their full paths.
getDirectoryPaths        :: FilePath -> IO [FilePath]
getDirectoryPaths dirPath = map (dirPath </>) <$> getDirectoryContents dirPath

-- | Process each separate input file.
processFile ::  FilePath -> IO Bool
processFile filepath = do src <- parseSource filepath
                          case src of
                            Left  msg              -> do report $ show msg
                                                         return False
                            Right (ast, _comments) -> do analyzeModule ast
                                                         return True

-- | Commonly defined function - should be added to base...
concatMapM  :: (Monad m) => (a -> m [b]) -> [a] -> m [b]
concatMapM f = fmap concat . mapM f

testFilename :: FilePath
testFilename = "Homplexity.hs"

main :: IO ()
main = do
  args <- $initHFlags "json-autotype -- automatic type and parser generation from JSON"
  if null args
    then    void $ processFile testFilename
    else do sums <- mapM processFile =<< concatMapM subTrees args
            putStrLn $ unwords ["Correctly parsed", show $ length $ filter id sums,
                                "out of",           show $ length             sums,
                                "input files."]