# LANGUAGE MultiParamTypeClasses       #
# LANGUAGE ScopedTypeVariables         #
# LANGUAGE FlexibleContexts            #
# LANGUAGE FlexibleInstances           #
{-# LANGUAGE UndecidableInstances       #-}
# LANGUAGE GeneralizedNewtypeDeriving #
-- | Computing cyclomatic complexity and branching depth.
module Language.Haskell.Homplexity.TypeComplexity(
    ConDepth
  , conDepthT
  , NumFunArgs
  , numFunArgsT) where

import Data.Data
import Data.Generics.Uniplate.Data
import Data .  )
import Language.Haskell.Exts.Syntax
import Language.Haskell.Homplexity.CodeFragment
import Language.Haskell.Homplexity.Metric
--import Debug.Trace

-- | Sum the results of mapping the function over the list.
maxOf :: (a -> Int) -> [a] -> Int
maxOf f = maximum . (0:). map f

-- * Depth of type constructor nesting
newtype ConDepth = ConDepth { unConDepth :: Int }
  deriving (Eq, Ord, Enum, Num, Real, Integral)

conDepthT :: Proxy ConDepth
conDepthT  = Proxy

instance Show ConDepth where
  showsPrec _ (ConDepth cc) = ("type constructor nesting of " ++)
                            . shows cc

instance Metric ConDepth TypeSignature where
  measure = ConDepth . conDepth . theType

-- | Function computing constructor depth of a @Type@.
conDepth :: (Eq a, Data a) => Type a -> Int
conDepth con = deeper con + maxOf conDepth (filter (/= con) $ childrenBi con)

-- | Check whether given constructor of @Type@ counts in constructor depth computation.
deeper :: Type a -> Int
deeper (TyForall   _ _bind _context _type) = 1
deeper (TyList     _ _aType         )      = 1
deeper (TyFun      _ _type1   _type2)      = 1
deeper (TyApp      _ _type1   _type2)      = 1
deeper (TyInfix    _ _type1 _ _type2)      = 1
deeper (TyTuple    _ _boxed   _types)      = 1
deeper (TyParArray _          _types)      = 1
deeper  _                                  = 0

-- * Number of function arguments
newtype NumFunArgs = NumFunArgs { _unNumFunArgs :: Int }
  deriving (Eq, Ord, Enum, Num, Real, Integral)

numFunArgsT :: Proxy NumFunArgs
numFunArgsT  = Proxy

instance Show NumFunArgs where
  showsPrec _ (NumFunArgs cc) =  shows cc
                              . (" arguments"    ++)

instance Metric NumFunArgs TypeSignature where
  measure = NumFunArgs . numFunArgs . theType

-- | Function computing constructor depth of a @Type@.
numFunArgs :: Type a -> Int
numFunArgs (TyParen    _ aType)                 =   numFunArgs aType
numFunArgs (TyKind     _ aType  _kind)          =   numFunArgs aType
numFunArgs (TyForall   _ _bind  _context aType) =   numFunArgs aType -- NOTE: doesn't count type argument
numFunArgs (TyFun      _ _type1 type2)          = 1+numFunArgs type2
numFunArgs (TyParArray _ aType)                 = 1+numFunArgs aType
numFunArgs  _                                   = 1


# LANGUAGE UndecidableInstances       #
 | Computing cyclomatic complexity and branching depth.
import Debug.Trace
 | Sum the results of mapping the function over the list.
 * Depth of type constructor nesting
 | Function computing constructor depth of a @Type@.
 | Check whether given constructor of @Type@ counts in constructor depth computation.
 * Number of function arguments
 | Function computing constructor depth of a @Type@.
 NOTE: doesn't count type argument
# LANGUAGE MultiParamTypeClasses       #
# LANGUAGE ScopedTypeVariables         #
# LANGUAGE FlexibleContexts            #
# LANGUAGE FlexibleInstances           #
# LANGUAGE GeneralizedNewtypeDeriving #
module Language.Haskell.Homplexity.TypeComplexity(
    ConDepth
  , conDepthT
  , NumFunArgs
  , numFunArgsT) where

import Data.Data
import Data.Generics.Uniplate.Data
import Data .  )
import Language.Haskell.Exts.Syntax
import Language.Haskell.Homplexity.CodeFragment
import Language.Haskell.Homplexity.Metric

maxOf :: (a -> Int) -> [a] -> Int
maxOf f = maximum . (0:). map f

newtype ConDepth = ConDepth { unConDepth :: Int }
  deriving (Eq, Ord, Enum, Num, Real, Integral)

conDepthT :: Proxy ConDepth
conDepthT  = Proxy

instance Show ConDepth where
  showsPrec _ (ConDepth cc) = ("type constructor nesting of " ++)
                            . shows cc

instance Metric ConDepth TypeSignature where
  measure = ConDepth . conDepth . theType

conDepth :: (Eq a, Data a) => Type a -> Int
conDepth con = deeper con + maxOf conDepth (filter (/= con) $ childrenBi con)

deeper :: Type a -> Int
deeper (TyForall   _ _bind _context _type) = 1
deeper (TyList     _ _aType         )      = 1
deeper (TyFun      _ _type1   _type2)      = 1
deeper (TyApp      _ _type1   _type2)      = 1
deeper (TyInfix    _ _type1 _ _type2)      = 1
deeper (TyTuple    _ _boxed   _types)      = 1
deeper (TyParArray _          _types)      = 1
deeper  _                                  = 0

newtype NumFunArgs = NumFunArgs { _unNumFunArgs :: Int }
  deriving (Eq, Ord, Enum, Num, Real, Integral)

numFunArgsT :: Proxy NumFunArgs
numFunArgsT  = Proxy

instance Show NumFunArgs where
  showsPrec _ (NumFunArgs cc) =  shows cc
                              . (" arguments"    ++)

instance Metric NumFunArgs TypeSignature where
  measure = NumFunArgs . numFunArgs . theType

numFunArgs :: Type a -> Int
numFunArgs (TyParen    _ aType)                 =   numFunArgs aType
numFunArgs (TyKind     _ aType  _kind)          =   numFunArgs aType
numFunArgs (TyFun      _ _type1 type2)          = 1+numFunArgs type2
numFunArgs (TyParArray _ aType)                 = 1+numFunArgs aType
numFunArgs  _                                   = 1

