hs-inspector 0.4.0.0 → 0.5.0.0

raw patch · 7 files changed

+167/−99 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• hs-inspector.cabal +3/−2
• src/Language/Haskell/Detector.hs +0/−16
• src/Language/Haskell/Explorer.hs +71/−16
• src/Language/Haskell/Inspector.hs +42/−61
• src/Language/Haskell/Inspector/Combiner.hs +20/−0
• src/Language/Haskell/Inspector/Smell.hs +4/−4
• src/Language/Haskell/Names.hs +27/−0

@@ -2,7 +2,7 @@ --  http://haskell.org/cabal/users-guide/  name:                hs-inspector-version:             0.4.0.0+version:             0.5.0.0 license:             MIT license-file:        LICENSE author:              Franco Leonardo Bulgarelli@@ -21,10 +21,11 @@   hs-source-dirs:       src   exposed-modules:+    Language.Haskell.Names     Language.Haskell.Explorer-    Language.Haskell.Detector     Language.Haskell.Inspector     Language.Haskell.Inspector.Smell+    Language.Haskell.Inspector.Combiner   build-depends:     base                      >= 4     && < 5,     haskell-src               >= 1     && < 1.1

@@ -1,16 +0,0 @@-module Language.Haskell.Detector (detect) where--import Language.Haskell.Inspector-import Language.Haskell.Syntax--bindingsOf :: Code -> [String]-bindingsOf = orNil . withCode (concatMap bindings)-  where-  bindings (HsTypeSig _ [b] _) = [nameOf b]-  bindings (HsTypeDecl _ b _ _) = [nameOf b]-  bindings (HsPatBind _ (HsPVar n) _ _) = [nameOf n]-  bindings (HsFunBind cases)  = map bindingInMatch cases-  bindings _                  = []--detect :: Inspection -> Code -> [Binding]-detect inspection code = filter (`inspection` code) $ bindingsOf code

@@ -1,24 +1,79 @@-module Language.Haskell.Explorer where+module Language.Haskell.Explorer (+  parseDecls,+  parseBindings,+  declsOf,+  rhssOf,+  expressionsOf,+  expressionToBinding,+  EO(..),+  Binding,+  Code) where  import Language.Haskell.Syntax+import Language.Haskell.Names+import Language.Haskell.Parser +type Binding = String+type Code = String+ data EO = E HsExp | O HsQOp -exploreExprs f exprs = exploreEO f $ map (E) exprs+-- xxxOf functions: take a binding and code+-- parseXxx functions: take just code -exploreEO f es = any f es || any (exploreEO' f) es+declsOf :: Binding -> Code -> [HsDecl]+declsOf binding = filter (isBinding binding) . parseDecls -exploreEO' :: (EO -> Bool) -> EO -> Bool-exploreEO' f (E (HsInfixApp a b c)) = exploreEO f [E a, O b, E c]-exploreEO' f (E (HsApp a b))  = exploreEO f [E a, E b]-exploreEO' f (E (HsNegApp a))  = exploreEO f [E a]-exploreEO' f (E (HsLambda _ _ a)) = exploreEO f [E a]-exploreEO' f (E (HsList as)) = exploreExprs f as-exploreEO' f (E (HsListComp a _)) = exploreExprs f [a] --TODO-exploreEO' f (E (HsTuple as))  = exploreExprs f as-exploreEO' f (E (HsParen a)) = exploreExprs f [a]-exploreEO' f (E (HsIf a b c)) = exploreExprs f [a, b, c]-exploreEO' _ _ = False+rhssOf :: Binding -> Code -> [HsRhs]+rhssOf binding = concatMap rhsForBinding . declsOf binding -topExprs (HsUnGuardedRhs e) = [e]-topExprs (HsGuardedRhss rhss) = rhss >>= \(HsGuardedRhs _ es1 es2) -> [es1, es2]+expressionsOf :: Binding -> Code -> [EO]+expressionsOf binding code = do+  rhs <- rhssOf binding code+  top <- topExpressions rhs+  unfoldExpression top++parseDecls :: Code -> [HsDecl]+parseDecls code+  | ParseOk (HsModule _ _ _ _ decls) <- parseModule code = decls+  | otherwise = []++parseBindings :: Code -> [Binding]+parseBindings = map declName . parseDecls++expressionToBinding :: EO -> Maybe Binding+expressionToBinding (O (HsQVarOp q)) = qName q+expressionToBinding (E (HsVar    q)) = qName q+expressionToBinding _                = Nothing++-- private++topExpressions :: HsRhs -> [EO]+topExpressions (HsUnGuardedRhs e) = [E e]+topExpressions (HsGuardedRhss rhss) = rhss >>= \(HsGuardedRhs _ es1 es2) -> [E es1, E es2]++unfoldExpression :: EO -> [EO]+unfoldExpression expr = expr : concatMap unfoldExpression (subExpressions expr)++subExpressions :: EO -> [EO]+subExpressions (E (HsInfixApp a b c)) = [E a, O b, E c]+subExpressions (E (HsApp a b))        = [E a, E b]+subExpressions (E (HsNegApp a))       = [E a]+subExpressions (E (HsLambda _ _ a))   = [E a]+subExpressions (E (HsList as))        = map (E) as+subExpressions (E (HsListComp a _))   = [E a] --TODO+subExpressions (E (HsTuple as))       = map (E) as+subExpressions (E (HsParen a))        = [E a]+subExpressions (E (HsIf a b c))       = [E a, E b, E c]+subExpressions _ = []++isBinding :: Binding -> HsDecl -> Bool+isBinding binding = (==binding).declName++rhsForBinding :: HsDecl -> [HsRhs]+rhsForBinding (HsPatBind _ _ rhs localDecls) = concatRhs rhs localDecls+rhsForBinding (HsFunBind cases) = cases >>= \(HsMatch _ _ _ rhs localDecls) -> concatRhs rhs localDecls+rhsForBinding _ = []++concatRhs rhs l = [rhs] ++ concatMap rhsForBinding l+

@@ -1,34 +1,48 @@-module Language.Haskell.Inspector where+module Language.Haskell.Inspector (+  hasComposition,+  hasGuards,+  hasIf,+  hasConditional,+  hasLambda,+  hasDirectRecursion,+  hasUsage,+  hasComprehension,+  hasBinding,+  hasTypeDeclaration,+  hasTypeSignature,+  hasExpression,+  hasDecl,+  hasRhs,+  isParseable,+  Inspection,+  GlobalInspection+  ) where -import  Language.Haskell.Parser import  Language.Haskell.Syntax-import  Data.Maybe (fromMaybe, isJust)-import  Control.Monad (join)-import  Data.List (find)+import  Language.Haskell.Names (isName) import  Language.Haskell.Explorer -type Binding = String-type Code = String type Inspection = Binding -> Code  -> Bool+type GlobalInspection = Code  -> Bool  -- | Inspection that tells whether a binding uses the composition operator '.' -- in its definition hasComposition :: Inspection-hasComposition = isBindingEO f+hasComposition = hasExpression f   where f (O (HsQVarOp (UnQual (HsSymbol ".")))) = True         f _ = False  -- | Inspection that tells whether a binding uses guards -- in its definition hasGuards :: Inspection-hasGuards = isBindingRhs f+hasGuards = hasRhs f   where f (HsGuardedRhss _) = True         f _ = False  -- | Inspection that tells whether a binding uses ifs -- in its definition hasIf :: Inspection-hasIf = isBindingEO f+hasIf = hasExpression f   where f (E (HsIf _ _ _)) = True         f _ = False @@ -40,7 +54,7 @@ -- | Inspection that tells whether a binding uses a lambda expression -- in its definition hasLambda :: Inspection-hasLambda = isBindingEO f+hasLambda = hasExpression f   where f (E (HsLambda _ _ _)) = True         f _ = False @@ -52,80 +66,47 @@ -- | Inspection that tells whether a binding uses the the given target binding -- in its definition hasUsage :: String -> Inspection-hasUsage target = isBindingEO f-  where f (O (HsQVarOp name)) = isTarget name-        f (E (HsVar    name)) = isTarget name-        f _ = False--        isTarget (Qual  _ n) = isName target n-        isTarget (UnQual  n) = isName target n-        isTarget _           = False+hasUsage target = hasExpression f+  where f expr | (Just n) <- expressionToBinding expr = n == target+               | otherwise = False  -- | Inspection that tells whether a binding uses lists comprehensions -- in its definition hasComprehension :: Inspection-hasComprehension = isBindingEO f+hasComprehension = hasExpression f   where f (E (HsListComp _ _)) = True         f _ = False  -- | Inspection that tells whether a top level binding exists hasBinding :: Inspection-hasBinding binding = isJust . findBindingRhs binding+hasBinding binding = not.null.rhssOf binding  hasTypeDeclaration :: Inspection-hasTypeDeclaration binding = testWithCode (any f)+hasTypeDeclaration binding = hasDecl f   where f (HsTypeDecl _ hsName _ _) = isName binding hsName         f _                         = False  hasTypeSignature :: Inspection-hasTypeSignature binding = testWithCode (any f)+hasTypeSignature binding = hasDecl f   where f (HsTypeSig _ [hsName] _)  = isName binding hsName         f _                         = False -isParseable :: Code -> Bool-isParseable = testWithCode (const True)+hasExpression :: (EO -> Bool) -> Inspection+hasExpression f binding = has f (expressionsOf binding) -negateInspection :: Inspection -> Inspection-negateInspection f code = not . f code+hasRhs :: (HsRhs -> Bool)-> Inspection+hasRhs f binding = has f (rhssOf binding) --- ===================================================+isParseable :: GlobalInspection+isParseable = not.null.parseDecls -isName name hsName = nameOf hsName == name+hasDecl :: (HsDecl -> Bool) -> GlobalInspection+hasDecl f = has f parseDecls -nameOf (HsSymbol n) = n-nameOf (HsIdent  n) = n -bindingInMatch (HsMatch _ n _ _ _) = nameOf n+-- private -isBindingEO f = isBindingRhs isExpr-  where isExpr rhs = exploreExprs f $ topExprs rhs+has f g = any f . g -isBindingRhs f = testWithBindingRhs (any f) -testWithBindingRhs :: ([HsRhs] -> Bool) -> Binding -> Code -> Bool-testWithBindingRhs f binding  = orFalse . withBindingRhs f binding--withBindingRhs :: ([HsRhs] -> a) -> Binding -> Code -> Maybe a-withBindingRhs f binding = fmap f . findBindingRhs binding--findBindingRhs binding = fmap rhsForBinding . join . withCode (find isBinding)-  where isBinding (HsPatBind _ (HsPVar n)  _ _) = nameOf n == binding-        isBinding (HsFunBind cases)  = any ((== binding).bindingInMatch) cases-        isBinding _ = False--rhsForBinding :: HsDecl -> [HsRhs]-rhsForBinding (HsPatBind _ _ rhs localDecls) = concatRhs rhs localDecls-rhsForBinding (HsFunBind cases) = cases >>= \(HsMatch _ _ _ rhs localDecls) -> concatRhs rhs localDecls-rhsForBinding _ = []--concatRhs rhs l = [rhs] ++ concatMap rhsForBinding l--testWithCode f =  orFalse . withCode f--withCode :: ([HsDecl] -> a) -> Code -> Maybe a-withCode f code | ParseOk (HsModule _ _ _ _ decls) <- parseModule code = Just (f decls)-                | otherwise = Nothing--orFalse = fromMaybe False-orNil = fromMaybe [] 

@@ -0,0 +1,20 @@+module Language.Haskell.Inspector.Combiner (+  detect,+  negative,+  transitive) where++import Language.Haskell.Inspector+import Language.Haskell.Explorer+import Data.Maybe (maybeToList)++detect :: Inspection -> Code -> [Binding]+detect inspection code = filter (`inspection` code) $ parseBindings code++negative :: Inspection -> Inspection+negative f code = not . f code++transitive :: Inspection -> Inspection+transitive inspection binding code = inspection binding code || inUsage+  where inUsage = any (flip (transitive inspection) code) $ do+                      expr <- expressionsOf binding code+                      maybeToList . expressionToBinding $ expr

@@ -9,27 +9,27 @@ import Language.Haskell.Inspector  hasRedundantBooleanComparison :: Inspection-hasRedundantBooleanComparison = isBindingEO f+hasRedundantBooleanComparison = hasExpression f   where f (E (HsInfixApp x (HsQVarOp (UnQual (HsSymbol c))) y)) = any isBooleanLiteral [x, y] && isComp c         f _ = False          isComp c = c == "==" || c == "/="  hasRedundantIf :: Inspection-hasRedundantIf = isBindingEO f+hasRedundantIf = hasExpression f   where f (E (HsIf _ x y)) = all isBooleanLiteral [x, y]         f _            = False   hasRedundantGuards :: Inspection-hasRedundantGuards = isBindingRhs f -- TODO not true when condition is a pattern+hasRedundantGuards = hasRhs f -- TODO not true when condition is a pattern   where f (HsGuardedRhss [             HsGuardedRhs _ _ x,             HsGuardedRhs _ (HsVar (UnQual (HsIdent "otherwise"))) y]) = all isBooleanLiteral [x, y]         f _ = False  hasRedundantLambda :: Inspection-hasRedundantLambda = isBindingEO f+hasRedundantLambda = hasExpression f   where f (E (HsLambda _ [HsPVar (HsIdent x)] (HsApp _ (HsVar (UnQual (HsIdent y)))))) = x == y         f _ = False -- TODO consider parenthesis and symbols 

@@ -0,0 +1,27 @@+module Language.Haskell.Names (+  isName,+  name,+  qName,+  declName) where++import  Language.Haskell.Syntax++isName :: String -> HsName -> Bool+isName n hsName = name hsName == n++name :: HsName -> String+name (HsSymbol n) = n+name (HsIdent  n) = n++qName :: HsQName -> Maybe String+qName (Qual  _ hsName) = Just (name hsName)+qName (UnQual  hsName) = Just (name hsName)+qName _                = Nothing++declName :: HsDecl -> String+declName (HsTypeSig _ [b] _) = name b+declName (HsTypeDecl _ b _ _) = name b+declName (HsPatBind _ (HsPVar n) _ _) = name n+declName (HsFunBind cases)  | (HsMatch _ n _ _ _) <- head cases = name n+declName _                  = []+