diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,20 @@ +Copyright (c) 2015 Franco Leonardo Bulgarelli + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/hs-inspector.cabal b/hs-inspector.cabal new file mode 100644 --- /dev/null +++ b/hs-inspector.cabal @@ -0,0 +1,43 @@ +-- Initial y.cabal generated by cabal init. For further documentation, see +-- http://haskell.org/cabal/users-guide/ + +name: hs-inspector +version: 0.1.0.0 +license: MIT +license-file: LICENSE +author: Franco Leonardo Bulgarelli +maintainer: flbulgarelli@frba.utn.edu.ar +category: Language +build-type: Simple +cabal-version: >=1.10 +description: Simple package for detecting usage of certain Haskell features on a module source code + +library + default-language: Haskell2010 + ghc-options: + -Wall + -fno-warn-missing-signatures + hs-source-dirs: + src + exposed-modules: + Language.Haskell.Inspector + Language.Haskell.Explorer + build-depends: + base >= 4 && < 5, + haskell-src >= 1 && < 1.1 + +test-suite spec + type: + exitcode-stdio-1.0 + ghc-options: + -Wall + -fno-warn-missing-signatures + hs-source-dirs: + spec + main-is: + Spec.hs + build-depends: + base >= 4 && < 5, + haskell-src >= 1 && < 1.1, + hspec >= 2 && < 3, + hs-inspector diff --git a/spec/Spec.hs b/spec/Spec.hs new file mode 100644 --- /dev/null +++ b/spec/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/src/Language/Haskell/Explorer.hs b/src/Language/Haskell/Explorer.hs new file mode 100644 --- /dev/null +++ b/src/Language/Haskell/Explorer.hs @@ -0,0 +1,24 @@ +module Language.Haskell.Explorer where + +import Language.Haskell.Syntax + +data EO = E HsExp | O HsQOp + +exploreExprs f exprs = exploreEO f $ map (E) exprs + +exploreEO f es = any f es || any (exploreEO' f) es + +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 + +topExprs (HsUnGuardedRhs e) = [e] +topExprs (HsGuardedRhss rhss) = rhss >>= \(HsGuardedRhs _ es1 es2) -> [es1, es2] diff --git a/src/Language/Haskell/Inspector.hs b/src/Language/Haskell/Inspector.hs new file mode 100644 --- /dev/null +++ b/src/Language/Haskell/Inspector.hs @@ -0,0 +1,68 @@ +module Language.Haskell.Inspector 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.Explorer + +type Binding = String +type Code = String +type Inspection = Binding -> Code -> Bool + +hasComposition :: Inspection +hasComposition = testAnyWithBindingExpr f + where f (O (HsQVarOp (UnQual (HsSymbol ".")))) = True + f _ = False + +hasGuards :: Inspection +hasGuards = testAnyWithBindingRhs f + where f (HsGuardedRhss _) = True + f _ = False + +hasLambda :: Inspection +hasLambda = testAnyWithBindingExpr f + where f (E (HsLambda _ _ _)) = True + f _ = False + +hasBinding :: Inspection +hasBinding binding = isJust . findBindingRhs binding + +isParseable :: Code -> Bool +isParseable = testWithCode (const True) + +testAnyWithBindingExpr f = testAnyWithBindingRhs testExprs + where testExprs rhs = exploreExprs f $ topExprs rhs + +testAnyWithBindingRhs 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 (HsIdent name)) _ _) = name == binding + isBinding (HsFunBind cases) = any isBindingInMatch cases + isBinding _ = False + + isBindingInMatch (HsMatch _ (HsIdent name) _ _ _ ) = name == binding + isBindingInMatch _ = 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 +