clang-pure 0.2.0.0 → 0.2.0.1

raw patch · 6 files changed

+64/−33 lines, 6 filesdep ~microlensdep ~singletonsPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: microlens, singletons

API changes (from Hackage documentation)

Files

• app/FindClasses.hs +16/−10
• clang-pure.cabal +12/−6
• examples/ListTypes.hs +6/−7
• src/Language/C/Clang/Cursor/Typed.hs +30/−3
• src/Language/C/Clang/Internal/FFI.hsc +0/−3
• src/Language/C/Clang/Internal/Types.hs +0/−4

@@ -1,5 +1,6 @@ {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE RecordWildCards #-}  module Main where @@ -18,12 +19,17 @@ deriving instance Generic CursorKind instance Hashable CursorKind -classes :: [ ( String, Cursor -> Bool ) ]-classes =-  [ ( "HasType", isJust . cursorType )-  , ( "HasChildren", notNullOf cursorChildrenF )-  , ( "HasExtent", isJust . cursorExtent )-  , ( "HasSpelling", not . BS.null . cursorSpelling )+data HasClass = HasClass+  { combineResults :: Bool -> Bool -> Bool+  , predicate :: Cursor -> Bool+  }++classes :: HMS.HashMap String HasClass+classes = HMS.fromList+  [ ( "HasType",     HasClass (&&) (isJust . cursorType)            )+  , ( "HasChildren", HasClass (||) (notNullOf cursorChildrenF)      )+  , ( "HasExtent",   HasClass (&&) (isJust . cursorExtent)          )+  , ( "HasSpelling", HasClass (&&) (not . BS.null . cursorSpelling) )   ]  main :: IO ()@@ -40,10 +46,10 @@         let root = translationUnitCursor tu         return $ HMS.fromList           [ ( className, findClass predicate root )-          | ( className, predicate ) <- classes+          | ( className, predicate ) <- HMS.toList classes           ] -      let classResults = foldl1' (HMS.unionWith (HMS.unionWith (&&))) pathClassResults+      let classResults = foldl1' (HMS.unionWithKey $ \className -> HMS.unionWith (combineResults (classes HMS.! className))) pathClassResults        let allInstances =             intercalate "\n"@@ -55,7 +61,7 @@        putStrLn allInstances -findClass :: (Cursor -> Bool) -> Cursor -> HMS.HashMap CursorKind Bool-findClass predicate root = HMS.fromListWith (&&) kindResults+findClass :: HasClass -> Cursor -> HMS.HashMap CursorKind Bool+findClass HasClass {..} root = HMS.fromListWith combineResults kindResults   where     kindResults = root ^.. cosmosOf cursorChildrenF . to (\c -> ( cursorKind c, predicate c ) )

@@ -1,5 +1,5 @@ name:                  clang-pure-version:               0.2.0.0+version:               0.2.0.1 synopsis:              Pure C++ code analysis with libclang description:   Pure C++ code analysis with libclang.@@ -50,8 +50,8 @@                        vector >= 0.10.12,                        bytestring >= 0.10.6,                        stm >= 2.4.4,-                       singletons >= 2.2,-                       microlens >= 0.4.7.0,+                       singletons >= 2.0.1,+                       microlens >= 0.4.2.1,                        microlens-contra >= 0.1.0.1   hs-source-dirs:      src/   build-tools:         hsc2hs@@ -59,18 +59,24 @@   include-dirs:        cbits/   cc-options:          -Wall   extra-libraries:     clang-  ghc-options:         -Wall -O2 -fno-warn-redundant-constraints+  ghc-options:         -Wall -O2+  if impl(ghc >= 8.0.0)+    ghc-options: -fno-warn-redundant-constraints  executable find-classes   main-is:             FindClasses.hs   build-depends:       base, clang-pure, lens, unordered-containers, hashable, bytestring   hs-source-dirs:      app   buildable:           False-  ghc-options:         -Wall -O2 -fno-warn-redundant-constraints -fno-warn-orphans+  ghc-options:         -Wall -O2 -fno-warn-orphans+  if impl(ghc >= 8.0.0)+    ghc-options: -fno-warn-redundant-constraints  executable list-fun-types   main-is:             ListTypes.hs   build-depends:       base, clang-pure, lens, bytestring   hs-source-dirs:      examples   buildable:           False-  ghc-options:         -Wall -O2 -fno-warn-redundant-constraints+  ghc-options:         -Wall -O2+  if impl(ghc >= 8.0.0)+    ghc-options: -fno-warn-redundant-constraints

@@ -21,12 +21,11 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}  import           Language.C.Clang import qualified Language.C.Clang.Cursor as UT import           Language.C.Clang.Cursor.Typed-import           Data.Foldable-import           Data.Function import           Control.Lens import qualified Data.ByteString.Char8 as BS import           Data.Monoid@@ -40,10 +39,10 @@       idx <- createIndex       tu <- parseTranslationUnit idx path clangArgs       let funDecs =-            translationUnitCursor tu ^..-              cosmosOnOf cursorChildrenF UT.cursorChildrenF-              . folding (matchKind @'FunctionDecl)-              . to (\fd -> ( cursorSpelling fd, cursorType fd ) )-      for_ funDecs $ \( f, t ) -> putStrLn $ BS.unpack f ++ " :: " ++ BS.unpack (typeSpelling t)+              cosmosOnOf cursorChildrenF UT.cursorChildrenF         -- fold over cursors recursively+            . folding (matchKind @'FunctionDecl)                    -- find only FunctionDecls...+            . filtered (isFromMainFile . rangeStart . cursorExtent) -- ...that are actually in the given file+            . to (\funDec -> cursorSpelling funDec <> " :: " <> typeSpelling (cursorType funDec))+      BS.putStrLn $ BS.unlines (translationUnitCursor tu ^.. funDecs)      _ -> putStrLn "usage: list-fun-types path [clang opts]"

@@ -13,7 +13,8 @@ -} module Language.C.Clang.Cursor.Typed   ( Cursor-  , CursorK(..)+  , CursorK()+  , withoutKind   , matchKind    , translationUnitCursor@@ -46,9 +47,13 @@ import           Language.C.Clang.Type import           Language.C.Clang.TranslationUnit -import           Language.C.Clang.Internal.Types (CursorK(..))+import           Language.C.Clang.Internal.Refs (Clang) --- | Match a `Cursor` as a particular `CursorKind`. You can use the @TypeApplications@ extension to easily specify the CursorKind you want: @matchKind \@'StructDecl@.+-- | A `Cursor` with a statically known `CursorKind`.+newtype CursorK (kind :: CursorKind) = CursorK { withoutKind :: Cursor }+  deriving (Eq, Clang)++-- | Match a `Cursor` as a particular `CursorKind`. You can use the @TypeApplications@ extension to easily specify the `CursorKind` you want: @matchKind \@'StructDecl@. matchKind :: forall kind. SingI kind => Cursor -> Maybe (CursorK kind) matchKind c   | cursorKind c == fromSing (sing :: Sing kind) = Just (CursorK c)@@ -92,30 +97,52 @@ instance HasChildren 'CXXDeleteExpr instance HasChildren 'CXXDynamicCastExpr instance HasChildren 'CXXFunctionalCastExpr+instance HasChildren 'CXXMethod instance HasChildren 'CXXNewExpr instance HasChildren 'CXXReinterpretCastExpr instance HasChildren 'CXXStaticCastExpr instance HasChildren 'CXXTryStmt+instance HasChildren 'CallExpr instance HasChildren 'CaseStmt+instance HasChildren 'ClassDecl instance HasChildren 'ClassTemplate instance HasChildren 'ClassTemplatePartialSpecialization instance HasChildren 'CompoundAssignOperator+instance HasChildren 'CompoundStmt instance HasChildren 'ConditionalOperator+instance HasChildren 'Constructor+instance HasChildren 'ConversionFunction+instance HasChildren 'DeclRefExpr instance HasChildren 'DeclStmt instance HasChildren 'DefaultStmt+instance HasChildren 'Destructor instance HasChildren 'DoStmt+instance HasChildren 'EnumConstantDecl instance HasChildren 'EnumDecl+instance HasChildren 'FieldDecl+instance HasChildren 'FirstExpr instance HasChildren 'ForStmt+instance HasChildren 'FunctionDecl instance HasChildren 'FunctionTemplate instance HasChildren 'IfStmt instance HasChildren 'InitListExpr+instance HasChildren 'MemberRefExpr+instance HasChildren 'Namespace+instance HasChildren 'NonTypeTemplateParameter instance HasChildren 'ParenExpr+instance HasChildren 'ParmDecl+instance HasChildren 'ReturnStmt+instance HasChildren 'StructDecl instance HasChildren 'SwitchStmt+instance HasChildren 'TemplateTypeParameter instance HasChildren 'TranslationUnit+instance HasChildren 'TypedefDecl instance HasChildren 'UnaryOperator+instance HasChildren 'UnexposedDecl instance HasChildren 'UnionDecl instance HasChildren 'UsingDeclaration instance HasChildren 'UsingDirective+instance HasChildren 'VarDecl instance HasChildren 'WhileStmt  instance HasType 'ArraySubscriptExpr

@@ -15,7 +15,6 @@ -}  {-# OPTIONS_GHC -fno-warn-orphans -fno-warn-overlapping-patterns #-}-{-# LANGUAGE DataKinds #-}  module Language.C.Clang.Internal.FFI where @@ -234,8 +233,6 @@ instance Eq Cursor where   (==) = defaultEq $ \lp rp ->     [C.exp| int { clang_equalCursors(*$(CXCursor *lp), *$(CXCursor *rp)) } |]--deriving instance Eq (CursorK kind)  instance Eq SourceRange where   (==) = defaultEq $ \lp rp ->

@@ -48,10 +48,6 @@ newtype Cursor = Cursor (Leaf TranslationUnit CXCursor)   deriving (Child, Clang) --- | A `Cursor` with a statically known `CursorKind`.-newtype CursorK (kind :: CursorKind) = CursorK { withoutKind :: Cursor }-  deriving (Clang)- data CXSourceRange type instance RefOf SourceRange = CXSourceRange type instance ParentOf SourceRange = TranslationUnit