module Language.Haskell.Homplexity.Utilities(
    sumOf
  , maxOf
  , declHeadName
  ) where

import Language.Haskell.Exts.Syntax (DeclHead(..), Name)

-- | Maximum of 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

-- | Sum the results of mapping the function over the list.
sumOf :: (a -> Int) -> [a] -> Int
sumOf :: forall a. (a -> Int) -> [a] -> Int
sumOf a -> Int
f = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([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

-- | Get the name of a declaration.
declHeadName :: DeclHead l -> Name l
declHeadName :: forall l. DeclHead l -> Name l
declHeadName (DHead l
_ Name l
name)     = Name l
name
declHeadName (DHInfix l
_ TyVarBind l
_ Name l
name) = Name l
name
declHeadName (DHParen l
_ DeclHead l
dh)     = DeclHead l -> Name l
forall l. DeclHead l -> Name l
declHeadName DeclHead l
dh
declHeadName (DHApp l
_ DeclHead l
dh TyVarBind l
_)     = DeclHead l -> Name l
forall l. DeclHead l -> Name l
declHeadName DeclHead l
dh