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

-- | For passing @Cyclomatic@ type as parameter.
cyclomaticT :: Proxy Cyclomatic 
cyclomaticT :: Proxy Cyclomatic
cyclomaticT  = Proxy Cyclomatic
forall {k} (t :: k). Proxy t
Proxy

instance Show Cyclomatic where
  showsPrec :: Int -> Cyclomatic -> ShowS
showsPrec Int
_ (Cyclomatic Int
cc) = (String
"cyclomatic complexity 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 Cyclomatic Function where
  measure :: Function -> Cyclomatic
measure Function
x = Int -> Cyclomatic
Cyclomatic (Int -> Cyclomatic) -> (Function -> Int) -> Function -> Cyclomatic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Function -> Int
forall from. Data from => from -> Int
cyclomatic (Function -> Cyclomatic) -> Function -> Cyclomatic
forall a b. (a -> b) -> a -> b
$ Function
x

-- | Computing cyclomatic complexity on a code fragment
cyclomatic :: Data from => from -> Int
cyclomatic :: forall from. Data from => from -> Int
cyclomatic from
x = from -> Int
forall from. Data from => from -> Int
cyclomaticOfMatches from
x
             Int -> Int -> Int
forall a. Num a => a -> a -> a
+ from -> Int
forall from. Data from => from -> Int
cyclomaticOfExprs   from
x
             Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

-- | Compute cyclomatic complexity of pattern matches.
cyclomaticOfMatches :: Data from => from -> Int
cyclomaticOfMatches :: forall from. Data from => from -> Int
cyclomaticOfMatches  = (MatchSet -> Int) -> [MatchSet] -> Int
forall a. (a -> Int) -> [a] -> Int
sumOf MatchSet -> Int
recurse ([MatchSet] -> Int) -> (from -> [MatchSet]) -> from -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. from -> [MatchSet]
forall from to. Biplate from to => from -> [to]
childrenBi
  where
    recurse   :: MatchSet -> Int
    recurse :: MatchSet -> Int
recurse  MatchSet
x = MatchSet -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length MatchSet
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+  (Match SrcLoc -> Int) -> MatchSet -> Int
forall a. (a -> Int) -> [a] -> Int
sumOf Match SrcLoc -> Int
forall from. Data from => from -> Int
cyclomaticOfMatches MatchSet
x

-- | Cyclomatic complexity of all expressions
cyclomaticOfExprs :: forall from.
        Data from => from -> Int
cyclomaticOfExprs :: forall from. Data from => from -> Int
cyclomaticOfExprs = (Exp SrcLoc -> Int) -> [Exp SrcLoc] -> Int
forall a. (a -> Int) -> [a] -> Int
sumOf Exp SrcLoc -> Int
forall {l}. Exp l -> Int
armCount ([Exp SrcLoc] -> Int) -> (from -> [Exp SrcLoc]) -> from -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (from -> [Exp SrcLoc]
forall from to. Biplate from to => from -> [to]
universeBi :: from -> [Exp SrcLoc])
  where
    armCount :: Exp l -> Int
armCount (If      {}    ) = Int
2           Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    armCount (MultiIf l
_ [GuardedRhs l]
alts) = [GuardedRhs l] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [GuardedRhs l]
alts Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    armCount (LCase   l
_ [Alt l]
alts) = [Alt l] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Alt l]
alts Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    armCount (Case  l
_ Exp l
_ [Alt l]
alts) = [Alt l] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Alt l]
alts Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    armCount Exp l
_              = Int
0               -- others are ignored

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

-- | For passing @Depth@ type as parameter.
depthT :: Proxy Depth 
depthT :: Proxy Depth
depthT  = Proxy Depth
forall {k} (t :: k). Proxy t
Proxy

instance Metric Depth Function where
  measure :: Function -> Depth
measure (Function {[String]
[SrcLoc]
[Binds SrcLoc]
[Rhs SrcLoc]
functionNames :: [String]
functionLocations :: [SrcLoc]
functionRhs :: [Rhs SrcLoc]
functionBinds :: [Binds SrcLoc]
functionNames :: Function -> [String]
functionLocations :: Function -> [SrcLoc]
functionRhs :: Function -> [Rhs SrcLoc]
functionBinds :: Function -> [Binds SrcLoc]
..}) = Int -> Depth
Depth (Int -> Depth) -> Int -> Depth
forall a b. (a -> b) -> a -> b
$ [Rhs SrcLoc] -> Int
forall from. Data from => [from] -> Int
depthOfMatches [Rhs SrcLoc]
functionRhs Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` [Binds SrcLoc] -> Int
forall from. Data from => [from] -> Int
depthOfMatches [Binds SrcLoc]
functionBinds

instance Show Depth where
  showsPrec :: Int -> Depth -> ShowS
showsPrec Int
_ (Depth Int
d) = (String
"branching depth 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
d

-- | Depth of branching within @Exp@ression.
depthOfExpr :: Exp SrcLoc -> Int
depthOfExpr :: Exp SrcLoc -> Int
depthOfExpr Exp SrcLoc
x = Bool -> Int
forall a. Enum a => a -> Int
fromEnum (Exp SrcLoc -> Bool
isDecision Exp SrcLoc
x)Int -> Int -> Int
forall a. Num a => a -> a -> a
+(Exp SrcLoc -> Int) -> [Exp SrcLoc] -> Int
forall a. (a -> Int) -> [a] -> Int
maxOf Exp SrcLoc -> Int
depthOfExpr (Exp SrcLoc -> [Exp SrcLoc]
forall on. Uniplate on => on -> [on]
children Exp SrcLoc
x)

-- | Helper function to compute depth of branching within @case@ expression match.
depthOfMatches ::  Data from => [from] -> Int
depthOfMatches :: forall from. Data from => [from] -> Int
depthOfMatches []   = Int
0 -- Should never happen
depthOfMatches [from
m ] =   (Exp SrcLoc -> Int) -> [Exp SrcLoc] -> Int
forall a. (a -> Int) -> [a] -> Int
maxOf Exp SrcLoc -> Int
depthOfExpr           (from -> [Exp SrcLoc]
forall from to. Biplate from to => from -> [to]
childrenBi from
m )
depthOfMatches  [from]
ms  = Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+(Exp SrcLoc -> Int) -> [Exp SrcLoc] -> Int
forall a. (a -> Int) -> [a] -> Int
maxOf Exp SrcLoc -> Int
depthOfExpr ((from -> [Exp SrcLoc]) -> [from] -> [Exp SrcLoc]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap from -> [Exp SrcLoc]
forall from to. Biplate from to => from -> [to]
childrenBi [from]
ms)

-- | Check whether given @Exp@ression node is a decision node (conditional branch.)
isDecision           :: Exp SrcLoc -> Bool
isDecision :: Exp SrcLoc -> Bool
isDecision If      {} = Bool
True
isDecision MultiIf {} = Bool
True 
isDecision LCase   {} = Bool
True
isDecision Case    {} = Bool
True
isDecision Exp SrcLoc
_          = Bool
False