{-# 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 :: forall m c a.
Metric m c =>
Assessment m -> (a -> [c]) -> Proxy m -> Proxy c -> a -> Log
measureAll Assessment m
assess a -> [c]
generator Proxy m
metricType Proxy c
fragType = [Log] -> Log
forall a. Monoid a => [a] -> a
mconcat
                                                ([Log] -> Log) -> (a -> [Log]) -> a -> Log
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c -> Log) -> [c] -> [Log]
forall a b. (a -> b) -> [a] -> [b]
map       (Assessment m -> Proxy m -> Proxy c -> c -> Log
forall c m.
(CodeFragment c, Metric m c) =>
Assessment m -> Proxy m -> Proxy c -> c -> Log
warnOfMeasure Assessment m
assess Proxy m
metricType Proxy c
fragType)
                                                ([c] -> [Log]) -> (a -> [c]) -> a -> [Log]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [c]
generator

measureTopOccurs :: (Data from, Metric m c) => Assessment m -> Proxy m -> Proxy c -> from -> Log
measureTopOccurs :: forall from m c.
(Data from, Metric m c) =>
Assessment m -> Proxy m -> Proxy c -> from -> Log
measureTopOccurs Assessment m
assess = Assessment m -> (from -> [c]) -> Proxy m -> Proxy c -> from -> Log
forall m c a.
Metric m c =>
Assessment m -> (a -> [c]) -> Proxy m -> Proxy c -> a -> Log
measureAll Assessment m
assess from -> [c]
forall c from. (CodeFragment c, Data from) => from -> [c]
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 :: forall from m c.
(Data from, Metric m c) =>
Assessment m -> Proxy m -> Proxy c -> from -> Log
measureAllOccurs Assessment m
assess = Assessment m -> (from -> [c]) -> Proxy m -> Proxy c -> from -> Log
forall m c a.
Metric m c =>
Assessment m -> (a -> [c]) -> Proxy m -> Proxy c -> a -> Log
measureAll Assessment m
assess from -> [c]
forall c from. (CodeFragment c, Data from) => from -> [c]
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 :: forall c m.
(CodeFragment c, Metric m c) =>
Assessment m -> Proxy m -> Proxy c -> c -> Log
warnOfMeasure Assessment m
assess Proxy m
metricType Proxy c
fragType c
c = Severity -> SrcLoc -> String -> Log
message  Severity
severity
                                                     (        c -> SrcLoc
forall c. CodeFragment c => c -> SrcLoc
fragmentLoc  c
c )
                                                     ([String] -> String
unwords [c -> String
forall c. CodeFragment c => c -> String
fragmentName c
c
                                                              ,String
"has"
                                                              ,m -> String
forall a. Show a => a -> String
show m
result
                                                              ,String
recommendation])
  where
    (Severity
severity, String
recommendation) = Assessment m
assess m
result
    result :: m
result = Proxy m -> Proxy c -> c -> m
forall m c. Metric m c => Proxy m -> Proxy c -> c -> m
measureFor Proxy m
metricType Proxy c
fragType c
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 :: Assessment LOC
assessModuleLength (LOC -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
locs)
                   | Int
locs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
flags_moduleLinesCritical = (Severity
Critical, String
"this function exceeds "       String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                                                    Int -> String
forall a. Show a => a -> String
show Int
flags_moduleLinesCritical String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                                                   String
" lines of code.")
                   | Int
locs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
flags_moduleLinesWarning  = (Severity
Warning,  String
"should be kept below "        String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                                                    Int -> String
forall a. Show a => a -> String
show Int
flags_moduleLinesWarning String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                                                   String
" lines of code.")
                   | Bool
otherwise    = (Severity
Info,     String
""                                        )

-- ** 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 :: Assessment LOC
assessFunctionLength (LOC -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
locs)
                   | Int
locs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
flags_functionLinesCritical = (Severity
Critical, String
"this function exceeds "          String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                                                       Int -> String
forall a. Show a => a -> String
show Int
flags_functionLinesCritical String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                                                      String
" lines of code.")
                   | Int
locs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
flags_functionLinesWarning  = (Severity
Warning,  String
"should be kept below "          String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                                                       Int -> String
forall a. Show a => a -> String
show Int
flags_functionLinesWarning String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                                                      String
" lines of code.")
                   | Bool
otherwise                          = (Severity
Info,     String
""                                 )


-- *** 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 :: Assessment Depth
assessFunctionDepth (Depth -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
depth)
                    | Int
depth Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
flags_functionDepthCritical = (Severity
Critical, String
"should never exceed " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                                                        Int -> String
forall a. Show a => a -> String
show Int
depth            String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                                                       String
" nesting levels for conditionals")
                    | Int
depth Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
flags_functionDepthWarning  = (Severity
Warning,  String
"should have no more than " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                                                        Int -> String
forall a. Show a => a -> String
show Int
depth                 String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                                                       String
" nested conditionals"            )
                    | Bool
otherwise = (Severity
Info,    String
""                                )

-- *** 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 :: Assessment Cyclomatic
assessFunctionCC (Cyclomatic -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
cy)
                 | Int
cy Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
flags_functionCCCritical = (Severity
Critical, String
"must never be as high as " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                                               Int -> String
forall a. Show a => a -> String
show Int
flags_functionCCCritical)
                 | Int
cy Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
flags_functionCCWarning  = (Severity
Warning,  String
"should be less than "        String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                                               Int -> String
forall a. Show a => a -> String
show Int
flags_functionCCWarning)
                 | Bool
otherwise                     = (Severity
Info,     String
""                               )

-- ** 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 :: Assessment ConDepth
assessTypeConDepth (ConDepth -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
cy)
                 | Int
cy Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
flags_typeConDepthCritical = (Severity
Critical, String
"must never be as high as " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                                                 Int -> String
forall a. Show a => a -> String
show Int
flags_typeConDepthCritical)
                 | Int
cy Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
flags_typeConDepthWarning  = (Severity
Warning,  String
"should be less than "        String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                                                 Int -> String
forall a. Show a => a -> String
show Int
flags_typeConDepthWarning )
                 | Bool
otherwise                       = (Severity
Info,     String
""                              )

-- *** 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 :: Assessment NumFunArgs
assessNumFunArgs (NumFunArgs -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
cy)
                 | Int
cy Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
flags_numFunArgsCritical = (Severity
Critical, String
"must never reach "    String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
flags_numFunArgsCritical)
                 | Int
cy Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
flags_numFunArgsWarning  = (Severity
Warning,  String
"should be less than " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
flags_numFunArgsWarning )
                 | Bool
otherwise                     = (Severity
Info,     String
""                                                     )

-- ** 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 :: Assessment RecordFieldsCount
assessRecordFieldsCount (RecordFieldsCount -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
cy)
                        | Int
cy Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
flags_recordFieldsCountCritical = (Severity
Critical, String
"must never reach " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
flags_recordFieldsCountCritical  )
                        | Int
cy Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
flags_recordFieldsCountWarning  = (Severity
Warning,  String
"should be less than " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
flags_recordFieldsCountWarning)
                        | Bool
otherwise                            = (Severity
Info,     String
""                                                           )

-- ** 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 :: Assessment NonTypeDeclCount
assessTCNonTypeDeclCount (NonTypeDeclCount -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
mc)
  | Int
mc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
flags_typeClassNonTypeDeclCritical = (Severity
Critical, String
"should never have more than " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                              Int -> String
forall a. Show a => a -> String
show Int
flags_typeClassNonTypeDeclCritical)
  | Int
mc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
flags_typeClassNonTypeDeclWarning  = (Severity
Warning,  String
" should have no more than " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                              Int -> String
forall a. Show a => a -> String
show Int
flags_typeClassNonTypeDeclWarning)
  | Bool
otherwise = (Severity
Info, String
"")

-- *** 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 :: Assessment AssocTypeCount
assessTCAssocTypesCount (AssocTypeCount -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
atc)
  | Int
atc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
flags_typeClassAssocTypesCritical = (Severity
Critical, String
"should never have more than " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                              Int -> String
forall a. Show a => a -> String
show Int
flags_typeClassAssocTypesCritical)
  | Int
atc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
flags_typeClassAssocTypesWarning  = (Severity
Warning,  String
" should have no more than " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                              Int -> String
forall a. Show a => a -> String
show Int
flags_typeClassAssocTypesWarning)
  | Bool
otherwise                               = (Severity
Info, String
"")

-- * Computing and assessing @Metric@s for all @CodeFragment@.
-- | Compute all metrics, and assign severity depending on configured thresholds.
metrics :: [Program -> Log]
metrics :: [Program -> Log]
metrics  = [ Assessment LOC
-> Proxy LOC -> Proxy (Module SrcLoc) -> Program -> Log
forall from m c.
(Data from, Metric m c) =>
Assessment m -> Proxy m -> Proxy c -> from -> Log
measureTopOccurs Assessment LOC
assessModuleLength       Proxy LOC
locT               Proxy (Module SrcLoc)
moduleT
           , Assessment LOC -> Proxy LOC -> Proxy Function -> Program -> Log
forall from m c.
(Data from, Metric m c) =>
Assessment m -> Proxy m -> Proxy c -> from -> Log
measureTopOccurs Assessment LOC
assessFunctionLength     Proxy LOC
locT               Proxy Function
functionT
           , Assessment Depth -> Proxy Depth -> Proxy Function -> Program -> Log
forall from m c.
(Data from, Metric m c) =>
Assessment m -> Proxy m -> Proxy c -> from -> Log
measureTopOccurs Assessment Depth
assessFunctionDepth      Proxy Depth
depthT             Proxy Function
functionT
           , Assessment Cyclomatic
-> Proxy Cyclomatic -> Proxy Function -> Program -> Log
forall from m c.
(Data from, Metric m c) =>
Assessment m -> Proxy m -> Proxy c -> from -> Log
measureTopOccurs Assessment Cyclomatic
assessFunctionCC         Proxy Cyclomatic
cyclomaticT        Proxy Function
functionT
           , Assessment ConDepth
-> Proxy ConDepth -> Proxy TypeSignature -> Program -> Log
forall from m c.
(Data from, Metric m c) =>
Assessment m -> Proxy m -> Proxy c -> from -> Log
measureTopOccurs Assessment ConDepth
assessTypeConDepth       Proxy ConDepth
conDepthT          Proxy TypeSignature
typeSignatureT
           , Assessment NumFunArgs
-> Proxy NumFunArgs -> Proxy TypeSignature -> Program -> Log
forall from m c.
(Data from, Metric m c) =>
Assessment m -> Proxy m -> Proxy c -> from -> Log
measureTopOccurs Assessment NumFunArgs
assessNumFunArgs         Proxy NumFunArgs
numFunArgsT        Proxy TypeSignature
typeSignatureT
           , Assessment RecordFieldsCount
-> Proxy RecordFieldsCount -> Proxy DataDef -> Program -> Log
forall from m c.
(Data from, Metric m c) =>
Assessment m -> Proxy m -> Proxy c -> from -> Log
measureTopOccurs Assessment RecordFieldsCount
assessRecordFieldsCount  Proxy RecordFieldsCount
recordFieldsCountT Proxy DataDef
dataDefT
           , Assessment NonTypeDeclCount
-> Proxy NonTypeDeclCount -> Proxy TypeClass -> Program -> Log
forall from m c.
(Data from, Metric m c) =>
Assessment m -> Proxy m -> Proxy c -> from -> Log
measureTopOccurs Assessment NonTypeDeclCount
assessTCNonTypeDeclCount Proxy NonTypeDeclCount
nonTypeDeclCountT  Proxy TypeClass
typeClassT
           , Assessment AssocTypeCount
-> Proxy AssocTypeCount -> Proxy TypeClass -> Program -> Log
forall from m c.
(Data from, Metric m c) =>
Assessment m -> Proxy m -> Proxy c -> from -> Log
measureTopOccurs Assessment AssocTypeCount
assessTCAssocTypesCount  Proxy AssocTypeCount
assocTypeCountT    Proxy TypeClass
typeClassT
           ]