clang-pure 0.2.0.4 → 0.2.0.5

raw patch · 7 files changed

+102/−30 lines, 7 filessetup-changed

Files

• Setup.hs +1/−13
• clang-pure.cabal +1/−1
• src/Language/C/Clang.hs +2/−0
• src/Language/C/Clang/Internal/Context.hs +1/−0
• src/Language/C/Clang/Internal/FFI.hsc +67/−16
• src/Language/C/Clang/Internal/Types.hs +27/−0
• src/Language/C/Clang/TranslationUnit.hs +3/−0

@@ -103,18 +103,6 @@    let verbosity = fromFlagOrDefault normal (configVerbosity flags) -  let addCSources libBuildInfo =-        libBuildInfo-#if !(MIN_VERSION_GLASGOW_HASKELL(8, 2, 1, 0) && MIN_VERSION_inline_c(0, 6, 0))-          { cSources = -- define the generated c-sources here so that they don't get picked up by sdist-#if defined(mingw32_HOST_OS) && !(MIN_VERSION_GLASGOW_HASKELL(8, 0, 2, 0))-              ["srcLanguageCClangInternalFFI.c"] -- work around a bug in hsc2hs-#else-              ["src/Language/C/Clang/Internal/FFI.c"]-#endif-          }-#endif-   addDirs <- case mbError of     Right () -> return id     Left (_ :: SomeException) -> do@@ -131,7 +119,7 @@   let lbi = libBuildInfo lib   return localBuildInfo     { localPkgDescr = pd-      { library = Just lib { libBuildInfo = addDirs $ addCSources lbi }+      { library = Just lib { libBuildInfo = addDirs lbi }       }     } 

@@ -1,5 +1,5 @@ name:                  clang-pure-version:               0.2.0.4+version:               0.2.0.5 synopsis:              Pure C++ code analysis with libclang description:   Pure C++ code analysis with libclang.

@@ -18,7 +18,9 @@   module C,   -- * Index   ClangIndex(),+  ClangIndexOption(..),   createIndex,+  createIndexWithOptions,   -- * Utilities   Clang(),   ClangOrd(..)

@@ -36,6 +36,7 @@   , (C.TypeName "CXFile", [t| CXFile |])   , (C.TypeName "CXType", [t| CXType |])   , (C.TypeName "CXToken", [t| CXToken |])+  , (C.Struct "CXUnsavedFile", [t| CXUnsavedFile |])   ]  clangCtx :: C.Context

@@ -18,11 +18,12 @@  module Language.C.Clang.Internal.FFI where +import Data.Bits import Data.ByteString (ByteString) import qualified Data.ByteString as BS+import qualified Data.ByteString.Unsafe as BS import Control.Exception import Control.Monad-import Data.Foldable import Data.Functor.Contravariant import Data.IORef import qualified Data.Vector.Storable as VS@@ -48,8 +49,15 @@   clang_disposeIndex :: Ptr CXIndexImpl -> Finalizer  createIndex :: IO ClangIndex-createIndex = do-  idxp <- [C.exp| CXIndex { clang_createIndex(0, 1) } |]+createIndex = createIndexWithOptions [ DisplayDiagnostics ]++createIndexWithOptions :: [ ClangIndexOption ] -> IO ClangIndex+createIndexWithOptions opts = do+  let excludeDecl = fromBool $ ExcludeDeclarationsFromPCH `elem` opts+      displayDiag = fromBool $ DisplayDiagnostics `elem` opts+  idxp <- [C.exp| CXIndex {+    clang_createIndex($(int excludeDecl), $(int displayDiag))+    } |]   ClangIndex <$> newRoot idxp (clang_disposeIndex idxp)  foreign import ccall "clang_disposeTranslationUnit"@@ -74,27 +82,70 @@  instance Exception ClangError +withCXUnsavedFile :: UnsavedFile -> (CXUnsavedFile -> IO a) -> IO a+withCXUnsavedFile ( path, contents ) f =+  withCString path $ \cPath ->+    BS.unsafeUseAsCStringLen contents $ \( cContents, cLength ) ->+      f $ CXUnsavedFile cPath cContents (fromIntegral cLength)++instance Storable CXUnsavedFile where+  sizeOf _ = #size struct CXUnsavedFile++  alignment _ = #alignment struct CXUnsavedFile++  peek ptr = do+    cFileName <- (#peek struct CXUnsavedFile, Filename) ptr+    cContents <- (#peek struct CXUnsavedFile, Contents) ptr+    cLength <- (#peek struct CXUnsavedFile, Length) ptr+    return $ CXUnsavedFile cFileName cContents cLength++  poke ptr (CXUnsavedFile cFileName cContents cLength) = do+    (#poke struct CXUnsavedFile, Filename) ptr cFileName+    (#poke struct CXUnsavedFile, Contents) ptr cContents+    (#poke struct CXUnsavedFile, Length) ptr cLength++toTranslationUnitFlag :: TranslationUnitOption -> CUInt+toTranslationUnitFlag = \case+  DetailedPreprocessingRecord -> #{const CXTranslationUnit_DetailedPreprocessingRecord}+  Incomplete -> #{const CXTranslationUnit_Incomplete}+  PrecompiledPreamble -> #{const CXTranslationUnit_PrecompiledPreamble}+  CacheCompletionResults -> #{const CXTranslationUnit_CacheCompletionResults}+  ForSerialization -> #{const CXTranslationUnit_ForSerialization}+  CXXChainedPCH -> #{const CXTranslationUnit_CXXChainedPCH}+  SkipFunctionBodies -> #{const CXTranslationUnit_SkipFunctionBodies}+  IncludeBriefCommentsInCodeCompletion -> #{const CXTranslationUnit_IncludeBriefCommentsInCodeCompletion}+  CreatePreambleOnFirstParse -> #{const CXTranslationUnit_CreatePreambleOnFirstParse}+ parseTranslationUnit :: ClangIndex -> FilePath -> [ String ] -> IO TranslationUnit-parseTranslationUnit idx path args = do+parseTranslationUnit idx path args = parseTranslationUnitWithOptions idx path args [] []++parseTranslationUnitWithOptions+  :: ClangIndex+  -> FilePath+  -> [ String ]+  -> [ UnsavedFile ]+  -> [ TranslationUnitOption ]+  -> IO TranslationUnit+parseTranslationUnitWithOptions idx path args unsavedFiles opts = do   tun <- newNode idx $ \idxp ->-    withCString path $ \cPath -> do-      ( tup, cres ) <- bracket-        (traverse newCString args)-        (traverse_ free) $-        \cArgList -> do+    withCString path $ \cPath ->+      withMany withCString args $ \cArgList ->+        withMany withCXUnsavedFile unsavedFiles $ \cUnsavedFileList -> do           let cArgs = VS.fromList cArgList-          C.withPtr $ \tupp -> [C.exp| int {+              cUnsavedFiles = VS.fromList cUnsavedFileList+              cFlags = foldr (.|.) 0 (map toTranslationUnitFlag opts)+          ( tup, cres ) <- C.withPtr $ \tupp -> [C.exp| int {             clang_parseTranslationUnit2(               $(CXIndex idxp),-              $(char* cPath),+              $(const char *cPath),               $vec-ptr:(const char * const * cArgs), $vec-len:cArgs,-              NULL, 0,-              0,+              $vec-ptr:(struct CXUnsavedFile *cUnsavedFiles), $vec-len:cUnsavedFiles,+              $(unsigned int cFlags),               $(CXTranslationUnit *tupp))             } |]-      let res = parseClangError cres-      when (res /= Success) $ throwIO res-      return ( tup, clang_disposeTranslationUnit tup )+          let res = parseClangError cres+          when (res /= Success) $ throwIO res+          return ( tup, clang_disposeTranslationUnit tup )   return $ TranslationUnitRef tun  translationUnitCursor :: TranslationUnit -> Cursor

@@ -21,8 +21,10 @@  module Language.C.Clang.Internal.Types where +import Data.ByteString (ByteString) import Data.Singletons.TH import Foreign+import Foreign.C  import Language.C.Clang.Internal.Refs @@ -32,6 +34,11 @@ newtype ClangIndex = ClangIndex (Root CXIndexImpl)   deriving (Parent, Clang) +data ClangIndexOption+  = ExcludeDeclarationsFromPCH+  | DisplayDiagnostics+    deriving (Eq, Ord, Show)+ instance Eq ClangIndex where (==) = pointerEq  data CXTranslationUnitImpl@@ -40,6 +47,26 @@ type instance ParentOf TranslationUnit = ClangIndex newtype TranslationUnit = TranslationUnitRef (Node ClangIndex CXTranslationUnitImpl)   deriving (Parent, Child, Clang)++data CXUnsavedFile = CXUnsavedFile+  { cxUnsavedFileName :: CString+  , cxUnsavedFileContents :: CString+  , cxUnsavedFileLength :: CULong+  }++type UnsavedFile = ( FilePath, ByteString )++data TranslationUnitOption+  = DetailedPreprocessingRecord+  | Incomplete+  | PrecompiledPreamble+  | CacheCompletionResults+  | ForSerialization+  | CXXChainedPCH+  | SkipFunctionBodies+  | IncludeBriefCommentsInCodeCompletion+  | CreatePreambleOnFirstParse+    deriving (Eq, Ord, Show)  instance Eq TranslationUnit where (==) = pointerEq 

@@ -16,7 +16,10 @@  module Language.C.Clang.TranslationUnit   ( TranslationUnit()+  , TranslationUnitOption(..)+  , UnsavedFile   , parseTranslationUnit+  , parseTranslationUnitWithOptions   ) where