content: {-# 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
             ]
  