{-# 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 :: forall a. (a -> Int) -> [a] -> Int
maxOf a -> Int
f = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> ([a] -> [Int]) -> [a] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
0Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:)([Int] -> [Int]) -> ([a] -> [Int]) -> [a] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Int) -> [a] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map a -> Int
f

-- * Depth of type constructor nesting
newtype ConDepth = ConDepth { ConDepth -> Int
unConDepth :: Int }
  deriving (ConDepth -> ConDepth -> Bool
(ConDepth -> ConDepth -> Bool)
-> (ConDepth -> ConDepth -> Bool) -> Eq ConDepth
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConDepth -> ConDepth -> Bool
== :: ConDepth -> ConDepth -> Bool
$c/= :: ConDepth -> ConDepth -> Bool
/= :: ConDepth -> ConDepth -> Bool
Eq, Eq ConDepth
Eq ConDepth
-> (ConDepth -> ConDepth -> Ordering)
-> (ConDepth -> ConDepth -> Bool)
-> (ConDepth -> ConDepth -> Bool)
-> (ConDepth -> ConDepth -> Bool)
-> (ConDepth -> ConDepth -> Bool)
-> (ConDepth -> ConDepth -> ConDepth)
-> (ConDepth -> ConDepth -> ConDepth)
-> Ord ConDepth
ConDepth -> ConDepth -> Bool
ConDepth -> ConDepth -> Ordering
ConDepth -> ConDepth -> ConDepth
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ConDepth -> ConDepth -> Ordering
compare :: ConDepth -> ConDepth -> Ordering
$c< :: ConDepth -> ConDepth -> Bool
< :: ConDepth -> ConDepth -> Bool
$c<= :: ConDepth -> ConDepth -> Bool
<= :: ConDepth -> ConDepth -> Bool
$c> :: ConDepth -> ConDepth -> Bool
> :: ConDepth -> ConDepth -> Bool
$c>= :: ConDepth -> ConDepth -> Bool
>= :: ConDepth -> ConDepth -> Bool
$cmax :: ConDepth -> ConDepth -> ConDepth
max :: ConDepth -> ConDepth -> ConDepth
$cmin :: ConDepth -> ConDepth -> ConDepth
min :: ConDepth -> ConDepth -> ConDepth
Ord, Int -> ConDepth
ConDepth -> Int
ConDepth -> [ConDepth]
ConDepth -> ConDepth
ConDepth -> ConDepth -> [ConDepth]
ConDepth -> ConDepth -> ConDepth -> [ConDepth]
(ConDepth -> ConDepth)
-> (ConDepth -> ConDepth)
-> (Int -> ConDepth)
-> (ConDepth -> Int)
-> (ConDepth -> [ConDepth])
-> (ConDepth -> ConDepth -> [ConDepth])
-> (ConDepth -> ConDepth -> [ConDepth])
-> (ConDepth -> ConDepth -> ConDepth -> [ConDepth])
-> Enum ConDepth
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ConDepth -> ConDepth
succ :: ConDepth -> ConDepth
$cpred :: ConDepth -> ConDepth
pred :: ConDepth -> ConDepth
$ctoEnum :: Int -> ConDepth
toEnum :: Int -> ConDepth
$cfromEnum :: ConDepth -> Int
fromEnum :: ConDepth -> Int
$cenumFrom :: ConDepth -> [ConDepth]
enumFrom :: ConDepth -> [ConDepth]
$cenumFromThen :: ConDepth -> ConDepth -> [ConDepth]
enumFromThen :: ConDepth -> ConDepth -> [ConDepth]
$cenumFromTo :: ConDepth -> ConDepth -> [ConDepth]
enumFromTo :: ConDepth -> ConDepth -> [ConDepth]
$cenumFromThenTo :: ConDepth -> ConDepth -> ConDepth -> [ConDepth]
enumFromThenTo :: ConDepth -> ConDepth -> ConDepth -> [ConDepth]
Enum, Integer -> ConDepth
ConDepth -> ConDepth
ConDepth -> ConDepth -> ConDepth
(ConDepth -> ConDepth -> ConDepth)
-> (ConDepth -> ConDepth -> ConDepth)
-> (ConDepth -> ConDepth -> ConDepth)
-> (ConDepth -> ConDepth)
-> (ConDepth -> ConDepth)
-> (ConDepth -> ConDepth)
-> (Integer -> ConDepth)
-> Num ConDepth
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: ConDepth -> ConDepth -> ConDepth
+ :: ConDepth -> ConDepth -> ConDepth
$c- :: ConDepth -> ConDepth -> ConDepth
- :: ConDepth -> ConDepth -> ConDepth
$c* :: ConDepth -> ConDepth -> ConDepth
* :: ConDepth -> ConDepth -> ConDepth
$cnegate :: ConDepth -> ConDepth
negate :: ConDepth -> ConDepth
$cabs :: ConDepth -> ConDepth
abs :: ConDepth -> ConDepth
$csignum :: ConDepth -> ConDepth
signum :: ConDepth -> ConDepth
$cfromInteger :: Integer -> ConDepth
fromInteger :: Integer -> ConDepth
Num, Num ConDepth
Ord ConDepth
Num ConDepth
-> Ord ConDepth -> (ConDepth -> Rational) -> Real ConDepth
ConDepth -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
$ctoRational :: ConDepth -> Rational
toRational :: ConDepth -> Rational
Real, Enum ConDepth
Real ConDepth
Real ConDepth
-> Enum ConDepth
-> (ConDepth -> ConDepth -> ConDepth)
-> (ConDepth -> ConDepth -> ConDepth)
-> (ConDepth -> ConDepth -> ConDepth)
-> (ConDepth -> ConDepth -> ConDepth)
-> (ConDepth -> ConDepth -> (ConDepth, ConDepth))
-> (ConDepth -> ConDepth -> (ConDepth, ConDepth))
-> (ConDepth -> Integer)
-> Integral ConDepth
ConDepth -> Integer
ConDepth -> ConDepth -> (ConDepth, ConDepth)
ConDepth -> ConDepth -> ConDepth
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: ConDepth -> ConDepth -> ConDepth
quot :: ConDepth -> ConDepth -> ConDepth
$crem :: ConDepth -> ConDepth -> ConDepth
rem :: ConDepth -> ConDepth -> ConDepth
$cdiv :: ConDepth -> ConDepth -> ConDepth
div :: ConDepth -> ConDepth -> ConDepth
$cmod :: ConDepth -> ConDepth -> ConDepth
mod :: ConDepth -> ConDepth -> ConDepth
$cquotRem :: ConDepth -> ConDepth -> (ConDepth, ConDepth)
quotRem :: ConDepth -> ConDepth -> (ConDepth, ConDepth)
$cdivMod :: ConDepth -> ConDepth -> (ConDepth, ConDepth)
divMod :: ConDepth -> ConDepth -> (ConDepth, ConDepth)
$ctoInteger :: ConDepth -> Integer
toInteger :: ConDepth -> Integer
Integral)

conDepthT :: Proxy ConDepth
conDepthT :: Proxy ConDepth
conDepthT  = Proxy ConDepth
forall {k} (t :: k). Proxy t
Proxy

instance Show ConDepth where
  showsPrec :: Int -> ConDepth -> ShowS
showsPrec Int
_ (ConDepth Int
cc) = (String
"type constructor nesting of " String -> ShowS
forall a. [a] -> [a] -> [a]
++)
                            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
cc

instance Metric ConDepth TypeSignature where
  measure :: TypeSignature -> ConDepth
measure = Int -> ConDepth
ConDepth (Int -> ConDepth)
-> (TypeSignature -> Int) -> TypeSignature -> ConDepth
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type SrcLoc -> Int
forall a. (Eq a, Data a) => Type a -> Int
conDepth (Type SrcLoc -> Int)
-> (TypeSignature -> Type SrcLoc) -> TypeSignature -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeSignature -> Type SrcLoc
theType

-- | Function computing constructor depth of a @Type@.
conDepth :: (Eq a, Data a) => Type a -> Int
conDepth :: forall a. (Eq a, Data a) => Type a -> Int
conDepth Type a
con = Type a -> Int
forall a. Type a -> Int
deeper Type a
con Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Type a -> Int) -> [Type a] -> Int
forall a. (a -> Int) -> [a] -> Int
maxOf Type a -> Int
forall a. (Eq a, Data a) => Type a -> Int
conDepth ((Type a -> Bool) -> [Type a] -> [Type a]
forall a. (a -> Bool) -> [a] -> [a]
filter (Type a -> Type a -> Bool
forall a. Eq a => a -> a -> Bool
/= Type a
con) ([Type a] -> [Type a]) -> [Type a] -> [Type a]
forall a b. (a -> b) -> a -> b
$ Type a -> [Type a]
forall from to. Biplate from to => from -> [to]
childrenBi Type a
con)

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

-- * Number of function arguments
newtype NumFunArgs = NumFunArgs { NumFunArgs -> Int
_unNumFunArgs :: Int }
  deriving (NumFunArgs -> NumFunArgs -> Bool
(NumFunArgs -> NumFunArgs -> Bool)
-> (NumFunArgs -> NumFunArgs -> Bool) -> Eq NumFunArgs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NumFunArgs -> NumFunArgs -> Bool
== :: NumFunArgs -> NumFunArgs -> Bool
$c/= :: NumFunArgs -> NumFunArgs -> Bool
/= :: NumFunArgs -> NumFunArgs -> Bool
Eq, Eq NumFunArgs
Eq NumFunArgs
-> (NumFunArgs -> NumFunArgs -> Ordering)
-> (NumFunArgs -> NumFunArgs -> Bool)
-> (NumFunArgs -> NumFunArgs -> Bool)
-> (NumFunArgs -> NumFunArgs -> Bool)
-> (NumFunArgs -> NumFunArgs -> Bool)
-> (NumFunArgs -> NumFunArgs -> NumFunArgs)
-> (NumFunArgs -> NumFunArgs -> NumFunArgs)
-> Ord NumFunArgs
NumFunArgs -> NumFunArgs -> Bool
NumFunArgs -> NumFunArgs -> Ordering
NumFunArgs -> NumFunArgs -> NumFunArgs
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: NumFunArgs -> NumFunArgs -> Ordering
compare :: NumFunArgs -> NumFunArgs -> Ordering
$c< :: NumFunArgs -> NumFunArgs -> Bool
< :: NumFunArgs -> NumFunArgs -> Bool
$c<= :: NumFunArgs -> NumFunArgs -> Bool
<= :: NumFunArgs -> NumFunArgs -> Bool
$c> :: NumFunArgs -> NumFunArgs -> Bool
> :: NumFunArgs -> NumFunArgs -> Bool
$c>= :: NumFunArgs -> NumFunArgs -> Bool
>= :: NumFunArgs -> NumFunArgs -> Bool
$cmax :: NumFunArgs -> NumFunArgs -> NumFunArgs
max :: NumFunArgs -> NumFunArgs -> NumFunArgs
$cmin :: NumFunArgs -> NumFunArgs -> NumFunArgs
min :: NumFunArgs -> NumFunArgs -> NumFunArgs
Ord, Int -> NumFunArgs
NumFunArgs -> Int
NumFunArgs -> [NumFunArgs]
NumFunArgs -> NumFunArgs
NumFunArgs -> NumFunArgs -> [NumFunArgs]
NumFunArgs -> NumFunArgs -> NumFunArgs -> [NumFunArgs]
(NumFunArgs -> NumFunArgs)
-> (NumFunArgs -> NumFunArgs)
-> (Int -> NumFunArgs)
-> (NumFunArgs -> Int)
-> (NumFunArgs -> [NumFunArgs])
-> (NumFunArgs -> NumFunArgs -> [NumFunArgs])
-> (NumFunArgs -> NumFunArgs -> [NumFunArgs])
-> (NumFunArgs -> NumFunArgs -> NumFunArgs -> [NumFunArgs])
-> Enum NumFunArgs
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: NumFunArgs -> NumFunArgs
succ :: NumFunArgs -> NumFunArgs
$cpred :: NumFunArgs -> NumFunArgs
pred :: NumFunArgs -> NumFunArgs
$ctoEnum :: Int -> NumFunArgs
toEnum :: Int -> NumFunArgs
$cfromEnum :: NumFunArgs -> Int
fromEnum :: NumFunArgs -> Int
$cenumFrom :: NumFunArgs -> [NumFunArgs]
enumFrom :: NumFunArgs -> [NumFunArgs]
$cenumFromThen :: NumFunArgs -> NumFunArgs -> [NumFunArgs]
enumFromThen :: NumFunArgs -> NumFunArgs -> [NumFunArgs]
$cenumFromTo :: NumFunArgs -> NumFunArgs -> [NumFunArgs]
enumFromTo :: NumFunArgs -> NumFunArgs -> [NumFunArgs]
$cenumFromThenTo :: NumFunArgs -> NumFunArgs -> NumFunArgs -> [NumFunArgs]
enumFromThenTo :: NumFunArgs -> NumFunArgs -> NumFunArgs -> [NumFunArgs]
Enum, Integer -> NumFunArgs
NumFunArgs -> NumFunArgs
NumFunArgs -> NumFunArgs -> NumFunArgs
(NumFunArgs -> NumFunArgs -> NumFunArgs)
-> (NumFunArgs -> NumFunArgs -> NumFunArgs)
-> (NumFunArgs -> NumFunArgs -> NumFunArgs)
-> (NumFunArgs -> NumFunArgs)
-> (NumFunArgs -> NumFunArgs)
-> (NumFunArgs -> NumFunArgs)
-> (Integer -> NumFunArgs)
-> Num NumFunArgs
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: NumFunArgs -> NumFunArgs -> NumFunArgs
+ :: NumFunArgs -> NumFunArgs -> NumFunArgs
$c- :: NumFunArgs -> NumFunArgs -> NumFunArgs
- :: NumFunArgs -> NumFunArgs -> NumFunArgs
$c* :: NumFunArgs -> NumFunArgs -> NumFunArgs
* :: NumFunArgs -> NumFunArgs -> NumFunArgs
$cnegate :: NumFunArgs -> NumFunArgs
negate :: NumFunArgs -> NumFunArgs
$cabs :: NumFunArgs -> NumFunArgs
abs :: NumFunArgs -> NumFunArgs
$csignum :: NumFunArgs -> NumFunArgs
signum :: NumFunArgs -> NumFunArgs
$cfromInteger :: Integer -> NumFunArgs
fromInteger :: Integer -> NumFunArgs
Num, Num NumFunArgs
Ord NumFunArgs
Num NumFunArgs
-> Ord NumFunArgs -> (NumFunArgs -> Rational) -> Real NumFunArgs
NumFunArgs -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
$ctoRational :: NumFunArgs -> Rational
toRational :: NumFunArgs -> Rational
Real, Enum NumFunArgs
Real NumFunArgs
Real NumFunArgs
-> Enum NumFunArgs
-> (NumFunArgs -> NumFunArgs -> NumFunArgs)
-> (NumFunArgs -> NumFunArgs -> NumFunArgs)
-> (NumFunArgs -> NumFunArgs -> NumFunArgs)
-> (NumFunArgs -> NumFunArgs -> NumFunArgs)
-> (NumFunArgs -> NumFunArgs -> (NumFunArgs, NumFunArgs))
-> (NumFunArgs -> NumFunArgs -> (NumFunArgs, NumFunArgs))
-> (NumFunArgs -> Integer)
-> Integral NumFunArgs
NumFunArgs -> Integer
NumFunArgs -> NumFunArgs -> (NumFunArgs, NumFunArgs)
NumFunArgs -> NumFunArgs -> NumFunArgs
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: NumFunArgs -> NumFunArgs -> NumFunArgs
quot :: NumFunArgs -> NumFunArgs -> NumFunArgs
$crem :: NumFunArgs -> NumFunArgs -> NumFunArgs
rem :: NumFunArgs -> NumFunArgs -> NumFunArgs
$cdiv :: NumFunArgs -> NumFunArgs -> NumFunArgs
div :: NumFunArgs -> NumFunArgs -> NumFunArgs
$cmod :: NumFunArgs -> NumFunArgs -> NumFunArgs
mod :: NumFunArgs -> NumFunArgs -> NumFunArgs
$cquotRem :: NumFunArgs -> NumFunArgs -> (NumFunArgs, NumFunArgs)
quotRem :: NumFunArgs -> NumFunArgs -> (NumFunArgs, NumFunArgs)
$cdivMod :: NumFunArgs -> NumFunArgs -> (NumFunArgs, NumFunArgs)
divMod :: NumFunArgs -> NumFunArgs -> (NumFunArgs, NumFunArgs)
$ctoInteger :: NumFunArgs -> Integer
toInteger :: NumFunArgs -> Integer
Integral)

numFunArgsT :: Proxy NumFunArgs
numFunArgsT :: Proxy NumFunArgs
numFunArgsT  = Proxy NumFunArgs
forall {k} (t :: k). Proxy t
Proxy

instance Show NumFunArgs where
  showsPrec :: Int -> NumFunArgs -> ShowS
showsPrec Int
_ (NumFunArgs Int
cc) =  Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
cc
                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
" arguments"    String -> ShowS
forall a. [a] -> [a] -> [a]
++)

instance Metric NumFunArgs TypeSignature where
  measure :: TypeSignature -> NumFunArgs
measure = Int -> NumFunArgs
NumFunArgs (Int -> NumFunArgs)
-> (TypeSignature -> Int) -> TypeSignature -> NumFunArgs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type SrcLoc -> Int
forall a. Type a -> Int
numFunArgs (Type SrcLoc -> Int)
-> (TypeSignature -> Type SrcLoc) -> TypeSignature -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeSignature -> Type SrcLoc
theType

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