content: {-# LANGUAGE MultiParamTypeClasses      #-}
  {-# LANGUAGE ScopedTypeVariables        #-}
  {-# LANGUAGE FlexibleContexts           #-}
  {-# LANGUAGE FlexibleInstances          #-}
  {-# LANGUAGE RecordWildCards            #-}
  {-# LANGUAGE UndecidableInstances       #-}
  {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  -- | Computing cyclomatic complexity and branching depth.
  module Language.Haskell.Homplexity.Cyclomatic(
      Cyclomatic
    , cyclomaticT
    , Depth
    , depthT) where
  
  import Data.Data
  import Data.Generics.Uniplate.Data
  import Language.Haskell.Exts.SrcLoc
  import Language.Haskell.Exts.Syntax
  import Language.Haskell.Homplexity.CodeFragment
  import Language.Haskell.Homplexity.Metric
  import Language.Haskell.Homplexity.Utilities
  
  type MatchSet = [Match SrcLoc]
  
  -- * Cyclomatic complexity
  -- | Represents cyclomatic complexity
  newtype Cyclomatic = Cyclomatic { unCyclo :: Int }
    deriving (Eq, Ord, Enum, Num, Real, Integral)
  
  -- | For passing @Cyclomatic@ type as parameter.
  cyclomaticT :: Proxy Cyclomatic 
  cyclomaticT  = Proxy
  
  instance Show Cyclomatic where
    showsPrec _ (Cyclomatic cc) = ("cyclomatic complexity of " ++)
                                . shows cc
  
  instance Metric Cyclomatic Function where
    measure x = Cyclomatic . cyclomatic $ x
  
  -- | Computing cyclomatic complexity on a code fragment
  cyclomatic :: Data from => from -> Int
  cyclomatic x = cyclomaticOfMatches x
               + cyclomaticOfExprs   x
               + 1
  
  -- | Compute cyclomatic complexity of pattern matches.
  cyclomaticOfMatches :: Data from => from -> Int
  cyclomaticOfMatches  = sumOf recurse . childrenBi
    where
      recurse   :: MatchSet -> Int
      recurse  x = length x - 1 +  sumOf cyclomaticOfMatches x
  
  -- | Cyclomatic complexity of all expressions
  cyclomaticOfExprs :: forall from.
          Data from => from -> Int
  cyclomaticOfExprs = sumOf armCount . (universeBi :: from -> [Exp SrcLoc])
    where
      armCount (If      {}    ) = 2           - 1
      armCount (MultiIf _ alts) = length alts - 1
      armCount (LCase   _ alts) = length alts - 1
      armCount (Case  _ _ alts) = length alts - 1
      armCount _              = 0               -- others are ignored
  
  -- * Decision depth
  -- | Decision depth
  newtype Depth = Depth Int
    deriving (Eq, Ord, Enum, Num, Real, Integral)
  
  -- | For passing @Depth@ type as parameter.
  depthT :: Proxy Depth 
  depthT  = Proxy
  
  instance Metric Depth Function where
    measure (Function {..}) = Depth $ depthOfMatches functionRhs `max` depthOfMatches functionBinds
  
  instance Show Depth where
    showsPrec _ (Depth d) = ("branching depth of "++)
                          .  shows d
  
  -- | Depth of branching within @Exp@ression.
  depthOfExpr :: Exp SrcLoc -> Int
  depthOfExpr x = fromEnum (isDecision x)+maxOf depthOfExpr (children x)
  
  -- | Helper function to compute depth of branching within @case@ expression match.
  depthOfMatches ::  Data from => [from] -> Int
  depthOfMatches []   = 0 -- Should never happen
  depthOfMatches [m ] =   maxOf depthOfExpr           (childrenBi m )
  depthOfMatches  ms  = 1+maxOf depthOfExpr (concatMap childrenBi ms)
  
  -- | Check whether given @Exp@ression node is a decision node (conditional branch.)
  isDecision           :: Exp SrcLoc -> Bool
  isDecision If      {} = True
  isDecision MultiIf {} = True 
  isDecision LCase   {} = True
  isDecision Case    {} = True
  isDecision _          = False
  
  