content: {-# 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.Proxy(Proxy)
  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
  
  