libclang-bindings 0.1.0.0 → 0.2.0.0

raw patch · 20 files changed

+599/−192 lines, 20 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +90/−9
• cbits/clang_wrappers_ffi.h +3/−3
• configure +9/−9
• configure.ac +1/−1
• libclang-bindings.cabal +3/−2
• src/Clang/CStandard.hs +0/−1
• src/Clang/HighLevel.hs +6/−0
• src/Clang/HighLevel/Diagnostics.hs +7/−3
• src/Clang/HighLevel/SourceLoc.hs +218/−115
• src/Clang/HighLevel/Tokens.hs +36/−23
• src/Clang/HighLevel/Types.hs +13/−6
• src/Clang/LowLevel/Core.hs +27/−0
• src/Clang/LowLevel/Core/Enums.hs +18/−0
• src/Clang/LowLevel/Core/Instances.hsc +5/−0
• src/Clang/LowLevel/FFI.hs +7/−4
• src/Clang/Paths.hs +46/−12
• test/Test/Test/Tokens.hs +93/−0
• test/Test/Util/Clang.hs +14/−3
• test/Test/Version.hs +1/−1
• test/test-clang-bindings.hs +2/−0

@@ -1,5 +1,86 @@ # Revision history for libclang-bindings +## ?.?.?.? -- YYYY-mm-dd++### Breaking changes++### New features++### Minor changes++### Bug fixes++## 0.2.0.0 -- 2026-10-06++### Breaking changes++* Add `CXType_PredefinedSugar` to `CXTypeKind`. LLVM/Clang 23 reports this kind+  for the predefined types `__size_t`, `__signed_size_t` and `__ptrdiff_t`;+  see [predefined-sugar-unexposed (llvm/llvm-project#202209)][llvm-202209].+* `SingleLoc`, `MultiLoc`, and `Token` are parameterized by path type+  (`SingleLoc path`, `MultiLoc path`, `Token path a`).+* High-level location functions such as `clang_getCursorLocation` return+  `RealPath` locations. They throw `ClangRealPathException` if the expansion+  location is in a virtual file, where 0.1.0.0 returned a location, and set a+  spelling or file location in a virtual file to `Nothing`. Use+  `toMultiSourcePath`/`toRangeSourcePath` for virtual files. See+  [location-wrappers-throw (#84)][issue-84].+* `RealPath` locations compare canonical paths: `Eq`, `Ord`,+  `compareSingleLoc` and `rangeContainsLoc` treat a file reached under two+  spellings as one file. See+  [binding-specs-path-spelling (well-typed/hs-bindgen#2236)][hs-bindgen-2236].+* Diagnostics use `SourcePath` locations: `Diagnostic`, `FixIt`,+  `clang_getDiagnosticLocation`, `clang_getDiagnosticRange` and+  `clang_getDiagnosticFixIt` do not throw for virtual files.+* `toMulti`/`toRange` renamed to `toMultiRealPath`/`toRangeRealPath`;+  new `toMultiSourcePath`/`toRangeSourcePath` for virtual files.+* `prettySingleLoc`, `prettyMultiLoc`, `prettyRangeSingleLoc` and+  `prettyRangeMultiLoc` take a `path -> String` argument. `SingleLoc`,+  `MultiLoc` and their ranges have `Show` instances only for `RealPath` and+  `SourcePath`.+* `clang_tokenize` takes a `CXSourceRange` instead of a `Range SingleLoc`, and+  returns `[Token SourcePath TokenSpelling]`. It passes the range to `libclang`+  unchanged, so a range that starts inside a macro expansion is tokenized from+  the macro definition; see the documentation of `clang_tokenize`.+* Remove `fromSingle` and `fromRange`. They looked up the `CXFile` by path,+  which fails for locations in buffers without one. Use `clang_getLocation`+  and `clang_getRange` from `Clang.LowLevel.Core` instead.+* Remove `nullSourcePath`. Use `Data.Text.null . getSourcePathText` instead.++### New features++* Bind `clang_File_tryGetRealPathName` and `clang_File_isEqual`.+* Add the `RealPath` newtype with `getRealPath`, `getRealPathText` and+  `realPathToSourcePath`. Add `getSourcePathText`.+* Add `clang_getRealPath`, which throws `ClangRealPathException` for a virtual+  file, and `clang_tryGetRealPath`, which returns `Nothing` for one.+* Add `toMultiCXFile`: builds `MultiLoc CXFile`.+* `SingleLoc` and `MultiLoc` derive `Functor`, `Foldable` and `Traversable`.+* Bind `clang_hashCursor`. See [hash-cursor (PR #81)][pr-81].++### Minor changes++* `Clang.HighLevel.Types` re-exports `RealPath` and `SourcePath`.++### Bug fixes++* `MultiLoc` no longer drops a presumed, spelling or file location that differs+  from the expansion location in only some of file, line and column. It used+  to drop, for example, the spelling location of a macro defined in the same+  file, and every presumed location set by a `#line` directive. See+  [macro-spelling-dropped (#85)][issue-85].+* `clang_tokenize` no longer throws for a range in a buffer without a file on+  disk, such as the predefines buffer holding macros defined with `-D`. See+  [header-redefines-D-macro (well-typed/hs-bindgen#2280)][hs-bindgen-2280].+* `clang_tokenize` returns `[]` for a range without tokens instead of failing.++[pr-81]: https://github.com/well-typed/libclang-bindings/pull/81+[issue-84]: https://github.com/well-typed/libclang-bindings/issues/84+[issue-85]: https://github.com/well-typed/libclang-bindings/issues/85+[llvm-202209]: https://github.com/llvm/llvm-project/pull/202209+[hs-bindgen-2236]: https://github.com/well-typed/hs-bindgen/issues/2236+[hs-bindgen-2280]: https://github.com/well-typed/hs-bindgen/issues/2280+ ## 0.1.0.0 -- 2026-07-14  ### Breaking changes@@ -10,15 +91,15 @@ ### New features  * Add a binding for `clang_isBeforeInTranslationUnit`. This function is only-  available for Clang versions 20.1 and newer; see [PR-53][pr-53].+  available for Clang versions 20.1 and newer; see [PR #53][pr-53]. * Add a binding for the `clang_Type_getOffsetOf` function. See [PR #37][pr-37]. * Add a new `clang_disposeToken` function to free a single `CXToken`. This is a   helper function alongside the existing `clang_disposeTokens` functions, which-  frees arrays of `CXToken`s. See [PR#42][pr-42].-* Add a new `foldTry` function that behaves like `foldWitHandler`, but it+  frees arrays of `CXToken`s. See [PR #42][pr-42].+* Add a new `foldTry` function that behaves like `foldWithHandler`, but it   returns the caught exception as a value like `Control.Exception.try` would.   The caught exception is represented using a new type called `FoldException`.-  See [PR #47][pr-47]+  See [PR #47][pr-47]. * Add a compile-time check of the `CLANG_VERSION` macro. See the   `Clang.Version.checkUserClangVersion` documentation for details. * Add `--with-so` option to the `configure` script, used to work around Cabal@@ -35,11 +116,11 @@   warnings for libclang APIs we actually call remain visible. See   [issue #58][issue-58]. -[pr-37]: https://github.com/well-typed/libclang/pull/37-[pr-42]: https://github.com/well-typed/libclang/pull/42-[pr-47]: https://github.com/well-typed/libclang/pull/47-[pr-53]: https://github.com/well-typed/libclang/pull/53-[issue-58]: https://github.com/well-typed/libclang/issues/58+[pr-37]: https://github.com/well-typed/libclang-bindings/pull/37+[pr-42]: https://github.com/well-typed/libclang-bindings/pull/42+[pr-47]: https://github.com/well-typed/libclang-bindings/pull/47+[pr-53]: https://github.com/well-typed/libclang-bindings/pull/53+[issue-58]: https://github.com/well-typed/libclang-bindings/issues/58  ## 0.1.0-alpha -- 2026-02-06 

@@ -74,9 +74,9 @@  /* OMITTED: int      clang_getFileUniqueID (CXFile file, CXFileUniqueID * outID); */ -/* OMITTED: int      clang_File_isEqual (CXFile file1, CXFile file2); */--/* OMITTED: CXString clang_File_tryGetRealPathName (CXFile file); */+static inline void wrap_File_tryGetRealPathName(CXFile file, CXString * result) {+  *result = clang_File_tryGetRealPathName(file);+}  /* *** Physical source locations *** */ 

@@ -1,6 +1,6 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles.-# Generated by GNU Autoconf 2.73 for libclang-bindings 0.1.0.0.+# Generated by GNU Autoconf 2.73 for libclang-bindings 0.2.0.0. # # # Copyright (C) 1992-1996, 1998-2017, 2020-2026 Free Software Foundation,@@ -584,8 +584,8 @@ # Identity of this package. PACKAGE_NAME='libclang-bindings' PACKAGE_TARNAME='libclang-bindings'-PACKAGE_VERSION='0.1.0.0'-PACKAGE_STRING='libclang-bindings 0.1.0.0'+PACKAGE_VERSION='0.2.0.0'+PACKAGE_STRING='libclang-bindings 0.2.0.0' PACKAGE_BUGREPORT='' PACKAGE_URL='' @@ -1241,7 +1241,7 @@   # Omit some internal or obsolete options to make the list less imposing.   # This message is too long to be a string in the A/UX 3.1 sh.   cat <<_ACEOF-'configure' configures libclang-bindings 0.1.0.0 to adapt to many kinds of systems.+'configure' configures libclang-bindings 0.2.0.0 to adapt to many kinds of systems.  Usage: $0 [OPTION]... [VAR=VALUE]... @@ -1304,7 +1304,7 @@  if test -n "$ac_init_help"; then   case $ac_init_help in-     short | recursive ) echo "Configuration of libclang-bindings 0.1.0.0:";;+     short | recursive ) echo "Configuration of libclang-bindings 0.2.0.0:";;    esac   cat <<\_ACEOF @@ -1392,7 +1392,7 @@ test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then   cat <<\_ACEOF-libclang-bindings configure 0.1.0.0+libclang-bindings configure 0.2.0.0 generated by GNU Autoconf 2.73  Copyright (C) 2026 Free Software Foundation, Inc.@@ -1616,7 +1616,7 @@ This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. -It was created by libclang-bindings $as_me 0.1.0.0, which was+It was created by libclang-bindings $as_me 0.2.0.0, which was generated by GNU Autoconf 2.73.  Invocation command line was    $ $0$ac_configure_args_raw@@ -4502,7 +4502,7 @@ # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log="-This file was extended by libclang-bindings $as_me 0.1.0.0, which was+This file was extended by libclang-bindings $as_me 0.2.0.0, which was generated by GNU Autoconf 2.73.  Invocation command line was    CONFIG_FILES    = $CONFIG_FILES@@ -4566,7 +4566,7 @@ cat >>"$CONFIG_STATUS" <<_ACEOF || ac_write_fail=1 ac_cs_config='$ac_cs_config_escaped' ac_cs_version="\\-libclang-bindings config.status 0.1.0.0+libclang-bindings config.status 0.2.0.0 configured by $0, generated by GNU Autoconf 2.73,   with options \\"\$ac_cs_config\\" 

@@ -1,5 +1,5 @@ AC_PREREQ([2.71])-AC_INIT([libclang-bindings],[0.1.0.0])+AC_INIT([libclang-bindings],[0.2.0.0])  dnl --with-compiler argument: This argument is passed by Cabal, so we have to dnl handle it.  We do not use it, so we ignore the passed value.

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               libclang-bindings-version:            0.1.0.0+version:            0.2.0.0 license:            BSD-3-Clause license-file:       LICENSE author:             Well-Typed LLP@@ -46,7 +46,7 @@   type:     git   location: https://github.com/well-typed/libclang-bindings   subdir:   libclang-bindings-  tag:      release-0.1.0.0+  tag:      release-0.2.0.0  -------------------------------------------------------------------------------- -- Configuration@@ -180,6 +180,7 @@     Test.Discover     Test.Meta.IsConcrete     Test.Test.Exceptions+    Test.Test.Tokens     Test.Util.AST     Test.Util.Clang     Test.Util.FoldException

@@ -20,7 +20,6 @@ import Clang.HighLevel.Types import Clang.Internal.Results import Clang.LowLevel.Core-import Clang.Paths  {-------------------------------------------------------------------------------   C standard

@@ -23,12 +23,18 @@   , prettyMultiLoc   , prettyRangeSingleLoc   , prettyRangeMultiLoc+    -- ** Conversion (CXFile)+  , toMultiCXFile     -- ** Convenience wrappers     -- *** for @CXSourceLocation@   , clang_getDiagnosticLocation   , clang_getCursorLocation   , clang_getCursorLocation'   , clang_getTokenLocation+    -- *** for @CXFile@+  , ClangRealPathException(..)+  , clang_getRealPath+  , clang_tryGetRealPath     -- *** for @CXSourceRange@   , clang_getDiagnosticRange   , clang_getDiagnosticFixIt

@@ -16,6 +16,7 @@ import Clang.HighLevel.SourceLoc (MultiLoc, Range) import Clang.HighLevel.SourceLoc qualified as SourceLoc import Clang.LowLevel.Core+import Clang.Paths (SourcePath)  {-------------------------------------------------------------------------------   Definition@@ -29,7 +30,10 @@     , diagnosticSeverity :: SimpleEnum CXDiagnosticSeverity        -- | Source location (where Clang would print the caret @^@)-    , diagnosticLocation  :: MultiLoc+      --+      -- Uses 'SourcePath' rather than 'RealPath' because diagnostics may+      -- refer to root headers whose real path is not available.+    , diagnosticLocation  :: MultiLoc SourcePath        -- | Text of the diagnostic     , diagnosticSpelling  :: Text@@ -51,7 +55,7 @@       -- A diagnostic's source ranges highlight important elements in the source       -- code. On the command line, Clang displays source ranges by underlining       -- them with @~@ characters.-    , diagnosticRanges :: [Range MultiLoc]+    , diagnosticRanges :: [Range (MultiLoc SourcePath)]        -- | Fix-it hints     , diagnosticFixIts :: [FixIt]@@ -78,7 +82,7 @@       -- replaced with the returned replacement string. Note that source ranges       -- are half-open ranges [a, b), so the source code should be replaced from       -- a and up to (but not including) b.-      fixItRange :: Range MultiLoc+      fixItRange :: Range (MultiLoc SourcePath)        -- | Text that should replace the source code     , fixItReplacement :: Text

@@ -7,11 +7,14 @@     -- * Comparisons   , compareSingleLoc   , rangeContainsLoc-    -- * Conversion-  , toMulti-  , toRange-  , fromSingle-  , fromRange+    -- * Conversion (CXFile)+  , toMultiCXFile+    -- * Conversion (RealPath)+  , toMultiRealPath+  , toRangeRealPath+    -- * Conversion (SourcePath)+  , toMultiSourcePath+  , toRangeSourcePath     -- * Get single location   , clang_getExpansionLocation   , clang_getPresumedLocation@@ -26,6 +29,10 @@   , prettyMultiLoc   , prettyRangeSingleLoc   , prettyRangeMultiLoc+    -- * File to RealPath+  , ClangRealPathException(..)+  , clang_getRealPath+  , clang_tryGetRealPath     -- * Convenience wrappers     -- * for @CXSourceLocation@   , clang_getDiagnosticLocation@@ -40,31 +47,33 @@   , clang_getTokenExtent   ) where +import Control.Exception (Exception, throwIO) import Control.Monad import Control.Monad.IO.Class import Data.List (intercalate) import Data.Text (Text)+import Data.Text qualified as Text import Foreign.C import GHC.Generics (Generic) import GHC.Stack  import Clang.LowLevel.Core qualified as Core+import Clang.LowLevel.Core.Pointers (CXFile) import Clang.Paths  {-------------------------------------------------------------------------------   Definition -------------------------------------------------------------------------------} --- | A /single/ location in a file+-- | A single location in a file ----- See 'MultiLoc' for additional discussion.-data SingleLoc = SingleLoc {-      singleLocPath   :: !SourcePath+data SingleLoc path = SingleLoc {+      singleLocPath   :: !path     , singleLocLine   :: !Int     , singleLocColumn :: !Int     , singleLocOffset :: !Int     }-  deriving stock (Eq, Ord, Generic)+  deriving stock (Eq, Ord, Generic, Functor, Foldable, Traversable)  -- | Presumed location --@@ -95,19 +104,23 @@ -- which is the position at the caret, and a \"spelling location\", which -- corresponds to the location of the @int@ token in the macro definition. --+-- The presumed, spelling and file locations are 'Nothing' when they coincide+-- with the expansion location, that is, when they agree with it on file, line+-- and column.+-- -- References: -- -- * <https://clang.llvm.org/doxygen/classclang_1_1SourceLocation.html> -- * <https://clang.llvm.org/doxygen/classclang_1_1SourceManager.html> --   (@getExpansionLoc@, @getSpellingLoc@, @getDecomposedSpellingLoc@)-data MultiLoc = MultiLoc {+data MultiLoc path = MultiLoc {       -- | Expansion location       --       -- If the location refers into a macro expansion, this corresponds to the       -- location of the macro expansion.       --       -- See <https://clang.llvm.org/doxygen/group__CINDEX__LOCATIONS.html#gadee4bea0fa34550663e869f48550eb1f>-      multiLocExpansion :: !SingleLoc+      multiLocExpansion :: !(SingleLoc path)        -- | Presumed location       --@@ -126,7 +139,7 @@       -- See <https://github.com/llvm/llvm-project/pull/72400>.       --       -- See <https://clang.llvm.org/doxygen/group__CINDEX__LOCATIONS.html#ga01f1a342f7807ea742aedd2c61c46fa0>-    , multiLocSpelling :: !(Maybe SingleLoc)+    , multiLocSpelling :: !(Maybe (SingleLoc path))        -- | File location       --@@ -136,9 +149,9 @@       -- location of the use of the argument.       --       -- See <https://clang.llvm.org/doxygen/group__CINDEX__LOCATIONS.html#gae0ee9ff0ea04f2446832fc12a7fd2ac8>-    , multiLocFile :: !(Maybe SingleLoc)+    , multiLocFile :: !(Maybe (SingleLoc path))     }-  deriving stock (Eq, Ord, Generic)+  deriving stock (Eq, Ord, Generic, Functor, Foldable, Traversable)  -- | Range --@@ -159,7 +172,7 @@ -- | Compare locations -- -- Returns 'Nothing' if the locations aren't in the same file.-compareSingleLoc :: SingleLoc -> SingleLoc -> Maybe Ordering+compareSingleLoc :: Eq path => SingleLoc path -> SingleLoc path -> Maybe Ordering compareSingleLoc a b = do     guard $ singleLocPath a == singleLocPath b     return $@@ -173,7 +186,7 @@ -- upper bound (following 'Core.CXSourceRange'). -- -- Returns 'Nothing' if the three locations are not all in the same file.-rangeContainsLoc :: Range SingleLoc -> SingleLoc -> Maybe Bool+rangeContainsLoc :: Eq path => Range (SingleLoc path) -> SingleLoc path -> Maybe Bool rangeContainsLoc Range{rangeStart, rangeEnd} loc = do     afterStart <- (/= LT) <$> compareSingleLoc loc rangeStart     beforeEnd  <- (== LT) <$> compareSingleLoc loc rangeEnd@@ -186,11 +199,16 @@   instances which we do not (yet?) define. -------------------------------------------------------------------------------} -instance Show SingleLoc         where show = show . prettySingleLoc ShowFile-instance Show MultiLoc          where show = show . prettyMultiLoc  ShowFile-instance Show (Range SingleLoc) where show = show . prettyRangeSingleLoc-instance Show (Range MultiLoc)  where show = show . prettyRangeMultiLoc+instance Show (SingleLoc RealPath)         where show = show . prettySingleLoc getRealPath ShowFile+instance Show (MultiLoc RealPath)          where show = show . prettyMultiLoc  getRealPath ShowFile+instance Show (Range (SingleLoc RealPath)) where show = show . prettyRangeSingleLoc getRealPath+instance Show (Range (MultiLoc RealPath))  where show = show . prettyRangeMultiLoc  getRealPath +instance Show (SingleLoc SourcePath)         where show = show . prettySingleLoc getSourcePath ShowFile+instance Show (MultiLoc SourcePath)          where show = show . prettyMultiLoc  getSourcePath ShowFile+instance Show (Range (SingleLoc SourcePath)) where show = show . prettyRangeSingleLoc getSourcePath+instance Show (Range (MultiLoc SourcePath))  where show = show . prettyRangeMultiLoc  getSourcePath+ deriving stock instance {-# OVERLAPPABLE #-} Show a => Show (Range a)  {-------------------------------------------------------------------------------@@ -202,22 +220,22 @@  data ShowFile = ShowFile | HideFile -prettySingleLoc :: ShowFile -> SingleLoc -> String-prettySingleLoc showFile loc = case showFile of+prettySingleLoc :: (path -> String) -> ShowFile -> SingleLoc path -> String+prettySingleLoc getPath showFile loc = case showFile of     -- Use space instead of first colon to avoid GHC literate preprocessor mangling-    ShowFile -> getSourcePath singleLocPath ++ " "+    ShowFile -> getPath singleLocPath ++ " "                   ++ show singleLocLine ++ ":" ++ show singleLocColumn     HideFile -> show singleLocLine ++ ":" ++ show singleLocColumn   where     SingleLoc{singleLocPath, singleLocLine, singleLocColumn} = loc -prettyMultiLoc :: ShowFile -> MultiLoc -> String-prettyMultiLoc showFile multiLoc =+prettyMultiLoc :: forall path. (path -> String) -> ShowFile -> MultiLoc path -> String+prettyMultiLoc getPath showFile multiLoc =     intercalate " " . concat $ [-        [ prettySingleLoc showFile multiLocExpansion ]-      , [ "<Presumed=" ++ presumed loc ++ ">" | Just loc <- [multiLocPresumed] ]-      , [ "<Spelling=" ++ single   loc ++ ">" | Just loc <- [multiLocSpelling] ]-      , [ "<File="     ++ single   loc ++ ">" | Just loc <- [multiLocFile]     ]+        [ prettySingleLoc getPath showFile multiLocExpansion ]+      , [ "<Presumed=" ++ presumed loc       ++ ">" | Just loc <- [multiLocPresumed] ]+      , [ "<Spelling=" ++ single getPath loc ++ ">" | Just loc <- [multiLocSpelling] ]+      , [ "<File="     ++ single getPath loc ++ ">" | Just loc <- [multiLocFile]     ]       ]   where     MultiLoc{@@ -226,35 +244,38 @@       , multiLocSpelling       , multiLocFile} = multiLoc -    presumed :: PresumedLoc -> [Char]-    presumed loc = single $ SingleLoc{+    expansionFilePath :: FilePath+    expansionFilePath = getPath (singleLocPath multiLocExpansion)++    presumed :: PresumedLoc -> String+    presumed loc = single getSourcePath SingleLoc{           singleLocPath   = presumedLocPath   loc         , singleLocLine   = presumedLocLine   loc         , singleLocColumn = presumedLocColumn loc         , singleLocOffset = 0 -- not used for pretty-printing         } -    single :: SingleLoc -> [Char]-    single loc =-        prettySingleLoc-          (if singleLocPath loc == singleLocPath multiLocExpansion-             then HideFile-             else ShowFile)+    single :: (p -> String) -> SingleLoc p -> String+    single get loc =+        prettySingleLoc get+          (if get (singleLocPath loc) == expansionFilePath+             then HideFile else ShowFile)           loc -prettyRangeSingleLoc :: Range SingleLoc -> String-prettyRangeSingleLoc = prettySourceRangeWith+prettyRangeSingleLoc :: Eq path => (path -> String) -> Range (SingleLoc path) -> String+prettyRangeSingleLoc getPath = prettySourceRangeWith       singleLocPath-      prettySingleLoc+      (prettySingleLoc getPath) -prettyRangeMultiLoc :: Range MultiLoc -> String-prettyRangeMultiLoc =+prettyRangeMultiLoc :: Eq path => (path -> String) -> Range (MultiLoc path) -> String+prettyRangeMultiLoc getPath =     prettySourceRangeWith       (singleLocPath . multiLocExpansion)-      prettyMultiLoc+      (prettyMultiLoc getPath)  prettySourceRangeWith ::-     (a -> SourcePath)+     Eq p+  => (a -> p)   -> (ShowFile -> a -> String)   -> Range a -> String prettySourceRangeWith path pretty Range{rangeStart, rangeEnd} = concat [@@ -271,100 +292,147 @@   Conversion -------------------------------------------------------------------------------} -toMulti :: MonadIO m => Core.CXSourceLocation -> m MultiLoc-toMulti location = do-    expansion <- clang_getExpansionLocation location+-- | Build a 'MultiLoc' holding raw 'CXFile' handles.+--+toMultiCXFile :: MonadIO m => Core.CXSourceLocation -> m (MultiLoc CXFile)+toMultiCXFile location = do+    expansion <- toSingleCXFile =<< Core.clang_getExpansionLocation location+    presumed  <- clang_getPresumedLocation location+    spelling  <- toSingleCXFile =<< Core.clang_getSpellingLocation location+    file      <- toSingleCXFile =<< Core.clang_getFileLocation location -    let differentSingle :: SingleLoc -> Maybe SingleLoc-        differentSingle loc = do-            guard $ singleLocPath   loc /= singleLocPath expansion-            guard $ singleLocLine   loc /= singleLocLine expansion-            guard $ singleLocColumn loc /= singleLocColumn expansion-            -- We don't compare the file offset-            return loc+    expansionName <- Core.clang_getFileName (singleLocPath expansion) -        differentPresumed :: PresumedLoc -> Maybe PresumedLoc+    let differentSingle loc = do+            sameFile <-+              Core.clang_File_isEqual (singleLocPath loc) (singleLocPath expansion)++            return $ do+              guard $+                   not sameFile+                || singleLocLine   loc /= singleLocLine   expansion+                || singleLocColumn loc /= singleLocColumn expansion+              pure loc+         differentPresumed loc = do-            guard $ presumedLocPath   loc /= singleLocPath expansion-            guard $ presumedLocLine   loc /= singleLocLine expansion-            guard $ presumedLocColumn loc /= singleLocColumn expansion+            guard $+                 getSourcePathText (presumedLocPath loc) /= expansionName+              || presumedLocLine   loc /= singleLocLine   expansion+              || presumedLocColumn loc /= singleLocColumn expansion             return loc -    MultiLoc expansion-      <$> (differentPresumed <$> clang_getPresumedLocation location)-      <*> (differentSingle   <$> clang_getSpellingLocation location)-      <*> (differentSingle   <$> clang_getFileLocation     location)+    spelling' <- differentSingle spelling+    file'     <- differentSingle file +    return MultiLoc{+        multiLocExpansion = expansion+      , multiLocPresumed  = differentPresumed presumed+      , multiLocSpelling  = spelling'+      , multiLocFile      = file'+      }+  where+    toSingleCXFile (f, line, column, offset) = return SingleLoc{+        singleLocPath   = f+      , singleLocLine   = fromIntegral line+      , singleLocColumn = fromIntegral column+      , singleLocOffset = fromIntegral offset+      } -toRange :: MonadIO m => Core.CXSourceRange -> m (Range MultiLoc)-toRange = toRangeWith toMulti+-- | Convert to 'MultiLoc RealPath'+--+-- The expansion location must be in a file on disk: it is resolved with+-- 'clang_getRealPath', which throws 'ClangRealPathException' otherwise (for+-- example, for a built-in macro definition or a directive in an unsaved file).+--+-- The spelling and file locations can be virtual even when the expansion+-- location is not, so they are resolved with 'clang_tryGetRealPath' and set to+-- 'Nothing' on failure. For example, any header that includes @stdio.h@ also+-- pulls in this field from glibc:+--+-- > // bits/types/__mbstate_t.h+-- > __WINT_TYPE__ __wch;+--+-- Since @clang@ predefines @\_\_WINT_TYPE\_\_@, the expansion location of the+-- field is in the glibc header, but its spelling location is in @clang@'s+-- @\<built-in\>@ buffer, whose 'CXFile' is @NULL@.+--+-- Consequently, 'Nothing' in 'multiLocSpelling' or 'multiLocFile' may also mean+-- that the location has no real path.+toMultiRealPath :: (MonadIO m, HasCallStack) => Core.CXSourceLocation -> m (MultiLoc RealPath)+toMultiRealPath location = do+    multi     <- toMultiCXFile location+    expansion <- traverse clang_getRealPath (multiLocExpansion multi)+    spelling  <- trySingleRealPath (multiLocSpelling multi)+    file      <- trySingleRealPath (multiLocFile multi)+    return MultiLoc{+        multiLocExpansion = expansion+      , multiLocPresumed  = multiLocPresumed multi+      , multiLocSpelling  = spelling+      , multiLocFile      = file+      }+  where+    trySingleRealPath :: MonadIO m => Maybe (SingleLoc CXFile) -> m (Maybe (SingleLoc RealPath))+    trySingleRealPath = \case+      Nothing  -> return Nothing+      Just loc -> fmap (\rp -> loc{ singleLocPath = rp }) <$>+                    clang_tryGetRealPath (singleLocPath loc) -fromSingle ::-     (MonadIO m, HasCallStack)-  => Core.CXTranslationUnit -> SingleLoc -> m Core.CXSourceLocation-fromSingle unit SingleLoc{singleLocPath, singleLocLine, singleLocColumn} = do-     let SourcePath path = singleLocPath-     file <- Core.clang_getFile unit path-     Core.clang_getLocation-       unit-       file-       (fromIntegral singleLocLine)-       (fromIntegral singleLocColumn)+toMultiSourcePath :: MonadIO m => Core.CXSourceLocation -> m (MultiLoc SourcePath)+toMultiSourcePath location =+    traverse (fmap SourcePath . Core.clang_getFileName) =<< toMultiCXFile location -fromRange ::-     (MonadIO m, HasCallStack)-  => Core.CXTranslationUnit -> Range SingleLoc -> m Core.CXSourceRange-fromRange unit Range{rangeStart, rangeEnd} = do-    rangeStart' <- fromSingle unit rangeStart-    rangeEnd'   <- fromSingle unit rangeEnd-    Core.clang_getRange rangeStart' rangeEnd'+toRangeRealPath :: (MonadIO m, HasCallStack) => Core.CXSourceRange -> m (Range (MultiLoc RealPath))+toRangeRealPath = toRangeWith toMultiRealPath +toRangeSourcePath :: MonadIO m => Core.CXSourceRange -> m (Range (MultiLoc SourcePath))+toRangeSourcePath = toRangeWith toMultiSourcePath+ {-------------------------------------------------------------------------------   Get single location -------------------------------------------------------------------------------} -clang_getExpansionLocation :: MonadIO m => Core.CXSourceLocation -> m SingleLoc+clang_getExpansionLocation :: (MonadIO m, HasCallStack) => Core.CXSourceLocation -> m (SingleLoc RealPath) clang_getExpansionLocation location =-    toSingle =<< Core.clang_getExpansionLocation location+    toSingleRealPath =<< Core.clang_getExpansionLocation location  clang_getPresumedLocation :: MonadIO m => Core.CXSourceLocation -> m PresumedLoc clang_getPresumedLocation location =     toPresumed <$> Core.clang_getPresumedLocation location -clang_getSpellingLocation :: MonadIO m => Core.CXSourceLocation -> m SingleLoc+clang_getSpellingLocation :: (MonadIO m, HasCallStack) => Core.CXSourceLocation -> m (SingleLoc RealPath) clang_getSpellingLocation location =-    toSingle =<< Core.clang_getSpellingLocation location+    toSingleRealPath =<< Core.clang_getSpellingLocation location -clang_getFileLocation :: MonadIO m => Core.CXSourceLocation -> m SingleLoc+clang_getFileLocation :: (MonadIO m, HasCallStack) => Core.CXSourceLocation -> m (SingleLoc RealPath) clang_getFileLocation location =-    toSingle =<< Core.clang_getFileLocation location+    toSingleRealPath =<< Core.clang_getFileLocation location  {-------------------------------------------------------------------------------   Convenience wrappers for @CXSourceLocation@ -------------------------------------------------------------------------------}  -- | Retrieve the source location of the given diagnostic.-clang_getDiagnosticLocation :: MonadIO m => Core.CXDiagnostic -> m MultiLoc+clang_getDiagnosticLocation :: MonadIO m => Core.CXDiagnostic -> m (MultiLoc SourcePath) clang_getDiagnosticLocation diagnostic =-    toMulti =<< Core.clang_getDiagnosticLocation diagnostic+    toMultiSourcePath =<< Core.clang_getDiagnosticLocation diagnostic --- | Retrieve the physical location of the source constructor referenced by the+-- | Retrieve the physical location of the source construct referenced by the -- given cursor.-clang_getCursorLocation :: MonadIO m => Core.CXCursor -> m MultiLoc+clang_getCursorLocation :: (MonadIO m, HasCallStack) => Core.CXCursor -> m (MultiLoc RealPath) clang_getCursorLocation cursor =-    toMulti =<< Core.clang_getCursorLocation cursor+    toMultiRealPath =<< Core.clang_getCursorLocation cursor  -- | Like 'clang_getCursorLocation', but only retrieve the expansion location-clang_getCursorLocation' :: MonadIO m => Core.CXCursor -> m SingleLoc+clang_getCursorLocation' :: (MonadIO m, HasCallStack) => Core.CXCursor -> m (SingleLoc RealPath) clang_getCursorLocation' cursor =     clang_getExpansionLocation =<< Core.clang_getCursorLocation cursor  -- | Retrieve the source location of the given token. clang_getTokenLocation ::-     MonadIO m-  => Core.CXTranslationUnit -> Core.CXToken -> m MultiLoc+     (MonadIO m, HasCallStack)+  => Core.CXTranslationUnit -> Core.CXToken -> m (MultiLoc RealPath) clang_getTokenLocation unit token =-    toMulti =<< Core.clang_getTokenLocation unit token+    toMultiRealPath =<< Core.clang_getTokenLocation unit token  {-------------------------------------------------------------------------------   Convenience wrappers for @CXSourceRange@@@ -373,57 +441,92 @@ -- | Retrieve a source range associated with the diagnostic. clang_getDiagnosticRange ::      MonadIO m-  => Core.CXDiagnostic -> CUInt -> m (Range MultiLoc)+  => Core.CXDiagnostic -> CUInt -> m (Range (MultiLoc SourcePath)) clang_getDiagnosticRange diagnostic range =-    toRange =<< Core.clang_getDiagnosticRange diagnostic range+    toRangeSourcePath =<< Core.clang_getDiagnosticRange diagnostic range  -- | Retrieve the replacement information for a given fix-it. clang_getDiagnosticFixIt ::      MonadIO m   => Core.CXDiagnostic   -> CUInt-  -> m (Range MultiLoc, Text)+  -> m (Range (MultiLoc SourcePath), Text) clang_getDiagnosticFixIt diagnostic fixit = do     (range, replacement) <- Core.clang_getDiagnosticFixIt diagnostic fixit-    (, replacement) <$> toRange range+    (, replacement) <$> toRangeSourcePath range  -- | Retrieve a range for a piece that forms the cursors spelling name. clang_Cursor_getSpellingNameRange ::-     MonadIO m+     (MonadIO m, HasCallStack)   => Core.CXCursor   -> CUInt   -> CUInt-  -> m (Maybe (Range MultiLoc))+  -> m (Maybe (Range (MultiLoc RealPath))) clang_Cursor_getSpellingNameRange cursor pieceIndex options = do     mRange <- Core.clang_Cursor_getSpellingNameRange cursor pieceIndex options     case mRange of       Nothing    -> return Nothing-      Just range -> Just <$> toRangeWith toMulti range+      Just range -> Just <$> toRangeWith toMultiRealPath range  -- | Retrieve the physical extent of the source construct referenced by the -- given cursor.-clang_getCursorExtent :: MonadIO m => Core.CXCursor -> m (Range MultiLoc)+clang_getCursorExtent :: (MonadIO m, HasCallStack) => Core.CXCursor -> m (Range (MultiLoc RealPath)) clang_getCursorExtent cursor =-    toRange =<< Core.clang_getCursorExtent cursor+    toRangeRealPath =<< Core.clang_getCursorExtent cursor  -- | Retrieve a source range that covers the given token. clang_getTokenExtent ::-     MonadIO m+     (MonadIO m, HasCallStack)   => Core.CXTranslationUnit   -> Core.CXToken-  -> m (Range MultiLoc)+  -> m (Range (MultiLoc RealPath)) clang_getTokenExtent unit token =-    toRange =<< Core.clang_getTokenExtent unit token+    toRangeRealPath =<< Core.clang_getTokenExtent unit token  {-------------------------------------------------------------------------------+  Exceptions+-------------------------------------------------------------------------------}++-- | Thrown by 'clang_getRealPath' when the file has no backing file on disk+data ClangRealPathException =+    ClangRealPathException SourcePath CallStack+  deriving stock (Show)+  deriving anyclass (Exception)++{-------------------------------------------------------------------------------   Auxiliary -------------------------------------------------------------------------------} -toSingle :: MonadIO m => (Core.CXFile, CUInt, CUInt, CUInt) -> m SingleLoc-toSingle (file, line, column, offset) = do-    path <- Core.clang_getFileName file+-- | Get the 'RealPath' for a 'Core.CXFile'+--+-- Precondition: the file must be on disk. Throws 'ClangRealPathException'+-- for virtual files.+clang_getRealPath :: (MonadIO m, HasCallStack) => Core.CXFile -> m RealPath+clang_getRealPath file = do+    path <- Core.clang_File_tryGetRealPathName file+    if Text.null path+      then do+        name <- SourcePath <$> Core.clang_getFileName file+        liftIO . throwIO $ ClangRealPathException name callStack+      else return (RealPath path)++-- | Try to get the 'RealPath' for a 'Core.CXFile'+--+-- Returns 'Nothing' for virtual/in-memory files.+clang_tryGetRealPath :: MonadIO m => Core.CXFile -> m (Maybe RealPath)+clang_tryGetRealPath file = do+    path <- Core.clang_File_tryGetRealPathName file+    return $ if Text.null path then Nothing else Just (RealPath path)++-- | Build a @SingleLoc RealPath@. Throws 'ClangRealPathException' for virtual+-- files.+toSingleRealPath ::+     (MonadIO m, HasCallStack)+  => (Core.CXFile, CUInt, CUInt, CUInt) -> m (SingleLoc RealPath)+toSingleRealPath (file, line, column, offset) = do+    realPath <- clang_getRealPath file     return SingleLoc{-        singleLocPath   = SourcePath   path+        singleLocPath   = realPath       , singleLocLine   = fromIntegral line       , singleLocColumn = fromIntegral column       , singleLocOffset = fromIntegral offset@@ -431,7 +534,7 @@  toPresumed :: (Text, CUInt, CUInt) -> PresumedLoc toPresumed (path, line, column) = PresumedLoc{-      presumedLocPath   = SourcePath   path+      presumedLocPath   = SourcePath path     , presumedLocLine   = fromIntegral line     , presumedLocColumn = fromIntegral column     }

@@ -9,26 +9,28 @@ import Control.Monad.IO.Class import Data.Text (Text) import GHC.Generics (Generic)-import GHC.Stack  import Clang.Enum.Simple-import Clang.HighLevel.SourceLoc (MultiLoc, Range, SingleLoc)+import Clang.HighLevel.SourceLoc (MultiLoc, Range) import Clang.HighLevel.SourceLoc qualified as SourceLoc import Clang.LowLevel.Core hiding (clang_tokenize) import Clang.LowLevel.Core qualified as Core+import Clang.Paths (SourcePath)  {-------------------------------------------------------------------------------   Definition -------------------------------------------------------------------------------} -data Token a = Token {+data Token path a = Token {       tokenKind       :: !(SimpleEnum CXTokenKind)     , tokenSpelling   :: !a-    , tokenExtent     :: !(Range MultiLoc)+    , tokenExtent     :: !(Range (MultiLoc path))     , tokenCursorKind :: !(SimpleEnum CXCursorKind)     }-  deriving stock (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)+  deriving stock (Eq, Ord, Functor, Foldable, Traversable, Generic) +deriving stock instance (Show a, Show (Range (MultiLoc path))) => Show (Token path a)+ newtype TokenSpelling = TokenSpelling {       getTokenSpelling :: Text     }@@ -39,32 +41,43 @@ -------------------------------------------------------------------------------}  -- | Get all tokens in the specified range+--+-- @libclang@ lexes the source text between the spelling locations of the start+-- and end of the range.+--+-- Consequently, a range that starts inside a macro expansion starts in the+-- macro definition. For example, given+--+-- > #define T int+-- > T x;+--+-- the extent of @x@ starts at the @int@ produced by expanding @T@, and yields+-- the tokens @int T x@: the text from the @int@ in the definition to @x@. clang_tokenize ::-     (MonadIO m, HasCallStack)+     MonadIO m   => CXTranslationUnit-  -> Range SingleLoc-     -- ^ Range-     ---     -- We use 'Range' 'SingleLoc' here instead of 'CXSourceRange' in order to-     -- avoid ambiguity; see 'Clang.HighLevel.SourceLoc.MultiLoc' for discussion.-  -> m [Token TokenSpelling]-clang_tokenize unit range = liftIO $ do-    range' <- SourceLoc.fromRange unit range-    bracket-        (Core.clang_tokenize unit range')-        (uncurry $ Core.clang_disposeTokens unit) $ \(tokens, numTokens) -> do-      cursors <- clang_annotateTokens unit tokens numTokens-      forM [0 .. pred numTokens] $ \i -> do-        cursor <- index_CXCursorArray cursors i-        toToken unit (index_CXTokenArray tokens i) cursor+  -> CXSourceRange+  -> m [Token SourcePath TokenSpelling]+clang_tokenize unit range =+    liftIO $+      bracket+          (Core.clang_tokenize unit range)+          (uncurry $ Core.clang_disposeTokens unit) $ \(tokens, numTokens) -> do+        if numTokens == 0+          then return []+          else do+            cursors <- clang_annotateTokens unit tokens numTokens+            forM [0 .. pred numTokens] $ \i -> do+              cursor <- index_CXCursorArray cursors i+              toToken unit (index_CXTokenArray tokens i) cursor  toToken ::      MonadIO m-  => CXTranslationUnit -> CXToken -> CXCursor -> m (Token TokenSpelling)+  => CXTranslationUnit -> CXToken -> CXCursor -> m (Token SourcePath TokenSpelling) toToken unit token cursor = do     tokenKind       <- clang_getTokenKind token     tokenSpelling   <- TokenSpelling <$> clang_getTokenSpelling unit token-    tokenExtent     <- SourceLoc.clang_getTokenExtent unit token+    tokenExtent     <- SourceLoc.toRangeSourcePath =<< Core.clang_getTokenExtent unit token     tokenCursorKind <- clang_getCursorKind cursor     return Token{         tokenKind

@@ -3,18 +3,24 @@ -- Intended for unqualified import; see "Clang.HighLevel" for more detailed -- discussion. module Clang.HighLevel.Types (+    -- * Paths+    RealPath(..)+  , SourcePath(..)     -- * Source locations-    SingleLoc(..)+  , SingleLoc(..)   , MultiLoc(..)   , Range(..)     -- ** Comparisons   , compareSingleLoc   , rangeContainsLoc-    -- ** Conversion-  , toMulti-  , toRange-  , fromSingle-  , fromRange+    -- ** Conversion (CXFile)+  , toMultiCXFile+    -- ** Conversion (RealPath)+  , toMultiRealPath+  , toRangeRealPath+    -- ** Conversion (SourcePath)+  , toMultiSourcePath+  , toRangeSourcePath     -- * Tokens   , Token(..)   , TokenSpelling(..)@@ -55,3 +61,4 @@ import Clang.HighLevel.Fold import Clang.HighLevel.SourceLoc import Clang.HighLevel.Tokens+import Clang.Paths

@@ -99,6 +99,7 @@   , CXAvailabilityKind(..)   , clang_getTranslationUnitCursor   , clang_equalCursors+  , clang_hashCursor   , clang_getCursorSemanticParent   , clang_getCursorLexicalParent   , clang_getCursorTLSKind@@ -216,6 +217,8 @@   , clang_Location_isFromMainFile     -- * File manipulation routines   , clang_getFileName+  , clang_File_isEqual+  , clang_File_tryGetRealPathName     -- * Debugging   , clang_breakpoint     -- * Exceptions@@ -697,6 +700,13 @@     onHaskellHeap b $ \b' ->       cToBool <$> wrap_equalCursors a' b' +-- | Compute a hash value for the given cursor.+--+-- <https://clang.llvm.org/doxygen/group__CINDEX__CURSOR__MANIP.html#gabf27e0eaee38ae9e7453f55754d4929b>+clang_hashCursor :: MonadIO m => CXCursor -> m CUInt+clang_hashCursor cursor = liftIO $+    onHaskellHeap cursor wrap_hashCursor+ -- | Determine the semantic parent of the given cursor. -- -- The semantic parent of a cursor is the cursor that semantically contains the@@ -2000,6 +2010,23 @@ -- <https://clang.llvm.org/doxygen/group__CINDEX__FILES.html#ga626ff6335ab1e0a2b8c8823301225690> clang_getFileName :: MonadIO m => CXFile -> m Text clang_getFileName file = liftIO $ preallocate_$ wrap_getFileName file++-- | Check whether two files refer to the same underlying file.+--+-- <https://clang.llvm.org/doxygen/group__CINDEX__FILES.html#ga2efb64a9f8b36bdca41e24ced5fc6a69>+clang_File_isEqual :: MonadIO m => CXFile -> CXFile -> m Bool+clang_File_isEqual f1 f2 = liftIO $+    cToBool <$> nowrapper_File_isEqual f1 f2++-- | Get the real, canonical path name of the given file.+--+-- Returns the empty string for virtual files (files that are not saved to+-- disk, such as unsaved files passed to @clang_parseTranslationUnit@).+--+-- <https://clang.llvm.org/doxygen/group__CINDEX__FILES.html#ga2becf44b7e67e25038e6e4fdb3e22a96>+clang_File_tryGetRealPathName :: MonadIO m => CXFile -> m Text+clang_File_tryGetRealPathName file =+    liftIO $ preallocate_$ wrap_File_tryGetRealPathName file  -- | Retrieve the contents of the given file that is loaded in the given -- translation unit.

@@ -183,6 +183,12 @@ -- We don't need them, and by omitting them we are compatible with a larger -- range of @libclang@ versions. --+-- NOTE: 'CXType_PredefinedSugar' only exists in @libclang@ 23 and later. We+-- include it anyway, because @libclang@ 23 reports it for types as common as+-- the argument of @malloc@. Older versions never report it, and the+-- 'Clang.Enum.Simple.IsSimpleEnum' instance does not rely on the header+-- declaring it.+-- -- NOTE: We omit @CXType_FirstBuiltin@ and @CXType_LastBuiltin@, which are -- aliases for the first and last builtin type in the list, respectively. If -- we need them, we should define them as separate constants.@@ -269,6 +275,18 @@    | CXType_ExtVector   | CXType_Atomic++    -- | Sugar for the predefined types @__size_t@, @__signed_size_t@ and+    -- @__ptrdiff_t@ (LLVM/Clang 23 and later).+    --+    -- Clang uses these for the type of @sizeof@ and of pointer subtraction,+    -- and in the signatures of library builtins such as @malloc@ and+    -- @strlen@. LLVM/Clang 22 reports the same types as 'CXType_Unexposed';+    -- earlier versions report the underlying integer type directly. That+    -- integer type is the canonical type.+    --+    -- See <https://github.com/llvm/llvm-project/pull/202209>.+  | CXType_PredefinedSugar   deriving stock (Show, Eq, Ord, Enum, Bounded, Generic)  {-------------------------------------------------------------------------------

@@ -149,6 +149,10 @@   simpleToC CXType_Attributed          = #const CXType_Attributed   simpleToC CXType_ExtVector           = #const CXType_ExtVector   simpleToC CXType_Atomic              = #const CXType_Atomic+  -- Headers before LLVM/Clang 23 do not declare CXType_PredefinedSugar, so we+  -- cannot take its value from the header. The value is fixed by the+  -- libclang ABI, and older versions never report it.+  simpleToC CXType_PredefinedSugar     = 182    simpleFromC (#const CXType_Invalid)             = Just CXType_Invalid   simpleFromC (#const CXType_Unexposed)           = Just CXType_Unexposed@@ -216,6 +220,7 @@   simpleFromC (#const CXType_Attributed)          = Just CXType_Attributed   simpleFromC (#const CXType_ExtVector)           = Just CXType_ExtVector   simpleFromC (#const CXType_Atomic)              = Just CXType_Atomic+  simpleFromC 182                                 = Just CXType_PredefinedSugar    simpleFromC _otherwise = Nothing 

@@ -4,14 +4,15 @@  #include "clang_config.h" +import Foreign.C.Types+import Foreign.Ptr+ import Clang.Enum.Simple import Clang.Internal.ByValue import Clang.Internal.ConstPtr import Clang.LowLevel.Core.Enums import Clang.LowLevel.Core.Pointers import Clang.LowLevel.Core.Structs-import Foreign.C.Types-import Foreign.Ptr  -- *** Top-level *** @@ -124,9 +125,11 @@  -- OMITTED: int      clang_getFileUniqueID (CXFile file, CXFileUniqueID * outID); --- OMITTED: int      clang_File_isEqual (CXFile file1, CXFile file2);+foreign import capi unsafe "clang_wrappers.h clang_File_isEqual"+  nowrapper_File_isEqual :: CXFile -> CXFile -> IO CInt --- OMITTED: CXString clang_File_tryGetRealPathName (CXFile file);+foreign import capi unsafe "clang_wrappers.h"+  wrap_File_tryGetRealPathName :: CXFile -> W CXString_ -> IO ()  -- *** Physical source locations *** 

@@ -2,8 +2,14 @@     -- * Source paths     SourcePath(..)   , getSourcePath-  , nullSourcePath+  , getSourcePathText +    -- * Real paths+  , RealPath(..)+  , getRealPath+  , getRealPathText+  , realPathToSourcePath+     -- * C include directories   , CIncludeDir(..)   ) where@@ -16,24 +22,52 @@   Source paths -------------------------------------------------------------------------------} --- | Filesystem path of a source file, typically a C header------ The 'Text' type is used because Clang uses UTF-8 internally for everything,--- including paths.+-- | Path of a source file as reported by @clang_getFileName@ ----- The format of the path is platform-dependent.  For example, different--- directory separators are used on different platforms.+-- For on-disk files this is typically the path used in the @#include@+-- directive. For virtual files (unsaved buffers, @#line@ directives)+-- it is the clang-assigned name. Platform-dependent format. newtype SourcePath = SourcePath Text-  -- 'Show' instance valid due to 'IsString' instance   deriving newtype (Eq, IsString, Ord, Show)  -- | Get the 'FilePath' representation of a 'SourcePath' getSourcePath :: SourcePath -> FilePath-getSourcePath (SourcePath path) = Text.unpack path+getSourcePath = Text.unpack . getSourcePathText --- | Determine if a 'SourcePath' is empty-nullSourcePath :: SourcePath -> Bool-nullSourcePath (SourcePath path) = Text.null path+-- | Get the 'Text' representation of a 'SourcePath'+getSourcePathText :: SourcePath -> Text+getSourcePathText (SourcePath path) = path++{-------------------------------------------------------------------------------+  Real paths+-------------------------------------------------------------------------------}++-- | Canonical absolute path of an on-disk file+--+-- Obtained via @clang_File_tryGetRealPathName@. Two 'RealPath' values+-- for the same physical file compare equal regardless of include spelling.+-- Platform-dependent format.+--+-- Virtual files (unsaved buffers, the @\<built-in\>@ buffer) have no real path,+-- so functions that must return a 'RealPath' for one throw+-- 'Clang.HighLevel.ClangRealPathException'. That includes the location+-- functions in "Clang.HighLevel". For virtual files, use+-- 'Clang.HighLevel.clang_tryGetRealPath' or a 'SourcePath' conversion such as+-- 'Clang.HighLevel.Types.toMultiSourcePath'.+newtype RealPath = RealPath Text+  deriving stock (Eq, Ord, Show)++-- | Get the 'FilePath' representation of a 'RealPath'+getRealPath :: RealPath -> FilePath+getRealPath = Text.unpack . getRealPathText++-- | Get the 'Text' representation of a 'RealPath'+getRealPathText :: RealPath -> Text+getRealPathText (RealPath path) = path++-- | Embed a 'RealPath' as a 'SourcePath'+realPathToSourcePath :: RealPath -> SourcePath+realPathToSourcePath (RealPath t) = SourcePath t  {-------------------------------------------------------------------------------   C include directories

@@ -0,0 +1,93 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Test tokenization of cursor extents+module Test.Test.Tokens (tests) where++import Data.Default (def)+import Data.Text (Text)+import Test.Tasty+import Test.Tasty.HUnit+import Test.Util.Clang qualified as Clang+import Test.Util.Input (TestInput)+import Test.Util.Input qualified as Input++import Clang.Args+import Clang.Enum.Bitfield+import Clang.Enum.Simple+import Clang.HighLevel qualified as HighLevel+import Clang.HighLevel.Types+import Clang.LowLevel.Core++{-------------------------------------------------------------------------------+  List of tests+-------------------------------------------------------------------------------}++tests :: TestTree+tests = testGroup "Test.Test.Tokens" [+      testCase "macroDefinition"        tokenize_macroDefinition+    , testCase "commandLineMacro"       tokenize_commandLineMacro+    , testCase "declStartsInExpansion"  tokenize_declStartsInExpansion+    ]++{-------------------------------------------------------------------------------+  Tests+-------------------------------------------------------------------------------}++tokenize_macroDefinition :: Assertion+tokenize_macroDefinition = do+    tokens <- tokenizeCursor def input CXCursor_MacroDefinition "FOO"+    assertEqual "" ["FOO", "(", "x", ")", "x", "+", "1"] tokens+  where+    input :: TestInput+    input = "#define FOO(x) x + 1\n"++-- | A @-D@ macro lives in Clang's predefines buffer, which has no 'CXFile'+tokenize_commandLineMacro :: Assertion+tokenize_commandLineMacro = do+    tokens <- tokenizeCursor args "" CXCursor_MacroDefinition "FOO"+    assertEqual "" ["FOO", "(", "x", ")", "x", "+", "1"] tokens+  where+    args :: ClangArgs+    args = ClangArgs ["-DFOO(x)=x + 1"]++-- | The range is tokenized as is, from the spelling location of its start+tokenize_declStartsInExpansion :: Assertion+tokenize_declStartsInExpansion = do+    tokens <- tokenizeCursor def input CXCursor_VarDecl "x"+    assertEqual "" ["int", "T", "x"] tokens+  where+    input :: TestInput+    input = Input.unlines [+        "#define T int"+      , "T x;"+      ]++{-------------------------------------------------------------------------------+  Auxiliary+-------------------------------------------------------------------------------}++-- | Tokenize the extent of the top-level cursor with the given kind and name+tokenizeCursor ::+     ClangArgs+  -> TestInput+  -> CXCursorKind+  -> Text+  -> IO [Text]+tokenizeCursor args input kind name =+    Clang.withInputUsing args flags input $ \unit -> do+      root    <- clang_getTranslationUnitCursor unit+      extents <- HighLevel.clang_visitChildren root $ simpleFold $ \curr -> do+        currKind <- fromSimpleEnum <$> clang_getCursorKind curr+        currName <- clang_getCursorSpelling curr+        if currKind == Right kind && currName == name+          then foldContinueWith =<< clang_getCursorExtent curr+          else foldContinue+      case extents of+        [extent] ->+          map (getTokenSpelling . tokenSpelling)+            <$> HighLevel.clang_tokenize unit extent+        _otherwise ->+          assertFailure $ "expected one cursor, found " ++ show (length extents)+  where+    flags :: BitfieldEnum CXTranslationUnit_Flags+    flags = bitfieldEnum [CXTranslationUnit_DetailedPreprocessingRecord]

@@ -6,6 +6,7 @@ module Test.Util.Clang (     -- * Top-level call into clang     withInput+  , withInputUsing   , parseUsing   ) where @@ -13,6 +14,8 @@ import Data.Default import Test.Util.Input (TestInput (..)) +import Clang.Args+import Clang.Enum.Bitfield import Clang.Enum.Simple import Clang.HighLevel qualified as HighLevel import Clang.HighLevel.Types@@ -23,15 +26,23 @@ -------------------------------------------------------------------------------}  withInput :: TestInput -> (CXTranslationUnit -> IO a) -> IO a-withInput (TestInput input) onSuccess =+withInput = withInputUsing def mempty++withInputUsing ::+     ClangArgs+  -> BitfieldEnum CXTranslationUnit_Flags+  -> TestInput+  -> (CXTranslationUnit -> IO a)+  -> IO a+withInputUsing args flags (TestInput input) onSuccess =     HighLevel.withUnsavedFile "test.h" input $ \file ->     HighLevel.withIndex DisplayDiagnostics   $ \ix   ->     HighLevel.withTranslationUnit2       ix       (Just "test.h")-      def+      args       [file]-      mempty+      flags       onFailure       onSuccess   where

@@ -78,7 +78,7 @@       version `elem` historicReleases        -- For the current versions we don't know which minor/patch to expect-    , major `elem` [21, 22]+    , major `elem` [21, 22, 23]     ]  -- | Historic @llvm@ releases

@@ -4,6 +4,7 @@ import Test.Meta.IsConcrete qualified as IsConcrete import Test.Tasty import Test.Test.Exceptions qualified as Exceptions+import Test.Test.Tokens qualified as Tokens import Test.Version qualified as Version  {-------------------------------------------------------------------------------@@ -19,5 +20,6 @@         ]     , testGroup "Tests" [           Exceptions.tests+        , Tokens.tests         ]     ]