{-# LANGUAGE DeriveDataTypeable    #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE StandaloneDeriving    #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE UndecidableInstances  #-}
{-# LANGUAGE ViewPatterns          #-}
-- | Main module parsing inputs, and running analysis.
module Language.Haskell.Homplexity.Assessment where

import           Data.Data
--import           Data.Monoid

import           Language.Haskell.Homplexity.CodeFragment
import           Language.Haskell.Homplexity.Cyclomatic
import           Language.Haskell.Homplexity.Message
import           Language.Haskell.Homplexity.Metric
import           Language.Haskell.Homplexity.RecordFieldsCount
import           Language.Haskell.Homplexity.TypeClassComplexity
import           Language.Haskell.Homplexity.TypeComplexity

import           HFlags

{-
numFunctions = length
             . filter isFunBind
             . getModuleDecls

testNumFunctions = (>20)

numFunctionsMsg = "More than 20 functions per module"

numFunctionsSeverity = Warning
 -}

-- * Showing metric measurements
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 :: (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
-- | Measure all occurences of a given @CodeFragment@ with a given @Metric@,
-- then use @Assessment@ on them and give a list of @Log@ messages.
--
-- Arguments come in the following order:
-- 1. @Assessment@ for the value of the @Metric@.
-- 2. @Metric@ given as @Proxy@ type.
-- 3. @CodeFragment@ given as @Proxy@ type.
-- 4. Program containing @CodeFragment@s.
measureAllOccurs :: (Data from, Metric m c) => Assessment m -> Proxy m -> Proxy c -> from -> Log
measureAllOccurs assess = measureAll assess allOccurs

-- | Type of functions that convert a @Metric@ into a log message.
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

-- * Assessments of severity for used @Metric@s.
-- ** Module definition checks
defineFlag "moduleLinesWarning"  (500  :: Int) "issue warning when module exceeds this number of lines"
defineFlag "moduleLinesCritical" (3000 :: Int) "issue critical when module exceeds this number of lines"

assessModuleLength :: Assessment LOC
assessModuleLength (fromIntegral -> locs)
                   | locs > flags_moduleLinesCritical = (Critical, "this function exceeds "       ++
                                                                    show flags_moduleLinesCritical ++
                                                                   " lines of code.")
                   | locs > flags_moduleLinesWarning  = (Warning,  "should be kept below "        ++
                                                                    show flags_moduleLinesWarning ++
                                                                   " lines of code.")
                   | otherwise    = (Info,     ""                                        )

-- ** Function definition checks
-- *** Number of lines of code within function body
defineFlag "functionLinesWarning"  (20 :: Int) "issue warning when function exceeds this number of lines"
defineFlag "functionLinesCritical" (40 :: Int) "issue critical when function exceeds this number of lines"

assessFunctionLength :: Assessment LOC
assessFunctionLength (fromIntegral -> locs)
                   | locs > flags_functionLinesCritical = (Critical, "this function exceeds "          ++
                                                                       show flags_functionLinesCritical ++
                                                                      " lines of code.")
                   | locs > flags_functionLinesWarning  = (Warning,  "should be kept below "          ++
                                                                       show flags_functionLinesWarning ++
                                                                      " lines of code.")
                   | otherwise                          = (Info,     ""                                 )


-- *** Decision depth of function definition
defineFlag "functionDepthWarning"  (4 :: Int) "issue warning when function exceeds this decision depth"
defineFlag "functionDepthCritical" (8 :: Int) "issue critical when function exceeds this decision depth"

assessFunctionDepth :: Assessment Depth
assessFunctionDepth (fromIntegral -> depth)
                    | depth > flags_functionDepthCritical = (Critical, "should never exceed " ++
                                                                        show depth            ++
                                                                       " nesting levels for conditionals")
                    | depth > flags_functionDepthWarning  = (Warning,  "should have no more than " ++
                                                                        show depth                 ++
                                                                       " nested conditionals"            )
                    | otherwise = (Info,    ""                                )

-- *** Cyclomatic complexity of function definition
defineFlag "functionCCWarning"  (20::Int) "issue warning when function's cyclomatic complexity exceeds this number"
defineFlag "functionCCCritical" (50::Int) "issue critical when function's cyclomatic complexity exceeds this number"

assessFunctionCC :: Assessment Cyclomatic
assessFunctionCC (fromIntegral -> cy)
                 | cy > flags_functionCCCritical = (Critical, "must never be as high as " ++
                                                               show flags_functionCCCritical)
                 | cy > flags_functionCCWarning  = (Warning,  "should be less than "        ++
                                                               show flags_functionCCWarning)
                 | otherwise                     = (Info,     ""                               )

-- ** Type signature complexity
-- *** Type constructor depth in each type signature
defineFlag "typeConDepthWarning"  (6::Int) "issue warning when type constructor depth exceeds this number"
defineFlag "typeConDepthCritical" (9::Int) "issue critical when type constructor depth exceeds this number"

assessTypeConDepth :: Assessment ConDepth
assessTypeConDepth (fromIntegral -> cy)
                 | cy > flags_typeConDepthCritical = (Critical, "must never be as high as " ++
                                                                 show flags_typeConDepthCritical)
                 | cy > flags_typeConDepthWarning  = (Warning,  "should be less than "        ++
                                                                 show flags_typeConDepthWarning )
                 | otherwise                       = (Info,     ""                              )

-- *** Number of function arguments mentioned in each type signature
defineFlag "numFunArgsWarning"  (5::Int) "issue warning when number of function arguments exceeds this number"
defineFlag "numFunArgsCritical" (9::Int) "issue critical when number of function arguments exceeds this number"

assessNumFunArgs :: Assessment NumFunArgs
assessNumFunArgs (fromIntegral -> cy)
                 | cy > flags_numFunArgsCritical = (Critical, "must never reach "    ++ show flags_numFunArgsCritical)
                 | cy > flags_numFunArgsWarning  = (Warning,  "should be less than " ++ show flags_numFunArgsWarning )
                 | otherwise                     = (Info,     ""                                                     )

-- ** Data type complexity
-- *** Record fields count
defineFlag "recordFieldsCountWarning"  (6::Int) "issue warning when combined record fields count exceeds this number"
defineFlag "recordFieldsCountCritical" (9::Int) "issue critical when combined record fields count exceeds this number"

assessRecordFieldsCount :: Assessment RecordFieldsCount
assessRecordFieldsCount (fromIntegral -> cy)
                        | cy > flags_recordFieldsCountCritical = (Critical, "must never reach " ++ show flags_recordFieldsCountCritical  )
                        | cy > flags_recordFieldsCountWarning  = (Warning,  "should be less than " ++ show flags_recordFieldsCountWarning)
                        | otherwise                            = (Info,     ""                                                           )

-- ** Type class complexity
-- *** Method count of type class
defineFlag "typeClassNonTypeDeclWarning"  (5::Int) "issue warning when the number of methods in a type class exceeds this number"
defineFlag "typeClassNonTypeDeclCritical" (7::Int) "issue critical when the number of methods in a type class exceeds this number"

assessTCNonTypeDeclCount :: Assessment NonTypeDeclCount
assessTCNonTypeDeclCount (fromIntegral -> mc)
  | mc > flags_typeClassNonTypeDeclCritical = (Critical, "should never have more than " ++
                                              show flags_typeClassNonTypeDeclCritical)
  | mc > flags_typeClassNonTypeDeclWarning  = (Warning,  " should have no more than " ++
                                              show flags_typeClassNonTypeDeclWarning)
  | otherwise = (Info, "")

-- *** Associated type count of type class
defineFlag "typeClassAssocTypesWarning"  (3::Int) "issue warning when the number of associated types in a type class exceeds this number"
defineFlag "typeClassAssocTypesCritical" (5::Int) "issue critical when the number of associated types in a type class exceeds this number"

assessTCAssocTypesCount :: Assessment AssocTypeCount
assessTCAssocTypesCount (fromIntegral -> atc)
  | atc > flags_typeClassAssocTypesCritical = (Critical, "should never have more than " ++
                                              show flags_typeClassAssocTypesCritical)
  | atc > flags_typeClassAssocTypesWarning  = (Warning,  " should have no more than " ++
                                              show flags_typeClassAssocTypesWarning)
  | otherwise                               = (Info, "")

-- * Computing and assessing @Metric@s for all @CodeFragment@.
-- | Compute all metrics, and assign severity depending on configured thresholds.
metrics :: [Program -> Log]
metrics  = [ measureTopOccurs assessModuleLength       locT               moduleT
           , measureTopOccurs assessFunctionLength     locT               functionT
           , measureTopOccurs assessFunctionDepth      depthT             functionT
           , measureTopOccurs assessFunctionCC         cyclomaticT        functionT
           , measureTopOccurs assessTypeConDepth       conDepthT          typeSignatureT
           , measureTopOccurs assessNumFunArgs         numFunArgsT        typeSignatureT
           , measureTopOccurs assessRecordFieldsCount  recordFieldsCountT dataDefT
           , measureTopOccurs assessTCNonTypeDeclCount nonTypeDeclCountT  typeClassT
           , measureTopOccurs assessTCAssocTypesCount  assocTypeCountT    typeClassT
           ]