homplexity-0.4.8.1: Haskell code quality tool
Safe HaskellSafe-Inferred
LanguageHaskell2010

Language.Haskell.Homplexity.CodeFragment

Description

This module generalizes over types of code fragments that may need to be iterated upon and measured separately.

Synopsis

Documentation

class (Show c, Data (AST c), Data c) => CodeFragment c where Source #

Class CodeFragment allows for: * both selecting direct or all descendants of the given type of object within another structure (with occurs and allOccurs) * naming the object to allow user to distinguish it.

In order to compute selection, we just need to know which AST nodes contain the given object, and how to extract this given object from AST, if it is there (matchAST).:w

Minimal complete definition

matchAST, fragmentName

Methods

fragmentName :: c -> String Source #

fragmentSlice :: c -> SrcSlice Source #

Instances

Instances details
CodeFragment DataDef Source # 
Instance details

Defined in Language.Haskell.Homplexity.CodeFragment

Associated Types

type AST DataDef

CodeFragment Function Source # 
Instance details

Defined in Language.Haskell.Homplexity.CodeFragment

Associated Types

type AST Function

CodeFragment Program Source # 
Instance details

Defined in Language.Haskell.Homplexity.CodeFragment

Associated Types

type AST Program

CodeFragment TypeClass Source # 
Instance details

Defined in Language.Haskell.Homplexity.CodeFragment

Associated Types

type AST TypeClass

CodeFragment TypeSignature Source # 
Instance details

Defined in Language.Haskell.Homplexity.CodeFragment

Associated Types

type AST TypeSignature

CodeFragment (Module SrcLoc) Source # 
Instance details

Defined in Language.Haskell.Homplexity.CodeFragment

Associated Types

type AST (Module SrcLoc)

Methods

matchAST :: AST (Module SrcLoc) -> Maybe (Module SrcLoc)

fragmentName :: Module SrcLoc -> String Source #

fragmentSlice :: Module SrcLoc -> SrcSlice Source #

occurs :: (CodeFragment c, Data from) => from -> [c] Source #

Direct occurences of given CodeFragment fragment within another structure.

occursOf :: (Data from, CodeFragment c) => Proxy c -> from -> [c] Source #

Explicitly typed variant of occurs.

allOccurs :: (CodeFragment c, Data from) => from -> [c] Source #

allOccursOf :: (Data from, CodeFragment c) => Proxy c -> from -> [c] Source #

Explicitly typed variant of allOccurs.

newtype Program Source #

Program

Constructors

Program 

Fields

Instances

Instances details
Data Program Source # 
Instance details

Defined in Language.Haskell.Homplexity.CodeFragment

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Program -> c Program

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Program

toConstr :: Program -> Constr

dataTypeOf :: Program -> DataType

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Program)

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Program)

gmapT :: (forall b. Data b => b -> b) -> Program -> Program

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Program -> r

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Program -> r

gmapQ :: (forall d. Data d => d -> u) -> Program -> [u]

gmapQi :: Int -> (forall d. Data d => d -> u) -> Program -> u

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Program -> m Program

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Program -> m Program

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Program -> m Program

Show Program Source # 
Instance details

Defined in Language.Haskell.Homplexity.CodeFragment

Methods

showsPrec :: Int -> Program -> ShowS

show :: Program -> String

showList :: [Program] -> ShowS

CodeFragment Program Source # 
Instance details

Defined in Language.Haskell.Homplexity.CodeFragment

Associated Types

type AST Program

programT :: Proxy Program Source #

Proxy for passing Program type as an argument.

program :: [Module SrcLoc] -> Program Source #

Smart constructor for adding cross-references in the future.

data Module l #

Constructors

Module l (Maybe (ModuleHead l)) [ModulePragma l] [ImportDecl l] [Decl l] 
XmlPage l (ModuleName l) [ModulePragma l] (XName l) [XAttr l] (Maybe (Exp l)) [Exp l] 
XmlHybrid l (Maybe (ModuleHead l)) [ModulePragma l] [ImportDecl l] [Decl l] (XName l) [XAttr l] (Maybe (Exp l)) [Exp l] 

Instances

Instances details
Foldable Module 
Instance details

Defined in Language.Haskell.Exts.Syntax

Methods

fold :: Monoid m => Module m -> m

foldMap :: Monoid m => (a -> m) -> Module a -> m

foldMap' :: Monoid m => (a -> m) -> Module a -> m

foldr :: (a -> b -> b) -> b -> Module a -> b

foldr' :: (a -> b -> b) -> b -> Module a -> b

foldl :: (b -> a -> b) -> b -> Module a -> b

foldl' :: (b -> a -> b) -> b -> Module a -> b

foldr1 :: (a -> a -> a) -> Module a -> a

foldl1 :: (a -> a -> a) -> Module a -> a

toList :: Module a -> [a]

null :: Module a -> Bool

length :: Module a -> Int

elem :: Eq a => a -> Module a -> Bool

maximum :: Ord a => Module a -> a

minimum :: Ord a => Module a -> a

sum :: Num a => Module a -> a

product :: Num a => Module a -> a

Traversable Module 
Instance details

Defined in Language.Haskell.Exts.Syntax

Methods

traverse :: Applicative f => (a -> f b) -> Module a -> f (Module b)

sequenceA :: Applicative f => Module (f a) -> f (Module a)

mapM :: Monad m => (a -> m b) -> Module a -> m (Module b)

sequence :: Monad m => Module (m a) -> m (Module a)

Functor Module 
Instance details

Defined in Language.Haskell.Exts.Syntax

Methods

fmap :: (a -> b) -> Module a -> Module b

(<$) :: a -> Module b -> Module a

ExactP Module 
Instance details

Defined in Language.Haskell.Exts.ExactPrint

Methods

exactP :: Module SrcSpanInfo -> EP ()

AppFixity Module 
Instance details

Defined in Language.Haskell.Exts.Fixity

Methods

applyFixities :: MonadFail m => [Fixity] -> Module SrcSpanInfo -> m (Module SrcSpanInfo)

Annotated Module 
Instance details

Defined in Language.Haskell.Exts.Syntax

Methods

ann :: Module l -> l

amap :: (l -> l) -> Module l -> Module l

Data l => Data (Module l) 
Instance details

Defined in Language.Haskell.Exts.Syntax

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Module l -> c (Module l)

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Module l)

toConstr :: Module l -> Constr

dataTypeOf :: Module l -> DataType

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (Module l))

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Module l))

gmapT :: (forall b. Data b => b -> b) -> Module l -> Module l

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Module l -> r

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Module l -> r

gmapQ :: (forall d. Data d => d -> u) -> Module l -> [u]

gmapQi :: Int -> (forall d. Data d => d -> u) -> Module l -> u

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Module l -> m (Module l)

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Module l -> m (Module l)

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Module l -> m (Module l)

Generic (Module l) 
Instance details

Defined in Language.Haskell.Exts.Syntax

Associated Types

type Rep (Module l) :: Type -> Type

Methods

from :: Module l -> Rep (Module l) x

to :: Rep (Module l) x -> Module l

Show l => Show (Module l) 
Instance details

Defined in Language.Haskell.Exts.Syntax

Methods

showsPrec :: Int -> Module l -> ShowS

show :: Module l -> String

showList :: [Module l] -> ShowS

Eq l => Eq (Module l) 
Instance details

Defined in Language.Haskell.Exts.Syntax

Methods

(==) :: Module l -> Module l -> Bool

(/=) :: Module l -> Module l -> Bool

Ord l => Ord (Module l) 
Instance details

Defined in Language.Haskell.Exts.Syntax

Methods

compare :: Module l -> Module l -> Ordering

(<) :: Module l -> Module l -> Bool

(<=) :: Module l -> Module l -> Bool

(>) :: Module l -> Module l -> Bool

(>=) :: Module l -> Module l -> Bool

max :: Module l -> Module l -> Module l

min :: Module l -> Module l -> Module l

Pretty (Module pos) 
Instance details

Defined in Language.Haskell.Exts.Pretty

Methods

pretty :: Module pos -> Doc

prettyPrec :: Int -> Module pos -> Doc

CodeFragment (Module SrcLoc) Source # 
Instance details

Defined in Language.Haskell.Homplexity.CodeFragment

Associated Types

type AST (Module SrcLoc)

Methods

matchAST :: AST (Module SrcLoc) -> Maybe (Module SrcLoc)

fragmentName :: Module SrcLoc -> String Source #

fragmentSlice :: Module SrcLoc -> SrcSlice Source #

type Rep (Module l) 
Instance details

Defined in Language.Haskell.Exts.Syntax

type Rep (Module l) = D1 ('MetaData "Module" "Language.Haskell.Exts.Syntax" "haskell-src-exts-1.23.1-232fe581ea5b1e36619e557b053dfbe555d5bcad5cb120276359fe905944e816" 'False) (C1 ('MetaCons "Module" 'PrefixI 'False) ((S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 l) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (ModuleHead l)))) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [ModulePragma l]) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [ImportDecl l]) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Decl l])))) :+: (C1 ('MetaCons "XmlPage" 'PrefixI 'False) ((S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 l) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (ModuleName l)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [ModulePragma l]))) :*: ((S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (XName l)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [XAttr l])) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (Exp l))) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Exp l])))) :+: C1 ('MetaCons "XmlHybrid" 'PrefixI 'False) (((S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 l) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (ModuleHead l)))) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [ModulePragma l]) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [ImportDecl l]))) :*: ((S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Decl l]) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (XName l))) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [XAttr l]) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (Exp l))) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Exp l])))))))

moduleT :: Proxy (Module SrcLoc) Source #

Proxy for passing Module type as an argument.

data Function Source #

Alias for a function declaration

Constructors

Function 

Fields

Instances

Instances details
Data Function Source # 
Instance details

Defined in Language.Haskell.Homplexity.CodeFragment

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Function -> c Function

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Function

toConstr :: Function -> Constr

dataTypeOf :: Function -> DataType

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Function)

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Function)

gmapT :: (forall b. Data b => b -> b) -> Function -> Function

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Function -> r

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Function -> r

gmapQ :: (forall d. Data d => d -> u) -> Function -> [u]

gmapQi :: Int -> (forall d. Data d => d -> u) -> Function -> u

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Function -> m Function

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Function -> m Function

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Function -> m Function

Show Function Source # 
Instance details

Defined in Language.Haskell.Homplexity.CodeFragment

Methods

showsPrec :: Int -> Function -> ShowS

show :: Function -> String

showList :: [Function] -> ShowS

CodeFragment Function Source # 
Instance details

Defined in Language.Haskell.Homplexity.CodeFragment

Associated Types

type AST Function

Metric Cyclomatic Function Source # 
Instance details

Defined in Language.Haskell.Homplexity.Cyclomatic

Metric Depth Function Source # 
Instance details

Defined in Language.Haskell.Homplexity.Cyclomatic

functionT :: Proxy Function Source #

Proxy for passing Function type as an argument.

data DataDef Source #

Alias for a data declaration

Constructors

DataDef 

Fields

Instances

Instances details
Data DataDef Source # 
Instance details

Defined in Language.Haskell.Homplexity.CodeFragment

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> DataDef -> c DataDef

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c DataDef

toConstr :: DataDef -> Constr

dataTypeOf :: DataDef -> DataType

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c DataDef)

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DataDef)

gmapT :: (forall b. Data b => b -> b) -> DataDef -> DataDef

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> DataDef -> r

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> DataDef -> r

gmapQ :: (forall d. Data d => d -> u) -> DataDef -> [u]

gmapQi :: Int -> (forall d. Data d => d -> u) -> DataDef -> u

gmapM :: Monad m => (forall d. Data d => d -> m d) -> DataDef -> m DataDef

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> DataDef -> m DataDef

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> DataDef -> m DataDef

Show DataDef Source # 
Instance details

Defined in Language.Haskell.Homplexity.CodeFragment

Methods

showsPrec :: Int -> DataDef -> ShowS

show :: DataDef -> String

showList :: [DataDef] -> ShowS

CodeFragment DataDef Source # 
Instance details

Defined in Language.Haskell.Homplexity.CodeFragment

Associated Types

type AST DataDef

Metric RecordFieldsCount DataDef Source # 
Instance details

Defined in Language.Haskell.Homplexity.RecordFieldsCount

dataDefT :: Proxy DataDef Source #

Proxy for passing DataDef type as an argument.

data TypeSignature Source #

Type alias for a type signature of a function as a CodeFragment

Constructors

TypeSignature 

Fields

Instances

Instances details
Data TypeSignature Source # 
Instance details

Defined in Language.Haskell.Homplexity.CodeFragment

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> TypeSignature -> c TypeSignature

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c TypeSignature

toConstr :: TypeSignature -> Constr

dataTypeOf :: TypeSignature -> DataType

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c TypeSignature)

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TypeSignature)

gmapT :: (forall b. Data b => b -> b) -> TypeSignature -> TypeSignature

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> TypeSignature -> r

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> TypeSignature -> r

gmapQ :: (forall d. Data d => d -> u) -> TypeSignature -> [u]

gmapQi :: Int -> (forall d. Data d => d -> u) -> TypeSignature -> u

gmapM :: Monad m => (forall d. Data d => d -> m d) -> TypeSignature -> m TypeSignature

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> TypeSignature -> m TypeSignature

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> TypeSignature -> m TypeSignature

Show TypeSignature Source # 
Instance details

Defined in Language.Haskell.Homplexity.CodeFragment

Methods

showsPrec :: Int -> TypeSignature -> ShowS

show :: TypeSignature -> String

showList :: [TypeSignature] -> ShowS

CodeFragment TypeSignature Source # 
Instance details

Defined in Language.Haskell.Homplexity.CodeFragment

Associated Types

type AST TypeSignature

Metric ConDepth TypeSignature Source # 
Instance details

Defined in Language.Haskell.Homplexity.TypeComplexity

Metric NumFunArgs TypeSignature Source # 
Instance details

Defined in Language.Haskell.Homplexity.TypeComplexity

typeSignatureT :: Proxy TypeSignature Source #

Proxy for passing TypeSignature type as an argument.

data TypeClass Source #

Alias for a class signature

Constructors

TypeClass 

Fields

Instances

Instances details
Data TypeClass Source # 
Instance details

Defined in Language.Haskell.Homplexity.CodeFragment

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> TypeClass -> c TypeClass

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c TypeClass

toConstr :: TypeClass -> Constr

dataTypeOf :: TypeClass -> DataType

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c TypeClass)

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TypeClass)

gmapT :: (forall b. Data b => b -> b) -> TypeClass -> TypeClass

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> TypeClass -> r

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> TypeClass -> r

gmapQ :: (forall d. Data d => d -> u) -> TypeClass -> [u]

gmapQi :: Int -> (forall d. Data d => d -> u) -> TypeClass -> u

gmapM :: Monad m => (forall d. Data d => d -> m d) -> TypeClass -> m TypeClass

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> TypeClass -> m TypeClass

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> TypeClass -> m TypeClass

Show TypeClass Source # 
Instance details

Defined in Language.Haskell.Homplexity.CodeFragment

Methods

showsPrec :: Int -> TypeClass -> ShowS

show :: TypeClass -> String

showList :: [TypeClass] -> ShowS

CodeFragment TypeClass Source # 
Instance details

Defined in Language.Haskell.Homplexity.CodeFragment

Associated Types

type AST TypeClass

Metric AssocTypeCount TypeClass Source # 
Instance details

Defined in Language.Haskell.Homplexity.TypeClassComplexity

Metric NonTypeDeclCount TypeClass Source # 
Instance details

Defined in Language.Haskell.Homplexity.TypeClassComplexity

typeClassT :: Proxy TypeClass Source #

Proxy for passing TypeClass type as an argument.

fragmentLoc :: CodeFragment c => c -> SrcLoc Source #

First location for each CodeFragment - for convenient reporting.