diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,12 @@ +# High-level bindings for tree-sitter + +This package implements high-level bindings for [tree-sitter](https://tree-sitter.github.io/tree-sitter/), +a widely-supported parser generator tool and an incremental parsing library. + +This package is an alternative to the official [tree-sitter](https://hackage.haskell.org/package/tree-sitter) package, +which only binds a subset of the features offered by tree-sitter parsers. + +This package is compiled against [tree-sitter](https://github.com/tree-sitter/tree-sitter) version [0.24.3](https://github.com/tree-sitter/tree-sitter/releases/tag/v0.24.3) (2024-10-09). +It is feature complete for version 14 of the tree-sitter ABI and is backwards compatible down to version 13. + +All tree-sitter versions up to version [0.25.8](https://github.com/tree-sitter/tree-sitter/releases/tag/v0.25.8) (2025-07-13) are backwards compatible down to version 13, so this package should work with all grammars generated by any version of tree-sitter after [0.19.0](https://github.com/tree-sitter/tree-sitter/releases/tag/v0.19.0) (2021-03-01), though this is untested. diff --git a/hs-tree-sitter.cabal b/hs-tree-sitter.cabal new file mode 100644 --- /dev/null +++ b/hs-tree-sitter.cabal @@ -0,0 +1,56 @@ +cabal-version: 3.4 +name: hs-tree-sitter +version: 13.0.14.0 +license: AGPL-3.0-only +synopsis: High-level bindings for tree-sitter +description: High-level bindings for tree-sitter. +author: Wen Kokke +maintainer: wenkokke@users.noreply.github.com +category: Language +build-type: Simple +extra-doc-files: README.md +tested-with: + GHC ==8.10.7 + || ==9.0.2 + || ==9.2.8 + || ==9.4.8 + || ==9.6.7 + || ==9.8.4 + || ==9.10.2 + || ==9.12.2 + +common language + ghc-options: + -Wall -Wcompat -Widentities -Wprepositive-qualified-module + -Wredundant-constraints -Wunticked-promoted-constructors + -Wunused-packages + + default-language: Haskell2010 + default-extensions: ImportQualifiedPost + + if impl(ghc <9.6.1) + ghc-options: + -optc=-Wno-discarded-qualifiers + -optc=-Wno-incompatible-pointer-types-discards-qualifiers + +library + import: language + exposed-modules: TreeSitter + hs-source-dirs: src + build-depends: hs-tree-sitter:internal + default-extensions: NoImplicitPrelude + +library internal + import: language + visibility: private + hs-source-dirs: src-internal + ghc-options: -Wno-name-shadowing + exposed-modules: + TreeSitter.Internal + TreeSitter.Internal.ST + + build-depends: + , base >=4.13 && <5 + , base-compat-constptr >=0.1 && <0.2 + , bytestring >=0.11 && <0.13 + , hs-tree-sitter-capi >=13.0 && <13.1 diff --git a/src-internal/TreeSitter/Internal.hs b/src-internal/TreeSitter/Internal.hs new file mode 100644 --- /dev/null +++ b/src-internal/TreeSitter/Internal.hs @@ -0,0 +1,1710 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ViewPatterns #-} +{-# OPTIONS_GHC -Wno-unused-top-binds #-} + +module TreeSitter.Internal ( + -- * ABI Versioning + C.TREE_SITTER_LANGUAGE_VERSION, + C.TREE_SITTER_MIN_COMPATIBLE_LANGUAGE_VERSION, + + -- * Types + Symbol (..), + StateId (..), + GrammarType (..), + FieldId (..), + FieldName (..), + CaptureName (..), + CaptureIndex (..), + PatternIndex (..), + Language, + Parser, + Tree, + Query, + QueryCursor, + LookaheadIterator, + InputEncoding (InputEncodingUTF8, InputEncodingUTF16), + SymbolType (SymbolTypeRegular, SymbolTypeAnonymous, SymbolTypeSupertype, SymbolTypeAuxiliary), + Point (Point, pointColumn, pointRow), + Range (Range, rangeStartPoint, rangeEndPoint, rangeStartByte, rangeEndByte), + Input, + LogType (LogTypeLex, LogTypeParse), + InputEdit (InputEdit, inputEditStartByte, inputEditOldEndByte, inputEditNewEndByte, inputEditStartPoint, inputEditOldEndPoint, inputEditNewEndPoint), + Node, + NodeId (..), + nodeId, + TreeCursor, + TreeCursorId (..), + QueryCapture, + Quantifier, + QueryMatch, + QueryPredicateStepType, + QueryPredicateStep, + QueryErrorType (QueryErrorTypeSyntax, QueryErrorTypeNodeType, QueryErrorTypeField, QueryErrorTypeCapture, QueryErrorTypeStructure, QueryErrorTypeLanguage), + QueryError (..), + + -- * Parser + parserNew, + unsafeParserDelete, + withParser, + parserSetLanguage, + parserLanguage, + parserSetIncludedRanges, + parserIncludedRanges, + parserSetLogger, + parserLogger, + parserHasLogger, + parserRemoveLogger, + parserParse, + parserParseString, + parserParseByteString, + parserParseByteStringWithEncoding, + parserReset, + Microsecond (..), + parserSetTimeoutMicros, + parserTimeoutMicros, + CancellationFlag (Cancel, Continue), + CancellationFlagRef, + getCancellationFlag, + putCancellationFlag, + parserSetCancellationFlag, + parserCancellationFlag, + parserPrintDotGraphs, + + -- * Tree + treeCopy, + unsafeTreeDelete, + treeRootNode, + treeRootNodeWithOffset, + treeLanguage, + treeIncludedRanges, + treeEdit, + treeGetChangedRanges, + treePrintDotGraph, + + -- * Node + nodeType, + nodeTypeAsString, + nodeSymbol, + nodeLanguage, + nodeGrammarType, + nodeGrammarTypeAsString, + nodeGrammarSymbol, + nodeRange, + nodeStartByte, + nodeStartPoint, + nodeEndByte, + nodeEndPoint, + showNode, + showNodeAsString, + nodeIsNull, + nodeIsNamed, + nodeIsMissing, + nodeIsExtra, + nodeHasChanges, + nodeHasError, + nodeIsError, + nodeParseState, + nodeNextParseState, + nodeParent, + nodeChildWithDescendant, + nodeChild, + nodeFieldNameForChild, + nodeFieldNameForChildAsString, + nodeFieldNameForNamedChild, + nodeFieldNameForNamedChildAsString, + nodeChildCount, + nodeNamedChild, + nodeNamedChildCount, + nodeChildByFieldName, + nodeChildByFieldId, + nodeNextSibling, + nodePrevSibling, + nodeNextNamedSibling, + nodePrevNamedSibling, + nodeFirstChildForByte, + nodeFirstNamedChildForByte, + nodeDescendantCount, + nodeDescendantForByteRange, + nodeDescendantForPointRange, + nodeNamedDescendantForByteRange, + nodeNamedDescendantForPointRange, + nodeEdit, + nodeEq, + + -- * TreeCursor + treeCursorNew, + unsafeTreeCursorDelete, + treeCursorReset, + treeCursorResetTo, + treeCursorCurrentNode, + treeCursorCurrentFieldName, + treeCursorCurrentFieldId, + treeCursorGotoParent, + treeCursorGotoNextSibling, + treeCursorGotoPreviousSibling, + treeCursorGotoFirstChild, + treeCursorGotoLastChild, + treeCursorGotoDescendant, + treeCursorCurrentDescendantIndex, + treeCursorCurrentDepth, + treeCursorGotoFirstChildForByte, + treeCursorGotoFirstChildForPoint, + treeCursorCopy, + + -- * Query + queryNew, + unsafeQueryDelete, + queryPatternCount, + queryCaptureCount, + queryStringCount, + queryStartByteForPattern, + queryEndByteForPattern, + queryPredicatesForPattern, + queryIsPatternRooted, + queryIsPatternNonLocal, + queryIsPatternGuaranteedAtStep, + queryCaptureNameForIndex, + queryCaptureQuantifierForIndex, + queryStringValueForIndex, + queryDisableCapture, + queryDisablePattern, + queryCursorNew, + unsafeQueryCursorDelete, + queryCursorExec, + queryCursorDidExceedMatchLimit, + queryCursorMatchLimit, + queryCursorSetMatchLimit, + queryCursorSetTimeoutMicros, + queryCursorTimeoutMicros, + queryCursorSetByteRange, + queryCursorSetPointRange, + queryCursorNextMatch, + queryCursorRemoveMatch, + queryCursorNextCapture, + queryCursorSetMaxStartDepth, + + -- * Language + unsafeToLanguage, + unsafeLanguageDelete, + languageCopy, + languageSymbolCount, + languageStateCount, + languageSymbolName, + languageSymbolForGrammarType, + languageFieldCount, + languageFieldNameForId, + languageFieldIdForName, + languageSymbolType, + languageVersion, + languageNextState, + + -- * Lookahead Iterator + withLookaheadIteratorAsTSLookaheadIteratorPtr, + lookaheadIteratorNew, + unsafeLookaheadIteratorDelete, + lookaheadIteratorResetState, + lookaheadIteratorReset, + lookaheadIteratorLanguage, + lookaheadIteratorNext, + lookaheadIteratorCurrentSymbol, + lookaheadIteratorCurrentSymbolName, + + -- * Global Configuration +) where + +import Control.Exception (Exception (..), assert, bracket, throwIO) +import Control.Monad ((<=<)) +import Data.ByteString qualified as BS +import Data.ByteString.Builder qualified as BSB +import Data.ByteString.Char8 qualified as BSC +import Data.ByteString.Internal (ByteString (BS)) +import Data.ByteString.Unsafe qualified as BSU +import Data.Coerce (coerce) +import Data.IORef (newIORef, writeIORef) +import Data.Maybe (isJust) +import Foreign +import Foreign.C (CBool, CInt (CInt), CSize (..)) +import Foreign.C.ConstPtr.Compat (ConstPtr (..)) +import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr) +import GHC.IO.FD (FD (..)) +import GHC.IO.Handle.FD (handleToFd) +import System.IO (Handle) +import TreeSitter.CApi qualified as C +import TreeSitter.CApi qualified as TSNode (TSNode (..)) + +-------------------------------------------------------------------------------- + +{-# ANN module ("HLint: ignore Redundant lambda" :: String) #-} + +{-# ANN module ("HLint: ignore Foreign should be imported post-qualified or with an explicit import list" :: String) #-} + +-------------------------------------------------------------------------------- + +-- * Types + +newtype CaptureIndex = WrapTSCaptureIndex {unWrapTSCaptureIndex :: Word32} + +newtype PatternIndex = WrapTSPatternIndex {unWrapTSPatternIndex :: Word32} + +newtype StateId = WrapTSStateId {unWrapTSStateId :: C.TSStateId} + deriving stock (Show, Read, Eq, Ord) + deriving newtype (Num, Real, Integral, Enum) + +newtype Symbol = WrapTSSymbol {unWrapTSSymbol :: C.TSSymbol} + deriving stock (Show, Read, Eq, Ord) + deriving newtype (Num, Real, Integral, Enum) + +newtype GrammarType = WrapTSGrammarType {unWrapTSGrammarType :: ByteString} + deriving stock (Show, Read, Eq, Ord) + +newtype FieldId = WrapTSFieldId {unWrapTSFieldId :: C.TSFieldId} + deriving stock (Show, Read, Eq, Ord) + deriving newtype (Num, Real, Integral, Enum) + +newtype FieldName = WrapTSFieldName {unWrapTSFieldName :: ByteString} + deriving stock (Show, Read, Eq, Ord) + +newtype CaptureName = WrapTSCaptureName {unWrapTSCaptureName :: ByteString} + deriving stock (Show, Read, Eq, Ord) + +newtype Language = WrapTSLanguage {unWrapTSLanguage :: ForeignPtr C.TSLanguage} + +newtype Parser = WrapTSParser {unWrapTSParser :: ForeignPtr C.TSParser} + +-- | __Warning__: 'Tree' is not thread-safe. To use a 'Tree' from multiple threads, you must copy it using 'treeCopy'. +newtype Tree = WrapTSTree {unWrapTSTree :: ForeignPtr C.TSTree} + +newtype Query = WrapTSQuery {unWrapTSQuery :: ForeignPtr C.TSQuery} + +newtype QueryCursor = WrapTSQueryCursor {unWrapTSQueryCursor :: ForeignPtr C.TSQueryCursor} + +newtype LookaheadIterator = WrapTSLookaheadIterator {unWrapTSLookaheadIterator :: ForeignPtr C.TSLookaheadIterator} + +newtype InputEncoding = WrapTSInputEncoding {unWrapTSInputEncoding :: C.TSInputEncoding} + +pattern InputEncodingUTF8 :: InputEncoding +pattern InputEncodingUTF8 = WrapTSInputEncoding C.TSInputEncodingUTF8 + +pattern InputEncodingUTF16 :: InputEncoding +pattern InputEncodingUTF16 = WrapTSInputEncoding C.TSInputEncodingUTF16 + +{-# COMPLETE InputEncodingUTF8, InputEncodingUTF16 #-} + +instance Show InputEncoding where + show InputEncodingUTF8 = "InputEncodingUTF8" + show InputEncodingUTF16 = "InputEncodingUTF16" + +newtype SymbolType = WrapTSSymbolType {unWrapTSSymbolType :: C.TSSymbolType} + deriving stock (Eq) + +pattern SymbolTypeRegular :: SymbolType +pattern SymbolTypeRegular = WrapTSSymbolType C.TSSymbolTypeRegular + +pattern SymbolTypeAnonymous :: SymbolType +pattern SymbolTypeAnonymous = WrapTSSymbolType C.TSSymbolTypeAnonymous + +pattern SymbolTypeSupertype :: SymbolType +pattern SymbolTypeSupertype = WrapTSSymbolType C.TSSymbolTypeSupertype + +pattern SymbolTypeAuxiliary :: SymbolType +pattern SymbolTypeAuxiliary = WrapTSSymbolType C.TSSymbolTypeAuxiliary + +{-# COMPLETE SymbolTypeRegular, SymbolTypeAnonymous, SymbolTypeSupertype, SymbolTypeAuxiliary #-} + +instance Show SymbolType where + show SymbolTypeRegular = "SymbolTypeRegular" + show SymbolTypeAnonymous = "SymbolTypeAnonymous" + show SymbolTypeSupertype = "SymbolTypeSupertype" + show SymbolTypeAuxiliary = "SymbolTypeAuxiliary" + +newtype Point = WrapTSPoint {unWrapTSPoint :: C.TSPoint} + deriving newtype (Ord, Eq) + +pattern Point :: Word32 -> Word32 -> Point +pattern Point + { pointRow + , pointColumn + } = + WrapTSPoint + ( C.TSPoint + pointRow + pointColumn + ) + +{-# COMPLETE Point #-} + +instance Show Point where + showsPrec :: Int -> Point -> ShowS + showsPrec p Point{..} = + showParen (p > 10) $ + showString "Point " + . showsPrec 11 pointRow + . showChar ' ' + . showsPrec 11 pointColumn + +newtype Range = WrapTSRange {unWrapTSRange :: C.TSRange} + deriving stock (Eq) + +pattern Range :: Point -> Point -> Word32 -> Word32 -> Range +pattern Range + { rangeStartPoint + , rangeEndPoint + , rangeStartByte + , rangeEndByte + } <- + WrapTSRange + ( C.TSRange + (WrapTSPoint -> rangeStartPoint) + (WrapTSPoint -> rangeEndPoint) + rangeStartByte + rangeEndByte + ) + where + Range startPoint endPoint startByte endByte = + WrapTSRange + ( C.TSRange + (unWrapTSPoint startPoint) + (unWrapTSPoint endPoint) + startByte + endByte + ) + +{-# COMPLETE Range #-} + +instance Show Range where + showsPrec :: Int -> Range -> ShowS + showsPrec p Range{..} = + showParen (p > 10) $ + showString "Range " + . showsPrec 11 rangeStartPoint + . showChar ' ' + . showsPrec 11 rangeEndPoint + . showChar ' ' + . showsPrec 11 rangeStartByte + . showChar ' ' + . showsPrec 11 rangeEndByte + +newtype LogType = WrapTSLogType {unWrapTSLogType :: C.TSLogType} + deriving (Eq) + +pattern LogTypeParse :: LogType +pattern LogTypeParse = WrapTSLogType C.TSLogTypeParse + +pattern LogTypeLex :: LogType +pattern LogTypeLex = WrapTSLogType C.TSLogTypeLex + +{-# COMPLETE LogTypeParse, LogTypeLex #-} + +instance Show LogType where + show LogTypeParse = "LogTypeParse" + show LogTypeLex = "LogTypeLex" + +type Log = LogType -> ByteString -> IO () + +logToTSLog :: Log -> C.TSLog +logToTSLog logFun = \logType logMsg -> + BS.packCString (unConstPtr logMsg) >>= logFun (coerce logType) + +tsLogToLog :: C.TSLog -> Log +tsLogToLog logFun = \logType logMsg -> + BS.useAsCString logMsg $ logFun (coerce logType) . ConstPtr + +newtype InputEdit = WrapTSInputEdit {unWrapTSInputEdit :: C.TSInputEdit} + +pattern InputEdit :: Word32 -> Word32 -> Word32 -> Point -> Point -> Point -> InputEdit +pattern InputEdit + { inputEditStartByte + , inputEditOldEndByte + , inputEditNewEndByte + , inputEditStartPoint + , inputEditOldEndPoint + , inputEditNewEndPoint + } <- + WrapTSInputEdit + ( C.TSInputEdit + inputEditStartByte + inputEditOldEndByte + inputEditNewEndByte + (WrapTSPoint -> inputEditStartPoint) + (WrapTSPoint -> inputEditOldEndPoint) + (WrapTSPoint -> inputEditNewEndPoint) + ) + where + InputEdit startByte oldEndByte newEndByte startPoint oldEndPoint newEndPoint = + WrapTSInputEdit + ( C.TSInputEdit + startByte + oldEndByte + newEndByte + (unWrapTSPoint startPoint) + (unWrapTSPoint oldEndPoint) + (unWrapTSPoint newEndPoint) + ) + +newtype Node = WrapTSNode {unWrapTSNode :: C.TSNode} + +newtype NodeId = WrapTSNodeId {unWrapTSNodeId :: Int} + deriving stock (Eq, Ord) + deriving newtype (Show) + +nodeId :: Node -> NodeId +nodeId = coerce . ptrToIntPtr . coerce . TSNode._id . coerce + +newtype TreeCursor = WrapTSTreeCursor {unWrapTSTreeCursor :: ForeignPtr C.TSTreeCursor} + +newtype TreeCursorId = WrapTSTreeCursorId {unWrapTSTreeCursorId :: Word} + deriving (Eq, Ord) + +-- treeCursorId :: TreeCursor -> TreeCursorId +-- treeCursorId = coerce . ptrToWordPtr . coerce . TSTreeCursor._id . coerce + +newtype QueryCapture = WrapTSQueryCapture {unWrapTSQueryCapture :: C.TSQueryCapture} + +newtype Quantifier = WrapTSQuantifier {unWrapTSQuantifier :: C.TSQuantifier} + deriving stock (Eq) + +pattern QuantifierZero :: Quantifier +pattern QuantifierZero = WrapTSQuantifier C.TSQuantifierZero + +pattern QuantifierZeroOrOne :: Quantifier +pattern QuantifierZeroOrOne = WrapTSQuantifier C.TSQuantifierZeroOrOne + +pattern QuantifierZeroOrMore :: Quantifier +pattern QuantifierZeroOrMore = WrapTSQuantifier C.TSQuantifierZeroOrMore + +pattern QuantifierOne :: Quantifier +pattern QuantifierOne = WrapTSQuantifier C.TSQuantifierOne + +pattern QuantifierOneOrMore :: Quantifier +pattern QuantifierOneOrMore = WrapTSQuantifier C.TSQuantifierOneOrMore + +{-# COMPLETE QuantifierZero, QuantifierZeroOrOne, QuantifierZeroOrMore, QuantifierOne, QuantifierOneOrMore #-} + +instance Show Quantifier where + show QuantifierZero = "QuantifierZero" + show QuantifierZeroOrOne = "QuantifierZeroOrOne" + show QuantifierZeroOrMore = "QuantifierZeroOrMore" + show QuantifierOne = "QuantifierOne" + show QuantifierOneOrMore = "QuantifierOneOrMore" + +newtype QueryMatch = WrapTSQueryMatch {unWrapTSQueryMatch :: C.TSQueryMatch} + +newtype QueryPredicateStepType = WrapTSQueryPredicateStepType {unWrapTSQueryPredicateStepType :: C.TSQueryPredicateStepType} + deriving stock (Eq) + +pattern QueryPredicateStepTypeDone :: QueryPredicateStepType +pattern QueryPredicateStepTypeDone = WrapTSQueryPredicateStepType C.TSQueryPredicateStepTypeDone + +pattern QueryPredicateStepTypeCapture :: QueryPredicateStepType +pattern QueryPredicateStepTypeCapture = WrapTSQueryPredicateStepType C.TSQueryPredicateStepTypeCapture + +pattern QueryPredicateStepTypeString :: QueryPredicateStepType +pattern QueryPredicateStepTypeString = WrapTSQueryPredicateStepType C.TSQueryPredicateStepTypeString + +{-# COMPLETE QueryPredicateStepTypeDone, QueryPredicateStepTypeCapture, QueryPredicateStepTypeString #-} + +instance Show QueryPredicateStepType where + show QueryPredicateStepTypeDone = "QueryPredicateStepTypeDone" + show QueryPredicateStepTypeCapture = "QueryPredicateStepTypeCapture" + show QueryPredicateStepTypeString = "QueryPredicateStepTypeString" + +newtype QueryPredicateStep = WrapTSQueryPredicateStep {unWrapTSQueryPredicateStep :: C.TSQueryPredicateStep} + +newtype QueryErrorType = WrapTSQueryErrorType {unWrapTSQueryErrorType :: C.TSQueryError} + deriving stock (Eq) + +pattern QueryErrorTypeSyntax :: QueryErrorType +pattern QueryErrorTypeSyntax = WrapTSQueryErrorType C.TSQueryErrorSyntax + +pattern QueryErrorTypeNodeType :: QueryErrorType +pattern QueryErrorTypeNodeType = WrapTSQueryErrorType C.TSQueryErrorNodeType + +pattern QueryErrorTypeField :: QueryErrorType +pattern QueryErrorTypeField = WrapTSQueryErrorType C.TSQueryErrorField + +pattern QueryErrorTypeCapture :: QueryErrorType +pattern QueryErrorTypeCapture = WrapTSQueryErrorType C.TSQueryErrorCapture + +pattern QueryErrorTypeStructure :: QueryErrorType +pattern QueryErrorTypeStructure = WrapTSQueryErrorType C.TSQueryErrorStructure + +pattern QueryErrorTypeLanguage :: QueryErrorType +pattern QueryErrorTypeLanguage = WrapTSQueryErrorType C.TSQueryErrorLanguage + +{-# COMPLETE QueryErrorTypeSyntax, QueryErrorTypeNodeType, QueryErrorTypeField, QueryErrorTypeCapture, QueryErrorTypeStructure, QueryErrorTypeLanguage #-} + +instance Show QueryErrorType where + show QueryErrorTypeSyntax = "QueryErrorTypeSyntax" + show QueryErrorTypeNodeType = "QueryErrorTypeNodeType" + show QueryErrorTypeField = "QueryErrorTypeField" + show QueryErrorTypeCapture = "QueryErrorTypeCapture" + show QueryErrorTypeStructure = "QueryErrorTypeStructure" + show QueryErrorTypeLanguage = "QueryErrorTypeLanguage" + +data QueryError = QueryError + { queryErrorOffset :: !Word32 + , queryErrorPoint :: !Point + , queryErrorMessage :: !String + , queryErrorType :: !QueryErrorType + } + deriving (Show) + +instance Exception QueryError where + displayException :: QueryError -> String + displayException = queryErrorMessage + +-- * Parser + +withParserAsTSParserPtr :: Parser -> (Ptr C.TSParser -> IO a) -> IO a +withParserAsTSParserPtr = withForeignPtr . coerce + +-- | See @`C.ts_parser_new`@. +parserNew :: IO Parser +parserNew = coerce newForeignPtr C.p_ts_parser_delete =<< C.ts_parser_new + +{-| Delete the 'Parser' and free the associated memory. + +See @`C.ts_parser_delete`@. + +__Warning__: Using the 'Parser' after calling 'unsafeParserDelete' leads to undefined behaviour. + +__Warning__: If the 'Parser' has a logger, this function does not delete it. +-} +unsafeParserDelete :: Parser -> IO () +unsafeParserDelete = coerce finalizeForeignPtr + +withParser :: (Parser -> IO a) -> IO a +withParser = bracket parserNew unsafeParserDelete + +-- | See @`C.ts_parser_language`@. +parserLanguage :: Parser -> IO Language +parserLanguage parser = + withParserAsTSParserPtr parser $ + unsafeToLanguage <=< coerce C.ts_parser_language + +-- | See @`C.ts_parser_set_language`@. +parserSetLanguage :: Parser -> Language -> IO Bool +parserSetLanguage parser language = + withParserAsTSParserPtr parser $ \parserPtr -> do + withLanguageAsTSLanguagePtr language $ \languagePtr -> do + success <- C.ts_parser_set_language parserPtr languagePtr + pure $ toBool success + +-- | See @`C.ts_parser_set_included_ranges`@. +parserSetIncludedRanges :: Parser -> [Range] -> IO Bool +parserSetIncludedRanges parser ranges = + withParserAsTSParserPtr parser $ \parserPtr -> do + let rangesLength = length ranges + withArray (coerce ranges) $ \rangesPtr -> do + success <- + C.ts_parser_set_included_ranges + parserPtr + (ConstPtr rangesPtr) + (fromIntegral rangesLength) + pure $ toBool success + +-- | See @`C.ts_parser_included_ranges`@. +parserIncludedRanges :: Parser -> IO [Range] +parserIncludedRanges parser = + withParserAsTSParserPtr parser $ \parserPtr -> do + alloca $ \rangesLengthPtr -> do + rangesPtr <- + C.ts_parser_included_ranges + (ConstPtr parserPtr) + rangesLengthPtr + rangesLength <- fromIntegral <$> peek rangesLengthPtr + coerce $ peekArray rangesLength (unConstPtr rangesPtr) + +{-| Set the 'Logger' for a 'Parser'. + + See @`C.ts_parser_set_logger`@. +-} +parserSetLogger :: Parser -> Log -> IO () +parserSetLogger parser logFun = + withParserAsTSParserPtr parser $ \parserPtr -> + C.ts_parser_set_logger (coerce parserPtr) (logToTSLog logFun) + +{-| Get the 'Logger' for a 'Parser'. + + If no 'Logger' was set, 'parserLogger' returns 'Nothing'. + + See @`C.ts_parser_logger`@. +-} +parserLogger :: Parser -> IO (Maybe Log) +parserLogger parser = + withParserAsTSParserPtr parser $ + fmap (fmap tsLogToLog) . C.ts_parser_logger . coerce + +-- | Test if the 'Parser' has a 'Logger'. +parserHasLogger :: Parser -> IO Bool +parserHasLogger = fmap isJust . parserLogger + +-- | If the 'Parser' has a 'Logger', remove and pure it. +parserRemoveLogger :: Parser -> IO (Maybe Log) +parserRemoveLogger parser = + withParserAsTSParserPtr parser $ + fmap (fmap tsLogToLog) . C.ts_parser_remove_logger . coerce + +type Input = + -- | Byte index. + Word32 -> + -- | Position. + Point -> + IO ByteString + +-- | See @`C.ts_parser_parse`@. +parserParse :: Parser -> Maybe Tree -> Input -> InputEncoding -> IO (Maybe Tree) +parserParse parser oldTree input encoding = + withParserAsTSParserPtr parser $ \parserPtr -> + withMaybeTreeAsTSTreePtr oldTree $ \oldTreePtr -> do + -- NOTE: The purpose of `chunkRef` is to hold on to a reference to + -- the current chunk and prevent its garbage collection until + -- the next call to `tsRead`. + -- Incorrect management of these references can potentially cause + -- either a memory leak or a use-after-free error, since by using + -- `unsafeForeignPtrToPtr` we bypass the foreign pointer finalizer. + -- NOTE: Despite my best efforts, I have not been able to demonstrate + -- that this code without the `IORef` leaks memory. + chunkRef <- newIORef BS.empty + let tsRead = \byteIndex position_p bytesRead -> do + position <- WrapTSPoint <$> peek position_p + chunk@(BS chunkForeignPtr chunkLenInt) <- input byteIndex position + writeIORef chunkRef chunk + let chunkLen = fromIntegral chunkLenInt + poke bytesRead chunkLen + let chunkPtr = coerce (unsafeForeignPtrToPtr chunkForeignPtr) + pure chunkPtr + newTreePtr <- + C.ts_parser_parse + parserPtr + (ConstPtr oldTreePtr) + tsRead + (coerce encoding) + toMaybeTree newTreePtr + +-- | See @`C.ts_parser_parse_string`@. +parserParseString :: Parser -> Maybe Tree -> String -> IO (Maybe Tree) +parserParseString parser oldTree string = + parserParseByteString parser oldTree (BSC.pack string) + +-- | See @`C.ts_parser_parse_string`@. +parserParseByteString :: Parser -> Maybe Tree -> ByteString -> IO (Maybe Tree) +parserParseByteString parser oldTree string = + withParserAsTSParserPtr parser $ \parserPtr -> + withMaybeTreeAsTSTreePtr oldTree $ \oldTreePtr -> + BSU.unsafeUseAsCStringLen string $ \(stringPtr, stringLen) -> do + newTreePtr <- + C.ts_parser_parse_string + parserPtr + (ConstPtr oldTreePtr) + (ConstPtr stringPtr) + (fromIntegral stringLen) + toMaybeTree newTreePtr + +-- | See @`C.ts_parser_parse_string_encoding`@. +parserParseByteStringWithEncoding :: Parser -> Maybe Tree -> ByteString -> InputEncoding -> IO (Maybe Tree) +parserParseByteStringWithEncoding parser oldTree string inputEncoding = + withParserAsTSParserPtr parser $ \parserPtr -> + withMaybeTreeAsTSTreePtr oldTree $ \oldTreePtr -> + BSU.unsafeUseAsCStringLen string $ \(stringPtr, stringLen) -> do + newTreePtr <- + C.ts_parser_parse_string_encoding + parserPtr + (ConstPtr oldTreePtr) + (ConstPtr stringPtr) + (fromIntegral stringLen) + (coerce inputEncoding) + toMaybeTree newTreePtr + +-- | See @`C.ts_parser_reset`@. +parserReset :: Parser -> IO () +parserReset = (`withParserAsTSParserPtr` C.ts_parser_reset) + +-- | Microseconds. +newtype Microsecond = Microsecond {unMicrosecond :: Word64} + deriving stock (Show, Read, Eq, Ord) + deriving newtype (Num, Real, Integral, Enum) + +-- | See @`C.ts_parser_set_timeout_micros`@. +parserSetTimeoutMicros :: Parser -> Microsecond -> IO () +parserSetTimeoutMicros parser ms = + withParserAsTSParserPtr parser $ \parserPtr -> + coerce C.ts_parser_set_timeout_micros parserPtr ms + +-- | See @`C.ts_parser_timeout_micros`@. +parserTimeoutMicros :: Parser -> IO Microsecond +parserTimeoutMicros parser = + withParserAsTSParserPtr parser $ + coerce C.ts_parser_timeout_micros + +newtype CancellationFlag = WrapTSCancellationFlag {unWrapTSCancellationFlag :: CSize} + +isContinue :: CancellationFlag -> Bool +isContinue = (== 0) . unWrapTSCancellationFlag +{-# INLINE isContinue #-} + +pattern Continue :: CancellationFlag +pattern Continue = WrapTSCancellationFlag 0 + +pattern Cancel :: CancellationFlag +pattern Cancel <- (isContinue -> False) + where + Cancel = WrapTSCancellationFlag 1 + +{-# COMPLETE Continue, Cancel #-} + +newtype CancellationFlagRef = CancellationFlagRef {unCancellationFlagRef :: ConstPtr CSize} + +putCancellationFlag :: CancellationFlagRef -> CancellationFlag -> IO () +putCancellationFlag = coerce (poke @CSize) +{-# INLINE putCancellationFlag #-} + +getCancellationFlag :: CancellationFlagRef -> IO CancellationFlag +getCancellationFlag = coerce (peek @CSize) +{-# INLINE getCancellationFlag #-} + +-- | See @`C.ts_parser_set_cancellation_flag`@. +parserSetCancellationFlag :: Parser -> CancellationFlagRef -> IO () +parserSetCancellationFlag parser cancellationFlagRef = + withParserAsTSParserPtr parser $ \parserPtr -> + coerce C.ts_parser_set_cancellation_flag parserPtr cancellationFlagRef + +-- | See @`C.ts_parser_cancellation_flag`@. +parserCancellationFlag :: Parser -> IO CancellationFlagRef +parserCancellationFlag parser = + withParserAsTSParserPtr parser $ \parserPtr -> + coerce C.ts_parser_cancellation_flag parserPtr + +{-| See @'C.ts_parser_print_dot_graphs'@. +| This function throws an 'IOError' if the 'Handle' does not reference a file descriptor. +-} +parserPrintDotGraphs :: Parser -> Handle -> IO () +parserPrintDotGraphs parser handle = do + fileDescriptor <- fdFD <$> handleToFd handle + withParserAsTSParserPtr parser $ \parserPtr -> + coerce C.ts_parser_print_dot_graphs parserPtr fileDescriptor + +-- * Tree + +toTree :: Ptr C.TSTree -> IO Tree +toTree = coerce newForeignPtr C.p_ts_tree_delete + +withTreeAsTSTreePtr :: Tree -> (Ptr C.TSTree -> IO a) -> IO a +withTreeAsTSTreePtr = withForeignPtr . coerce + +toMaybeTree :: Ptr C.TSTree -> IO (Maybe Tree) +toMaybeTree treePtr + | treePtr == nullPtr = pure Nothing + | otherwise = Just <$> toTree treePtr + +withMaybeTreeAsTSTreePtr :: Maybe Tree -> (Ptr C.TSTree -> IO a) -> IO a +withMaybeTreeAsTSTreePtr mtree action = + maybe (action nullPtr) (`withTreeAsTSTreePtr` action) mtree + +-- | See @`C.ts_tree_copy`@. +treeCopy :: Tree -> IO Tree +treeCopy tree = + withTreeAsTSTreePtr tree $ + toTree <=< C.ts_tree_copy + +{-| Delete the 'Tree'. + +See @`C.ts_tree_delete`@. + +__Warning__: Using the 'Tree' after calling 'unsafeTreeDelete' leads to undefined behaviour. +-} +unsafeTreeDelete :: Tree -> IO () +unsafeTreeDelete = coerce finalizeForeignPtr + +-- | See @`C.ts_tree_root_node`@. +treeRootNode :: Tree -> IO Node +treeRootNode tree = + withTreeAsTSTreePtr tree $ + coerce C.ts_tree_root_node + +-- | See @`C.ts_tree_root_node_with_offset`@. +treeRootNodeWithOffset :: Tree -> Word32 -> Point -> IO Node +treeRootNodeWithOffset tree offsetBytes offsetExtent = + withTreeAsTSTreePtr tree $ \treePtr -> + coerce C.ts_tree_root_node_with_offset treePtr offsetBytes offsetExtent + +-- | See @`C.ts_tree_language`@. +treeLanguage :: Tree -> IO Language +treeLanguage tree = + withTreeAsTSTreePtr tree $ + unsafeToLanguage <=< C.ts_tree_language + +-- | See @`C.ts_tree_included_ranges`@. +treeIncludedRanges :: Tree -> IO [Range] +treeIncludedRanges tree = do + alloca $ \rangesLengthPtr -> do + rangesPtr <- + withTreeAsTSTreePtr tree $ \treePtr -> + C.ts_tree_included_ranges treePtr rangesLengthPtr + rangesLength <- fromIntegral <$> peek rangesLengthPtr + coerce <$> peekArray rangesLength rangesPtr + +-- | See @`C.ts_tree_edit`@. +treeEdit :: Tree -> InputEdit -> IO () +treeEdit tree inputEdit = + withTreeAsTSTreePtr tree $ \treePtr -> + with (coerce inputEdit) $ \inputEditPtr -> + C.ts_tree_edit treePtr inputEditPtr + +-- | See @`C.ts_tree_get_changed_ranges`@. +treeGetChangedRanges :: Tree -> Tree -> IO [Range] +treeGetChangedRanges oldTree newTree = + alloca $ \rangesLengthPtr -> do + rangesPtr <- + withTreeAsTSTreePtr oldTree $ \oldTreePtr -> + withTreeAsTSTreePtr newTree $ \newTreePtr -> + C.ts_tree_get_changed_ranges oldTreePtr newTreePtr rangesLengthPtr + rangesLength <- fromIntegral <$> peek rangesLengthPtr + coerce <$> peekArray rangesLength rangesPtr + +{-| See @'C.ts_tree_print_dot_graph'@. +| This function throws an 'IOError' if the 'Handle' does not reference a file descriptor. +-} +treePrintDotGraph :: Tree -> Handle -> IO () +treePrintDotGraph tree handle = do + fileDescriptor <- fdFD <$> handleToFd handle + withTreeAsTSTreePtr tree $ \treePtr -> + C.ts_tree_print_dot_graph treePtr (coerce fileDescriptor) + +-- * Node + +-- | See @`C.ts_node_type`@. +nodeType :: Node -> IO ByteString +nodeType = + -- The string returned by ts_node_type is null-terminated + -- and lives in static and constant memory. Do not free. + BSU.unsafePackCString <=< coerce C.ts_node_type +{-# INLINE nodeType #-} + +-- | See @`C.ts_node_type`@. +nodeTypeAsString :: Node -> IO String +nodeTypeAsString = fmap BSC.unpack . nodeType +{-# INLINE nodeTypeAsString #-} + +-- | See @`C.ts_node_symbol`@. +nodeSymbol :: Node -> IO Symbol +nodeSymbol = coerce C.ts_node_symbol +{-# INLINE nodeSymbol #-} + +-- | See @`C.ts_node_language`@. +nodeLanguage :: Node -> IO Language +nodeLanguage = unsafeToLanguage <=< coerce C.ts_node_language +{-# INLINE nodeLanguage #-} + +-- | See @`C.ts_node_grammar_type`@. +nodeGrammarType :: Node -> IO GrammarType +nodeGrammarType = + -- The string returned by ts_node_grammar_type is null-terminated + -- and lives in static and constant memory. Do not free. + coerce . BSU.unsafePackCString <=< coerce C.ts_node_grammar_type +{-# INLINE nodeGrammarType #-} + +-- | See @`C.ts_node_grammar_type`@. +nodeGrammarTypeAsString :: Node -> IO String +nodeGrammarTypeAsString = fmap (BSC.unpack . coerce) . nodeGrammarType +{-# INLINE nodeGrammarTypeAsString #-} + +-- | See @`C.ts_node_grammar_symbol`@. +nodeGrammarSymbol :: Node -> IO Symbol +nodeGrammarSymbol = coerce C.ts_node_grammar_symbol +{-# INLINE nodeGrammarSymbol #-} + +-- | Get the `Range` for the `Node`. +nodeRange :: Node -> IO Range +nodeRange node = do + rangeStartByte <- nodeStartByte node + rangeEndByte <- nodeEndByte node + rangeStartPoint <- nodeStartPoint node + rangeEndPoint <- nodeEndPoint node + pure Range{..} + +-- | See @`C.ts_node_start_byte`@. +nodeStartByte :: Node -> IO Word32 +nodeStartByte = coerce C.ts_node_start_byte +{-# INLINE nodeStartByte #-} + +-- | See @`C.ts_node_start_point`@. +nodeStartPoint :: Node -> IO Point +nodeStartPoint = coerce C.ts_node_start_point +{-# INLINE nodeStartPoint #-} + +-- | See @`C.ts_node_end_byte`@. +nodeEndByte :: Node -> IO Word32 +nodeEndByte = coerce C.ts_node_end_byte +{-# INLINE nodeEndByte #-} + +-- | See @`C.ts_node_end_point`@. +nodeEndPoint :: Node -> IO Point +nodeEndPoint = coerce C.ts_node_end_point +{-# INLINE nodeEndPoint #-} + +-- | See @`C.ts_node_string`@. +showNode :: Node -> IO ByteString +showNode = BSU.unsafePackMallocCString <=< coerce C.ts_node_string +{-# INLINE showNode #-} + +-- | See @`C.ts_node_string`@. +showNodeAsString :: Node -> IO String +showNodeAsString = fmap BSC.unpack . showNode +{-# INLINE showNodeAsString #-} + +-- | See @`C.ts_node_is_null`@. +nodeIsNull :: Node -> IO Bool +nodeIsNull = fmap toBool . C.ts_node_is_null . coerce +{-# INLINE nodeIsNull #-} + +-- | See @`C.ts_node_is_named`@. +nodeIsNamed :: Node -> IO Bool +nodeIsNamed = fmap toBool . C.ts_node_is_named . coerce +{-# INLINE nodeIsNamed #-} + +-- | See @`C.ts_node_is_missing`@. +nodeIsMissing :: Node -> IO Bool +nodeIsMissing = fmap toBool . C.ts_node_is_missing . coerce +{-# INLINE nodeIsMissing #-} + +-- | See @`C.ts_node_is_extra`@. +nodeIsExtra :: Node -> IO Bool +nodeIsExtra = fmap toBool . C.ts_node_is_extra . coerce +{-# INLINE nodeIsExtra #-} + +-- | See @`C.ts_node_has_changes`@. +nodeHasChanges :: Node -> IO Bool +nodeHasChanges = fmap toBool . C.ts_node_has_changes . coerce +{-# INLINE nodeHasChanges #-} + +-- | See @`C.ts_node_has_error`@. +nodeHasError :: Node -> IO Bool +nodeHasError = fmap toBool . C.ts_node_has_error . coerce +{-# INLINE nodeHasError #-} + +-- | See @`C.ts_node_is_error`@. +nodeIsError :: Node -> IO Bool +nodeIsError = fmap toBool . C.ts_node_is_error . coerce +{-# INLINE nodeIsError #-} + +-- | See @`C.ts_node_parse_state`@. +nodeParseState :: Node -> IO StateId +nodeParseState = coerce C.ts_node_parse_state +{-# INLINE nodeParseState #-} + +-- | See @`C.ts_node_next_parse_state`@. +nodeNextParseState :: Node -> IO StateId +nodeNextParseState = coerce C.ts_node_next_parse_state +{-# INLINE nodeNextParseState #-} + +-- | See @`C.ts_node_parent`@. +nodeParent :: Node -> IO Node +nodeParent = coerce C.ts_node_parent +{-# INLINE nodeParent #-} + +-- | See @`C.ts_node_child_with_descendant`@. +nodeChildWithDescendant :: Node -> Node -> IO Node +nodeChildWithDescendant = coerce C.ts_node_child_with_descendant +{-# INLINE nodeChildWithDescendant #-} + +-- | See @`C.ts_node_child`@. +nodeChild :: Node -> Word32 -> IO Node +nodeChild = coerce C.ts_node_child +{-# INLINE nodeChild #-} + +-- | See @`C.ts_node_field_name_for_child`@. +nodeFieldNameForChild :: Node -> Word32 -> IO FieldName +nodeFieldNameForChild node = + -- The string returned by ts_node_grammar_type is null-terminated + -- and lives in static and constant memory. Do not free. + coerce . BSU.unsafePackCString <=< coerce C.ts_node_field_name_for_child node +{-# INLINE nodeFieldNameForChild #-} + +-- | See @`C.ts_node_field_name_for_child`@. +nodeFieldNameForChildAsString :: Node -> Word32 -> IO String +nodeFieldNameForChildAsString node childIndex = + BSC.unpack . coerce <$> nodeFieldNameForChild node childIndex +{-# INLINE nodeFieldNameForChildAsString #-} + +-- | See @`C.ts_node_field_name_for_named_child`@. +nodeFieldNameForNamedChild :: Node -> Word32 -> IO FieldName +nodeFieldNameForNamedChild node = + -- The string returned by ts_node_grammar_type is null-terminated + -- and lives in static and constant memory. Do not free. + coerce . BSU.unsafePackCString <=< coerce C.ts_node_field_name_for_named_child node +{-# INLINE nodeFieldNameForNamedChild #-} + +-- | See @`C.ts_node_field_name_for_named_child`@. +nodeFieldNameForNamedChildAsString :: Node -> Word32 -> IO String +nodeFieldNameForNamedChildAsString node childIndex = + BSC.unpack . coerce <$> nodeFieldNameForNamedChild node childIndex +{-# INLINE nodeFieldNameForNamedChildAsString #-} + +-- | See @`C.ts_node_child_count`@. +nodeChildCount :: Node -> IO Word32 +nodeChildCount = coerce C.ts_node_child_count +{-# INLINE nodeChildCount #-} + +-- | See @`C.ts_node_named_child`@. +nodeNamedChild :: Node -> Word32 -> IO Node +nodeNamedChild = coerce C.ts_node_named_child +{-# INLINE nodeNamedChild #-} + +-- | See @`C.ts_node_named_child_count`@. +nodeNamedChildCount :: Node -> IO Word32 +nodeNamedChildCount = coerce C.ts_node_named_child_count +{-# INLINE nodeNamedChildCount #-} + +-- | See @`C.ts_node_child_by_field_name`@. +nodeChildByFieldName :: Node -> FieldName -> IO Node +nodeChildByFieldName node fieldName = + BSU.unsafeUseAsCStringLen (coerce fieldName) $ \(stringPtr, stringLen) -> + coerce C.ts_node_child_by_field_name node stringPtr $ + fromIntegral @_ @Word32 stringLen +{-# INLINE nodeChildByFieldName #-} + +-- | See @`C.ts_node_child_by_field_id`@. +nodeChildByFieldId :: Node -> FieldId -> IO Node +nodeChildByFieldId = coerce C.ts_node_child_by_field_id +{-# INLINE nodeChildByFieldId #-} + +-- | See @`C.ts_node_next_sibling`@. +nodeNextSibling :: Node -> IO Node +nodeNextSibling = coerce C.ts_node_next_sibling +{-# INLINE nodeNextSibling #-} + +-- | See @`C.ts_node_prev_sibling`@. +nodePrevSibling :: Node -> IO Node +nodePrevSibling = coerce C.ts_node_prev_sibling +{-# INLINE nodePrevSibling #-} + +-- | See @`C.ts_node_next_named_sibling`@. +nodeNextNamedSibling :: Node -> IO Node +nodeNextNamedSibling = coerce C.ts_node_next_named_sibling +{-# INLINE nodeNextNamedSibling #-} + +-- | See @`C.ts_node_prev_named_sibling`@. +nodePrevNamedSibling :: Node -> IO Node +nodePrevNamedSibling = coerce C.ts_node_prev_named_sibling +{-# INLINE nodePrevNamedSibling #-} + +-- | See @`C.ts_node_first_child_for_byte`@. +nodeFirstChildForByte :: Node -> Word32 -> IO Node +nodeFirstChildForByte = coerce C.ts_node_first_child_for_byte +{-# INLINE nodeFirstChildForByte #-} + +-- | See @`C.ts_node_first_named_child_for_byte`@. +nodeFirstNamedChildForByte :: Node -> Word32 -> IO Node +nodeFirstNamedChildForByte = coerce C.ts_node_first_named_child_for_byte +{-# INLINE nodeFirstNamedChildForByte #-} + +-- | See @`C.ts_node_descendant_count`@. +nodeDescendantCount :: Node -> IO Word32 +nodeDescendantCount = coerce C.ts_node_descendant_count +{-# INLINE nodeDescendantCount #-} + +-- | See @`C.ts_node_descendant_for_byte_range`@. +nodeDescendantForByteRange :: Node -> Word32 -> Word32 -> IO Node +nodeDescendantForByteRange = coerce C.ts_node_descendant_for_byte_range +{-# INLINE nodeDescendantForByteRange #-} + +-- | See @`C.ts_node_descendant_for_point_range`@. +nodeDescendantForPointRange :: Node -> Point -> Point -> IO Node +nodeDescendantForPointRange = coerce C.ts_node_descendant_for_point_range +{-# INLINE nodeDescendantForPointRange #-} + +-- | See @`C.ts_node_named_descendant_for_byte_range`@. +nodeNamedDescendantForByteRange :: Node -> Word32 -> Word32 -> IO Node +nodeNamedDescendantForByteRange = coerce C.ts_node_named_descendant_for_byte_range +{-# INLINE nodeNamedDescendantForByteRange #-} + +-- | See @`C.ts_node_named_descendant_for_point_range`@. +nodeNamedDescendantForPointRange :: Node -> Point -> Point -> IO Node +nodeNamedDescendantForPointRange = coerce C.ts_node_named_descendant_for_point_range +{-# INLINE nodeNamedDescendantForPointRange #-} + +-- | See @`C.ts_node_edit`@. +nodeEdit :: Node -> InputEdit -> IO () +nodeEdit node inputEdit = + with (unWrapTSNode node) $ \nodePtr -> + with (unWrapTSInputEdit inputEdit) $ \inputEditPtr -> + coerce C.ts_node_edit nodePtr inputEditPtr +{-# INLINE nodeEdit #-} + +-- | See @`C.ts_node_eq`@. +nodeEq :: Node -> Node -> IO Bool +nodeEq node1 node2 = + toBool <$> C.ts_node_eq (coerce node1) (coerce node2) +{-# INLINE nodeEq #-} + +-- * TreeCursor + +withTreeCursorAsTSTreeCursorPtr :: TreeCursor -> (Ptr C.TSTreeCursor -> IO a) -> IO a +withTreeCursorAsTSTreeCursorPtr = withForeignPtr . coerce + +-- | See @`C.ts_tree_cursor_new`@. +treeCursorNew :: Node -> IO TreeCursor +treeCursorNew node = do + treeCursorForeignPtr <- mallocForeignPtr + withForeignPtr treeCursorForeignPtr $ \treeCursorPtr -> + C.ts_tree_cursor_new_p (coerce node) treeCursorPtr + addForeignPtrFinalizer C.p_ts_tree_cursor_delete treeCursorForeignPtr + pure $ WrapTSTreeCursor treeCursorForeignPtr + +{-| Delete the 'TreeCursor'. + +| See @`C.ts_tree_cursor_delete`@. + +__Warning__: Using the 'Tree' after calling 'unsafeTreeCursorDelete' leads to undefined behaviour. +-} +unsafeTreeCursorDelete :: TreeCursor -> IO () +unsafeTreeCursorDelete = coerce finalizeForeignPtr + +-- | See @`C.ts_tree_cursor_reset`@. +treeCursorReset :: TreeCursor -> Node -> IO () +treeCursorReset treeCursor node = + withTreeCursorAsTSTreeCursorPtr treeCursor $ \treeCursorPtr -> + C.ts_tree_cursor_reset treeCursorPtr (coerce node) + +-- | See @`C.ts_tree_cursor_reset_to`@. +treeCursorResetTo :: TreeCursor -> TreeCursor -> IO () +treeCursorResetTo self other = + withTreeCursorAsTSTreeCursorPtr self $ \selfPtr -> + withTreeCursorAsTSTreeCursorPtr other $ \otherPtr -> + coerce C.ts_tree_cursor_reset_to selfPtr otherPtr + +-- | See @`C.ts_tree_cursor_current_node`@. +treeCursorCurrentNode :: TreeCursor -> IO Node +treeCursorCurrentNode treeCursor = + withTreeCursorAsTSTreeCursorPtr treeCursor $ \treeCursorPtr -> + coerce C.ts_tree_cursor_current_node treeCursorPtr + +-- | See @`C.ts_tree_cursor_current_field_name`@. +treeCursorCurrentFieldName :: TreeCursor -> IO (Maybe ByteString) +treeCursorCurrentFieldName treeCursor = + withTreeCursorAsTSTreeCursorPtr treeCursor $ \treeCursorPtr -> do + fieldNamePtr <- coerce C.ts_tree_cursor_current_field_name treeCursorPtr + if fieldNamePtr == nullPtr + then pure Nothing + else Just <$> BSU.unsafePackCString fieldNamePtr + +-- | See @`C.ts_tree_cursor_current_field_id`@. +treeCursorCurrentFieldId :: TreeCursor -> IO (Maybe FieldId) +treeCursorCurrentFieldId treeCursor = + withTreeCursorAsTSTreeCursorPtr treeCursor $ \treeCursorPtr -> do + fieldId <- coerce C.ts_tree_cursor_current_field_id treeCursorPtr + pure $ if fieldId == 0 then Nothing else Just fieldId + +-- | See @`C.ts_tree_cursor_goto_parent`@. +treeCursorGotoParent :: TreeCursor -> IO Bool +treeCursorGotoParent treeCursor = + withTreeCursorAsTSTreeCursorPtr treeCursor $ + fmap toBool . C.ts_tree_cursor_goto_parent + +-- | See @`C.ts_tree_cursor_goto_next_sibling`@. +treeCursorGotoNextSibling :: TreeCursor -> IO Bool +treeCursorGotoNextSibling treeCursor = + withTreeCursorAsTSTreeCursorPtr treeCursor $ + fmap toBool . C.ts_tree_cursor_goto_next_sibling + +-- | See @`C.ts_tree_cursor_goto_previous_sibling`@. +treeCursorGotoPreviousSibling :: TreeCursor -> IO Bool +treeCursorGotoPreviousSibling treeCursor = + withTreeCursorAsTSTreeCursorPtr treeCursor $ + fmap toBool . C.ts_tree_cursor_goto_previous_sibling + +-- | See @`C.ts_tree_cursor_goto_first_child`@. +treeCursorGotoFirstChild :: TreeCursor -> IO Bool +treeCursorGotoFirstChild treeCursor = + withTreeCursorAsTSTreeCursorPtr treeCursor $ + fmap toBool . C.ts_tree_cursor_goto_first_child + +-- | See @`C.ts_tree_cursor_goto_last_child`@. +treeCursorGotoLastChild :: TreeCursor -> IO Bool +treeCursorGotoLastChild treeCursor = + withTreeCursorAsTSTreeCursorPtr treeCursor $ + fmap toBool . C.ts_tree_cursor_goto_last_child + +-- | See @`C.ts_tree_cursor_goto_descendant`@. +treeCursorGotoDescendant :: TreeCursor -> Word32 -> IO () +treeCursorGotoDescendant treeCursor descsendantIndex = + withTreeCursorAsTSTreeCursorPtr treeCursor $ \treeCursorPtr -> + C.ts_tree_cursor_goto_descendant treeCursorPtr descsendantIndex + +-- | See @`C.ts_tree_cursor_current_descendant_index`@. +treeCursorCurrentDescendantIndex :: TreeCursor -> IO Word32 +treeCursorCurrentDescendantIndex treeCursor = + withTreeCursorAsTSTreeCursorPtr treeCursor $ + C.ts_tree_cursor_current_descendant_index . coerce + +-- | See @`C.ts_tree_cursor_current_depth`@. +treeCursorCurrentDepth :: TreeCursor -> IO Word32 +treeCursorCurrentDepth treeCursor = + withTreeCursorAsTSTreeCursorPtr treeCursor $ + C.ts_tree_cursor_current_depth . coerce + +-- | See @`C.ts_tree_cursor_goto_first_child_for_byte`@. +treeCursorGotoFirstChildForByte :: TreeCursor -> Word32 -> IO Int64 +treeCursorGotoFirstChildForByte treeCursor goalByte = + withTreeCursorAsTSTreeCursorPtr treeCursor $ \treeCursorPtr -> + C.ts_tree_cursor_goto_first_child_for_byte treeCursorPtr goalByte + +-- | See @`C.ts_tree_cursor_goto_first_child_for_point`@. +treeCursorGotoFirstChildForPoint :: TreeCursor -> Point -> IO Int64 +treeCursorGotoFirstChildForPoint treeCursor point = + withTreeCursorAsTSTreeCursorPtr treeCursor $ \treeCursorPtr -> + C.ts_tree_cursor_goto_first_child_for_point treeCursorPtr (coerce point) + +-- | See @`C.ts_tree_cursor_copy`@. +treeCursorCopy :: TreeCursor -> IO TreeCursor +treeCursorCopy treeCursor = do + copyOfTreeCursorForeignPtr <- mallocForeignPtr + withForeignPtr copyOfTreeCursorForeignPtr $ \copyOfTreeCursorPtr -> + withTreeCursorAsTSTreeCursorPtr treeCursor $ \treeCursorPtr -> + C.ts_tree_cursor_copy_p treeCursorPtr copyOfTreeCursorPtr + addForeignPtrFinalizer C.p_ts_tree_cursor_delete copyOfTreeCursorForeignPtr + pure $ WrapTSTreeCursor copyOfTreeCursorForeignPtr + +-- * Query + +withQueryAsTSQueryPtr :: Query -> (Ptr C.TSQuery -> IO a) -> IO a +withQueryAsTSQueryPtr = withForeignPtr . coerce + +-- | See @`C.ts_query_new`@. +queryNew :: Language -> ByteString -> IO Query +queryNew language query = + alloca $ \queryErrorOffsetPtr -> alloca $ \queryErrorTypePtr -> do + queryPtr <- + withLanguageAsTSLanguagePtr language $ \languagePtr -> + BSU.unsafeUseAsCStringLen query $ \(queryPtr, queryLen) -> + coerce C.ts_query_new languagePtr queryPtr (fromIntegral queryLen :: Word32) queryErrorOffsetPtr queryErrorTypePtr + queryErrorType' <- peek queryErrorTypePtr + if queryPtr /= nullPtr + then assert (queryErrorType' == C.TSQueryErrorNone) $ do + WrapTSQuery <$> newForeignPtr C.p_ts_query_delete queryPtr + else assert (queryErrorType' /= C.TSQueryErrorNone) $ do + queryErrorOffset' <- peek queryErrorOffsetPtr + let !queryError = makeQueryError query queryErrorOffset' (WrapTSQueryErrorType queryErrorType') + throwIO queryError + +-- | Internal helper: Format a query error. +makeQueryError :: ByteString -> Word32 -> QueryErrorType -> QueryError +makeQueryError query queryErrorOffset queryErrorType = QueryError{..} + where + (queryErrorPoint, queryErrorLine) = offsetToPointAndLine query queryErrorOffset + queryErrorMessage = + BSC.unpack . BS.toStrict . BSB.toLazyByteString . mconcat $ + [ BSB.stringUtf8 $ + case queryErrorType of + QueryErrorTypeSyntax -> "Invalid syntax" + QueryErrorTypeNodeType -> "Invalid node type" + QueryErrorTypeField -> "Invalid field name" + QueryErrorTypeCapture -> "Invalid capture name" + QueryErrorTypeStructure -> "Impossible pattern" + QueryErrorTypeLanguage -> "Invalid language" + , BSB.stringUtf8 " at row " + , BSB.word32Dec $ pointRow queryErrorPoint + , BSB.stringUtf8 ", column " + , BSB.word32Dec $ pointColumn queryErrorPoint + , BSB.stringUtf8 ":\n\n> " + , BSB.stringUtf8 queryErrorLine + , BSB.stringUtf8 "\n> " + , BSB.stringUtf8 (replicate (fromIntegral $ pointColumn queryErrorPoint - 1) ' ') + , BSB.stringUtf8 "^\n\n" + ] + +-- | Internal helper: Given a byte offset, find the row, column, and line pointed to. +offsetToPointAndLine :: ByteString -> Word32 -> (Point, String) +offsetToPointAndLine str offset = (point, line) + where + (prefix, suffix) = BS.splitAt (fromIntegral offset) str + prefixLine = BSC.unpack $ BSC.takeWhileEnd (/= '\n') prefix + suffixLine = BSC.unpack $ BSC.takeWhile (/= '\n') suffix + row = 1 + BSC.count '\n' prefix + column = 1 + length prefixLine + point = Point{pointRow = fromIntegral row, pointColumn = fromIntegral column} + line = prefixLine <> suffixLine + +{-| Delete the 'Query' and free the associated memory. + +See @`C.ts_query_delete`@. + +__Warning__: Using the 'Query' after calling 'unsafeQueryDelete' leads to undefined behaviour. +-} +unsafeQueryDelete :: Query -> IO () +unsafeQueryDelete = coerce finalizeForeignPtr + +-- | See @`C.ts_query_pattern_count`@. +queryPatternCount :: Query -> IO Word32 +queryPatternCount query = + withQueryAsTSQueryPtr query $ + coerce C.ts_query_pattern_count + +-- | See @`C.ts_query_capture_count`@. +queryCaptureCount :: Query -> IO Word32 +queryCaptureCount query = + withQueryAsTSQueryPtr query $ + coerce C.ts_query_capture_count + +-- | See @`C.ts_query_string_count`@. +queryStringCount :: Query -> IO Word32 +queryStringCount query = + withQueryAsTSQueryPtr query $ + coerce C.ts_query_string_count + +-- | See @`C.ts_query_start_byte_for_pattern`@. +queryStartByteForPattern :: Query -> PatternIndex -> IO Word32 +queryStartByteForPattern query patternIndex = + withQueryAsTSQueryPtr query $ \queryPtr -> + coerce C.ts_query_start_byte_for_pattern queryPtr patternIndex + +-- | See @`C.ts_query_end_byte_for_pattern`@. +queryEndByteForPattern :: Query -> PatternIndex -> IO Word32 +queryEndByteForPattern query patternIndex = + withQueryAsTSQueryPtr query $ \queryPtr -> + coerce C.ts_query_end_byte_for_pattern queryPtr patternIndex + +-- -- | See @`ts_query_predicates_for_pattern`@. +queryPredicatesForPattern :: Query -> Word32 -> IO [QueryPredicateStep] +queryPredicatesForPattern query patternIndex = do + (stepsPtr, stepsLen) <- + alloca $ \stepCountPtr -> do + stepsPtr <- + withQueryAsTSQueryPtr query $ \queryPtr -> + C.ts_query_predicates_for_pattern (ConstPtr queryPtr) patternIndex stepCountPtr + stepsLen <- fromIntegral <$> peek stepCountPtr + pure (unConstPtr stepsPtr, stepsLen) + coerce $ peekArray @C.TSQueryPredicateStep stepsLen stepsPtr + +-- | See @`C.ts_query_is_pattern_rooted`@. +queryIsPatternRooted :: Query -> PatternIndex -> IO Bool +queryIsPatternRooted query patternIndex = + withQueryAsTSQueryPtr query $ \queryPtr -> + toBool @CBool <$> coerce C.ts_query_is_pattern_rooted queryPtr patternIndex + +-- | See @`C.ts_query_is_pattern_non_local`@. +queryIsPatternNonLocal :: Query -> PatternIndex -> IO Bool +queryIsPatternNonLocal query patternIndex = + withQueryAsTSQueryPtr query $ \queryPtr -> + toBool @CBool <$> coerce C.ts_query_is_pattern_non_local queryPtr patternIndex + +-- | See @`C.ts_query_is_pattern_guaranteed_at_step`@. +queryIsPatternGuaranteedAtStep :: Query -> Word32 -> IO Bool +queryIsPatternGuaranteedAtStep query byteOffset = + withQueryAsTSQueryPtr query $ \queryPtr -> + toBool <$> C.ts_query_is_pattern_guaranteed_at_step (ConstPtr queryPtr) byteOffset + +-- | See @`C.ts_query_capture_name_for_id`@. +queryCaptureNameForIndex :: Query -> CaptureIndex -> IO CaptureName +queryCaptureNameForIndex query captureIndex = do + (namePtr, nameLen) <- + alloca @Word32 $ \nameLenPtr -> + (,) + <$> withQueryAsTSQueryPtr + query + ( \queryPtr -> + coerce C.ts_query_capture_name_for_id queryPtr captureIndex nameLenPtr + ) + <*> (fromIntegral <$> peek nameLenPtr) + coerce $ BSU.unsafePackCStringLen (namePtr, nameLen) + +-- | See @`C.ts_query_capture_quantifier_for_id`@. +queryCaptureQuantifierForIndex :: Query -> PatternIndex -> CaptureIndex -> IO Quantifier +queryCaptureQuantifierForIndex query patternIndex captureIndex = + withQueryAsTSQueryPtr query $ \queryPtr -> + coerce C.ts_query_capture_quantifier_for_id queryPtr patternIndex captureIndex + +-- -- | See @`ts_query_string_value_for_id`@. +queryStringValueForIndex :: Query -> CaptureIndex -> IO ByteString +queryStringValueForIndex query captureIndex = do + (strPtr, strLen) <- + alloca @Word32 $ \strLenPtr -> + (,) + <$> withQueryAsTSQueryPtr + query + ( \queryPtr -> + coerce C.ts_query_string_value_for_id queryPtr captureIndex strLenPtr + ) + <*> (fromIntegral <$> peek strLenPtr) + BS.packCStringLen (strPtr, strLen) + +-- | See @`C.ts_query_disable_capture`@. +queryDisableCapture :: Query -> CaptureName -> IO () +queryDisableCapture query captureName = + withQueryAsTSQueryPtr query $ \queryPtr -> + BSU.unsafeUseAsCStringLen (coerce captureName) $ \(namePtr, nameLen) -> + coerce C.ts_query_disable_capture queryPtr namePtr (fromIntegral nameLen :: Word32) + +-- | See @`C.ts_query_disable_pattern`@. +queryDisablePattern :: Query -> PatternIndex -> IO () +queryDisablePattern query patternIndex = + withQueryAsTSQueryPtr query $ \queryPtr -> + coerce C.ts_query_disable_pattern queryPtr patternIndex + +withQueryCursorAsTSQueryCursorPtr :: QueryCursor -> (Ptr C.TSQueryCursor -> IO a) -> IO a +withQueryCursorAsTSQueryCursorPtr = withForeignPtr . coerce + +-- | See @`C.ts_query_cursor_new`@. +queryCursorNew :: IO QueryCursor +queryCursorNew = + coerce newForeignPtr C.p_ts_query_cursor_delete =<< C.ts_query_cursor_new + +-- | See @`C.ts_query_cursor_delete`@. +unsafeQueryCursorDelete :: QueryCursor -> IO () +unsafeQueryCursorDelete = coerce finalizeForeignPtr + +-- | See @`C.ts_query_cursor_exec`@. +queryCursorExec :: QueryCursor -> Query -> Node -> IO () +queryCursorExec queryCursor query node = + withQueryCursorAsTSQueryCursorPtr queryCursor $ \queryCursorPtr -> + withQueryAsTSQueryPtr query $ \queryPtr -> + coerce C.ts_query_cursor_exec queryCursorPtr queryPtr node + +-- | See @`C.ts_query_cursor_did_exceed_match_limit`@. +queryCursorDidExceedMatchLimit :: QueryCursor -> IO Bool +queryCursorDidExceedMatchLimit queryCursor = + withQueryCursorAsTSQueryCursorPtr queryCursor $ \queryCursorPtr -> + toBool @CBool <$> coerce C.ts_query_cursor_did_exceed_match_limit queryCursorPtr + +-- | See @`C.ts_query_cursor_match_limit`@. +queryCursorMatchLimit :: QueryCursor -> IO Word32 +queryCursorMatchLimit queryCursor = + withQueryCursorAsTSQueryCursorPtr queryCursor $ + coerce C.ts_query_cursor_match_limit + +-- | See @`C.ts_query_cursor_set_match_limit`@. +queryCursorSetMatchLimit :: QueryCursor -> Word32 -> IO () +queryCursorSetMatchLimit queryCursor matchLimit = + withQueryCursorAsTSQueryCursorPtr queryCursor $ \queryCursorPtr -> + C.ts_query_cursor_set_match_limit queryCursorPtr matchLimit + +-- | See @`C.ts_query_cursor_set_timeout_micros`@. +queryCursorSetTimeoutMicros :: QueryCursor -> Microsecond -> IO () +queryCursorSetTimeoutMicros queryCursor micros = + withQueryCursorAsTSQueryCursorPtr queryCursor $ \queryCursorPtr -> + coerce C.ts_query_cursor_set_timeout_micros queryCursorPtr micros + +-- | See @`C.ts_query_cursor_timeout_micros`@. +queryCursorTimeoutMicros :: QueryCursor -> IO Microsecond +queryCursorTimeoutMicros queryCursor = + withQueryCursorAsTSQueryCursorPtr queryCursor $ + coerce C.ts_query_cursor_timeout_micros + +-- | See @`C.ts_query_cursor_set_byte_range`@. +queryCursorSetByteRange :: QueryCursor -> Word32 -> Word32 -> IO () +queryCursorSetByteRange queryCursor startByte endByte = + withQueryCursorAsTSQueryCursorPtr queryCursor $ \queryCursorPtr -> + C.ts_query_cursor_set_byte_range queryCursorPtr startByte endByte + +-- | See @`C.ts_query_cursor_set_point_range`@. +queryCursorSetPointRange :: QueryCursor -> Point -> Point -> IO () +queryCursorSetPointRange queryCursor startPoint endPoint = + withQueryCursorAsTSQueryCursorPtr queryCursor $ \queryCursorPtr -> + coerce C.ts_query_cursor_set_point_range queryCursorPtr startPoint endPoint + +-- | See @`C.ts_query_cursor_next_match`@. +queryCursorNextMatch :: QueryCursor -> IO (Maybe QueryMatch) +queryCursorNextMatch queryCursor = + alloca $ \queryMatchPtr -> do + success <- + withQueryCursorAsTSQueryCursorPtr queryCursor $ \queryCursorPtr -> + C.ts_query_cursor_next_match queryCursorPtr queryMatchPtr + if toBool success + then do + queryMatch <- peek queryMatchPtr + pure . Just . coerce $ queryMatch + else pure Nothing + +-- | See @`C.ts_query_cursor_remove_match`@. +queryCursorRemoveMatch :: QueryCursor -> CaptureIndex -> IO () +queryCursorRemoveMatch queryCursor captureIndex = + withQueryCursorAsTSQueryCursorPtr queryCursor $ \queryCursorPtr -> + coerce C.ts_query_cursor_remove_match queryCursorPtr captureIndex + +-- | See @`C.ts_query_cursor_next_capture`@. +queryCursorNextCapture :: QueryCursor -> IO (Maybe (CaptureIndex, QueryMatch)) +queryCursorNextCapture queryCursor = + alloca $ \captureIndexPtr -> alloca $ \queryMatchPtr -> do + success <- + withQueryCursorAsTSQueryCursorPtr queryCursor $ \queryCursorPtr -> + C.ts_query_cursor_next_capture queryCursorPtr queryMatchPtr captureIndexPtr + if toBool success + then do + captureIndex <- peek captureIndexPtr + queryMatch <- peek queryMatchPtr + pure . Just . coerce $ (captureIndex, queryMatch) + else pure Nothing + +-- | See @`C.ts_query_cursor_set_max_start_depth`@. +queryCursorSetMaxStartDepth :: QueryCursor -> Word32 -> IO () +queryCursorSetMaxStartDepth queryCursor maxStartDepth = + withQueryCursorAsTSQueryCursorPtr queryCursor $ \queryCursorPtr -> + C.ts_query_cursor_set_max_start_depth queryCursorPtr maxStartDepth + +-- * Language + +unsafeToLanguage :: ConstPtr tsLanguage -> IO Language +unsafeToLanguage languageConstPtr = do + let languagePtr = castPtr . unConstPtr $ languageConstPtr + let languageFinalizer = castFunPtr C.p_ts_language_delete + languageForeignPtr <- newForeignPtr languageFinalizer languagePtr + pure $ coerce languageForeignPtr + +unsafeLanguageDelete :: Language -> IO () +unsafeLanguageDelete = + finalizeForeignPtr . coerce + +withLanguageAsTSLanguagePtr :: Language -> (ConstPtr C.TSLanguage -> IO a) -> IO a +withLanguageAsTSLanguagePtr language action = + withForeignPtr (coerce language) (action . ConstPtr) + +-- | See @`C.ts_language_copy`@. +languageCopy :: Language -> IO Language +languageCopy language = + withLanguageAsTSLanguagePtr language $ + unsafeToLanguage <=< C.ts_language_copy . coerce + +-- | See @`C.ts_language_symbol_count`@. +languageSymbolCount :: Language -> IO Word32 +languageSymbolCount language = + withLanguageAsTSLanguagePtr + language + C.ts_language_symbol_count + +-- | See @`C.ts_language_state_count`@. +languageStateCount :: Language -> IO Word32 +languageStateCount language = + withLanguageAsTSLanguagePtr + language + C.ts_language_state_count + +-- | See @`C.ts_language_symbol_name`@. +languageSymbolName :: Language -> Symbol -> IO ByteString +languageSymbolName language symbol = + withLanguageAsTSLanguagePtr language $ \languagePtr -> + BSU.unsafePackCString =<< coerce C.ts_language_symbol_name languagePtr symbol + +-- | See @`C.ts_language_symbol_for_name`@. +languageSymbolForGrammarType :: Language -> ByteString -> Bool -> IO Symbol +languageSymbolForGrammarType language grammarType isNamed = + withLanguageAsTSLanguagePtr language $ \languagePtr -> + BSU.unsafeUseAsCStringLen grammarType $ \(grammarTypeStr, grammarTypeLen) -> + coerce + C.ts_language_symbol_for_name + languagePtr + grammarTypeStr + (fromIntegral grammarTypeLen :: Word32) + (fromBool isNamed :: CBool) + +-- | See @`C.ts_language_field_count`@. +languageFieldCount :: Language -> IO Word32 +languageFieldCount language = + withLanguageAsTSLanguagePtr language $ \languagePtr -> + C.ts_language_field_count languagePtr + +-- | See @`C.ts_language_field_name_for_id`@. +languageFieldNameForId :: Language -> FieldId -> IO ByteString +languageFieldNameForId language fieldId = + withLanguageAsTSLanguagePtr language $ \languagePtr -> + BSU.unsafePackCString =<< coerce C.ts_language_field_name_for_id languagePtr fieldId + +-- | See @`C.ts_language_field_id_for_name`@. +languageFieldIdForName :: Language -> ByteString -> IO FieldId +languageFieldIdForName language fieldName = + withLanguageAsTSLanguagePtr language $ \languagePtr -> + BSU.unsafeUseAsCStringLen fieldName $ \(fieldNameStr, fieldNameLen) -> + coerce + C.ts_language_field_id_for_name + languagePtr + fieldNameStr + (fromIntegral fieldNameLen :: Word32) + +-- | See @`C.ts_language_symbol_type`@. +languageSymbolType :: Language -> Symbol -> IO SymbolType +languageSymbolType language symbol = + withLanguageAsTSLanguagePtr language $ \languagePtr -> + coerce C.ts_language_symbol_type languagePtr symbol + +-- | See @`C.ts_language_version`@. +languageVersion :: Language -> IO Word32 +languageVersion language = + withLanguageAsTSLanguagePtr language C.ts_language_version + +-- | See @`C.ts_language_next_state`@. +languageNextState :: Language -> StateId -> Symbol -> IO StateId +languageNextState language stateId symbol = + withLanguageAsTSLanguagePtr language $ \languagePtr -> + coerce C.ts_language_next_state languagePtr stateId symbol + +-- * Lookahead Iterator + +withLookaheadIteratorAsTSLookaheadIteratorPtr :: LookaheadIterator -> (ConstPtr C.TSLookaheadIterator -> IO a) -> IO a +withLookaheadIteratorAsTSLookaheadIteratorPtr lookaheadIterator action = + withForeignPtr (coerce lookaheadIterator) (action . ConstPtr) + +-- | See @`C.ts_lookahead_iterator_new`@. +lookaheadIteratorNew :: Language -> StateId -> IO LookaheadIterator +lookaheadIteratorNew language stateId = + withLanguageAsTSLanguagePtr language $ \languagePtr -> + coerce newForeignPtr C.p_ts_lookahead_iterator_delete + =<< C.ts_lookahead_iterator_new languagePtr (coerce stateId) + +{-| See @`C.ts_lookahead_iterator_delete`@. + + __Warning__: Using the `LookaheadIterator` after calling `unsafeLookaheadIteratorDelete` leads to undefined behaviour. +-} +unsafeLookaheadIteratorDelete :: LookaheadIterator -> IO () +unsafeLookaheadIteratorDelete = coerce finalizeForeignPtr + +-- | See @`C.ts_lookahead_iterator_reset_state`@. +lookaheadIteratorResetState :: LookaheadIterator -> StateId -> IO Bool +lookaheadIteratorResetState lookaheadIterator stateId = + withLookaheadIteratorAsTSLookaheadIteratorPtr lookaheadIterator $ \lookaheadIteratorPtr -> do + toBool @CBool <$> coerce C.ts_lookahead_iterator_reset_state lookaheadIteratorPtr stateId + +-- | See @`C.ts_lookahead_iterator_reset`@. +lookaheadIteratorReset :: LookaheadIterator -> Language -> StateId -> IO Bool +lookaheadIteratorReset lookaheadIterator language stateId = do + withLanguageAsTSLanguagePtr language $ \languagePtr -> + withLookaheadIteratorAsTSLookaheadIteratorPtr lookaheadIterator $ \lookaheadIteratorPtr -> + toBool @CBool <$> coerce C.ts_lookahead_iterator_reset lookaheadIteratorPtr languagePtr stateId + +-- | See @`C.ts_lookahead_iterator_language`@. +lookaheadIteratorLanguage :: LookaheadIterator -> IO Language +lookaheadIteratorLanguage lookaheadIterator = + withLookaheadIteratorAsTSLookaheadIteratorPtr lookaheadIterator $ + unsafeToLanguage <=< coerce C.ts_lookahead_iterator_language + +-- | See @`C.ts_lookahead_iterator_next`@. +lookaheadIteratorNext :: LookaheadIterator -> IO Bool +lookaheadIteratorNext lookaheadIterator = + withLookaheadIteratorAsTSLookaheadIteratorPtr lookaheadIterator $ \lookaheadIteratorPtr -> + toBool @CBool <$> coerce C.ts_lookahead_iterator_next lookaheadIteratorPtr + +-- | See @`C.ts_lookahead_iterator_current_symbol`@. +lookaheadIteratorCurrentSymbol :: LookaheadIterator -> IO Symbol +lookaheadIteratorCurrentSymbol lookaheadIterator = + withLookaheadIteratorAsTSLookaheadIteratorPtr lookaheadIterator $ \lookaheadIteratorPtr -> + coerce C.ts_lookahead_iterator_current_symbol lookaheadIteratorPtr + +-- | See @`C.ts_lookahead_iterator_current_symbol_name`@. +lookaheadIteratorCurrentSymbolName :: LookaheadIterator -> IO ByteString +lookaheadIteratorCurrentSymbolName lookaheadIterator = + withLookaheadIteratorAsTSLookaheadIteratorPtr lookaheadIterator $ + BSU.unsafePackCString <=< coerce C.ts_lookahead_iterator_current_symbol_name + +-- * Global Configuration + +-- -- | See @`C.ts_set_allocator`@. +-- setAllocator :: FunPtr (CSize -> IO ()) -> FunPtr (CSize -> CSize -> IO ()) -> FunPtr (Ptr a -> CSize -> IO ()) -> FunPtr (Ptr a -> IO ()) -> IO () +-- setAllocator = undefined -- C.ts_set_allocator diff --git a/src-internal/TreeSitter/Internal/ST.hs b/src-internal/TreeSitter/Internal/ST.hs new file mode 100644 --- /dev/null +++ b/src-internal/TreeSitter/Internal/ST.hs @@ -0,0 +1,504 @@ +{-# LANGUAGE RoleAnnotations #-} + +module TreeSitter.Internal.ST ( + -- * Types + FieldId (..), + FieldName (..), + GrammarType (..), + InputEdit (..), + Point (..), + StateId (..), + Symbol (..), + SymbolType (..), + Language, + Node, + TreeCursor, + + -- * Tree + treeRootNode, + treeRootNodeWithOffset, + + -- * Node + nodeType, + nodeTypeAsString, + nodeSymbol, + nodeLanguage, + nodeGrammarType, + nodeGrammarTypeAsString, + nodeGrammarSymbol, + nodeStartByte, + nodeStartPoint, + nodeEndByte, + nodeEndPoint, + showNode, + showNodeAsString, + nodeIsNull, + nodeIsNamed, + nodeIsMissing, + nodeIsExtra, + nodeHasChanges, + nodeHasError, + nodeIsError, + nodeParseState, + nodeNextParseState, + nodeParent, + nodeChildWithDescendant, + nodeChild, + nodeFieldNameForChild, + nodeFieldNameForChildAsString, + nodeFieldNameForNamedChild, + nodeFieldNameForNamedChildAsString, + nodeChildCount, + nodeNamedChild, + nodeNamedChildCount, + nodeChildByFieldName, + nodeChildByFieldId, + nodeNextSibling, + nodePrevSibling, + nodeNextNamedSibling, + nodePrevNamedSibling, + nodeFirstChildForByte, + nodeFirstNamedChildForByte, + nodeDescendantCount, + nodeDescendantForByteRange, + nodeDescendantForPointRange, + nodeNamedDescendantForByteRange, + nodeNamedDescendantForPointRange, + nodeEdit, + nodeEq, + + -- * TreeCursor + treeCursorNew, + treeCursorReset, + treeCursorResetTo, + treeCursorCurrentNode, + treeCursorCurrentFieldName, + treeCursorCurrentFieldId, + treeCursorGotoParent, + treeCursorGotoNextSibling, + treeCursorGotoPreviousSibling, + treeCursorGotoFirstChild, + treeCursorGotoLastChild, + treeCursorGotoDescendant, + treeCursorCurrentDescendantIndex, + treeCursorCurrentDepth, + treeCursorGotoFirstChildForByte, + treeCursorGotoFirstChildForPoint, + treeCursorCopy, + + -- * Language + languageCopy, + languageSymbolCount, + languageStateCount, + languageSymbolName, + languageSymbolForGrammarType, + languageFieldCount, + languageFieldNameForId, + languageFieldIdForName, + languageSymbolType, + languageVersion, + languageNextState, +) where + +import Control.Monad.ST (ST) +import Control.Monad.ST.Unsafe (unsafeIOToST) +import Data.ByteString (ByteString) +import Data.Coerce (coerce) +import Data.Int (Int64) +import Data.Word (Word32) +import TreeSitter.Internal ( + FieldId (..), + FieldName (..), + GrammarType (..), + InputEdit (..), + Point (..), + StateId (..), + Symbol (..), + SymbolType (..), + ) +import TreeSitter.Internal qualified as TSIO + +-------------------------------------------------------------------------------- + +{-# ANN module ("HLint: ignore Redundant lambda" :: String) #-} + +-------------------------------------------------------------------------------- + +-- * Types + +newtype Language s = WrapIOLanguage TSIO.Language + +type role Language nominal + +newtype Node s = WrapIONode TSIO.Node + +type role Node nominal + +newtype TreeCursor s = WrapIOTreeCursor TSIO.TreeCursor + +type role TreeCursor nominal + +-- * Tree + +-- | See @`TSIO.treeRootNode`@. +treeRootNode :: TSIO.Tree -> ST s (Node s) +treeRootNode = unsafeIOToST . coerce . TSIO.treeRootNode +{-# INLINE treeRootNode #-} + +-- | See @`TSIO.treeRootNodeWithOffset`@. +treeRootNodeWithOffset :: TSIO.Tree -> Word32 -> TSIO.Point -> ST s (Node s) +treeRootNodeWithOffset = ((unsafeIOToST .) .) . coerce TSIO.treeRootNodeWithOffset +{-# INLINE treeRootNodeWithOffset #-} + +-- * Node + +-- | See @`TSIO.nodeType`@. +nodeType :: Node s -> ST s ByteString +nodeType = unsafeIOToST . coerce TSIO.nodeType +{-# INLINE nodeType #-} + +-- -- | See @`TSIO.nodeType`@. +nodeTypeAsString :: Node s -> ST s String +nodeTypeAsString = unsafeIOToST . coerce TSIO.nodeTypeAsString +{-# INLINE nodeTypeAsString #-} + +-- | See @`TSIO.nodeSymbol`@. +nodeSymbol :: Node s -> ST s TSIO.Symbol +nodeSymbol = unsafeIOToST . coerce TSIO.nodeSymbol +{-# INLINE nodeSymbol #-} + +-- | See @`TSIO.nodeLanguage`@. +nodeLanguage :: Node s -> ST s TSIO.Language +nodeLanguage = unsafeIOToST . coerce TSIO.nodeLanguage +{-# INLINE nodeLanguage #-} + +-- | See @`TSIO.nodeGrammarType`@. +nodeGrammarType :: Node s -> ST s GrammarType +nodeGrammarType = unsafeIOToST . coerce TSIO.nodeGrammarType +{-# INLINE nodeGrammarType #-} + +-- | See @`TSIO.nodeGrammarType`@. +nodeGrammarTypeAsString :: Node s -> ST s String +nodeGrammarTypeAsString = unsafeIOToST . coerce TSIO.nodeGrammarTypeAsString +{-# INLINE nodeGrammarTypeAsString #-} + +-- | See @`TSIO.nodeGrammarSymbol`@. +nodeGrammarSymbol :: Node s -> ST s Symbol +nodeGrammarSymbol = unsafeIOToST . coerce TSIO.nodeGrammarSymbol +{-# INLINE nodeGrammarSymbol #-} + +-- | See @`TSIO.nodeStartByte`@. +nodeStartByte :: Node s -> ST s Word32 +nodeStartByte = unsafeIOToST . coerce TSIO.nodeStartByte +{-# INLINE nodeStartByte #-} + +-- | See @`TSIO.nodeStartPoint`@. +nodeStartPoint :: Node s -> ST s Point +nodeStartPoint = unsafeIOToST . coerce TSIO.nodeStartPoint +{-# INLINE nodeStartPoint #-} + +-- | See @`TSIO.nodeEndByte`@. +nodeEndByte :: Node s -> ST s Word32 +nodeEndByte = unsafeIOToST . coerce TSIO.nodeEndByte +{-# INLINE nodeEndByte #-} + +-- | See @`TSIO.nodeEndPoint`@. +nodeEndPoint :: Node s -> ST s Point +nodeEndPoint = unsafeIOToST . coerce TSIO.nodeEndPoint +{-# INLINE nodeEndPoint #-} + +-- | See @`TSIO.nodeString`@. +showNode :: Node s -> ST s ByteString +showNode = unsafeIOToST . coerce TSIO.showNode +{-# INLINE showNode #-} + +-- | See @`TSIO.nodeString`@. +showNodeAsString :: Node s -> ST s String +showNodeAsString = unsafeIOToST . coerce TSIO.showNodeAsString +{-# INLINE showNodeAsString #-} + +-- | See @`TSIO.nodeIsNull`@. +nodeIsNull :: Node s -> ST s Bool +nodeIsNull = unsafeIOToST . coerce TSIO.nodeIsNull +{-# INLINE nodeIsNull #-} + +-- | See @`TSIO.nodeIsNamed`@. +nodeIsNamed :: Node s -> ST s Bool +nodeIsNamed = unsafeIOToST . coerce TSIO.nodeIsNamed +{-# INLINE nodeIsNamed #-} + +-- | See @`TSIO.nodeIsMissing`@. +nodeIsMissing :: Node s -> ST s Bool +nodeIsMissing = unsafeIOToST . coerce TSIO.nodeIsMissing +{-# INLINE nodeIsMissing #-} + +-- | See @`TSIO.nodeIsExtra`@. +nodeIsExtra :: Node s -> ST s Bool +nodeIsExtra = unsafeIOToST . coerce TSIO.nodeIsExtra +{-# INLINE nodeIsExtra #-} + +-- | See @`TSIO.nodeHasChanges`@. +nodeHasChanges :: Node s -> ST s Bool +nodeHasChanges = unsafeIOToST . coerce TSIO.nodeHasChanges +{-# INLINE nodeHasChanges #-} + +-- | See @`TSIO.nodeHasError`@. +nodeHasError :: Node s -> ST s Bool +nodeHasError = unsafeIOToST . coerce TSIO.nodeHasError +{-# INLINE nodeHasError #-} + +-- | See @`TSIO.nodeIsError`@. +nodeIsError :: Node s -> ST s Bool +nodeIsError = unsafeIOToST . coerce TSIO.nodeIsError +{-# INLINE nodeIsError #-} + +-- | See @`TSIO.nodeParseState`@. +nodeParseState :: Node s -> ST s StateId +nodeParseState = unsafeIOToST . coerce TSIO.nodeParseState +{-# INLINE nodeParseState #-} + +-- | See @`TSIO.nodeNextParseState`@. +nodeNextParseState :: Node s -> ST s StateId +nodeNextParseState = unsafeIOToST . coerce TSIO.nodeNextParseState +{-# INLINE nodeNextParseState #-} + +-- | See @`TSIO.nodeParent`@. +nodeParent :: Node s -> ST s (Node s) +nodeParent = unsafeIOToST . coerce TSIO.nodeParent +{-# INLINE nodeParent #-} + +-- | See @`TSIO.nodeChildWithDescen[dant`@. +nodeChildWithDescendant :: Node s -> Node s -> ST s (Node s) +nodeChildWithDescendant = (unsafeIOToST .) . coerce TSIO.nodeChildWithDescendant +{-# INLINE nodeChildWithDescendant #-} + +-- | See @`TSIO.nodeChild`@. +nodeChild :: Node s -> Word32 -> ST s (Node s) +nodeChild = (unsafeIOToST .) . coerce TSIO.nodeChild +{-# INLINE nodeChild #-} + +-- | See @`TSIO.nodeFieldNameForChild`@. +nodeFieldNameForChild :: Node s -> Word32 -> ST s FieldName +nodeFieldNameForChild = (unsafeIOToST .) . coerce TSIO.nodeFieldNameForChild +{-# INLINE nodeFieldNameForChild #-} + +-- | See @`TSIO.nodeFieldNameForChild`@. +nodeFieldNameForChildAsString :: Node s -> Word32 -> ST s String +nodeFieldNameForChildAsString = (unsafeIOToST .) . coerce TSIO.nodeFieldNameForChildAsString +{-# INLINE nodeFieldNameForChildAsString #-} + +-- | See @`TSIO.nodeFieldNameForNamedChild`@. +nodeFieldNameForNamedChild :: Node s -> Word32 -> ST s FieldName +nodeFieldNameForNamedChild = (unsafeIOToST .) . coerce TSIO.nodeFieldNameForNamedChild +{-# INLINE nodeFieldNameForNamedChild #-} + +-- | See @`TSIO.nodeFieldNameForNamedChild`@. +nodeFieldNameForNamedChildAsString :: Node s -> Word32 -> ST s String +nodeFieldNameForNamedChildAsString = (unsafeIOToST .) . coerce TSIO.nodeFieldNameForNamedChildAsString +{-# INLINE nodeFieldNameForNamedChildAsString #-} + +-- | See @`TSIO.nodeChildCount`@. +nodeChildCount :: Node s -> ST s Word32 +nodeChildCount = unsafeIOToST . coerce TSIO.nodeChildCount +{-# INLINE nodeChildCount #-} + +-- | See @`TSIO.nodeNamedChild`@. +nodeNamedChild :: Node s -> Word32 -> ST s (Node s) +nodeNamedChild = (unsafeIOToST .) . coerce TSIO.nodeNamedChild +{-# INLINE nodeNamedChild #-} + +-- | See @`TSIO.nodeNamedChildCount`@. +nodeNamedChildCount :: Node s -> ST s Word32 +nodeNamedChildCount = unsafeIOToST . coerce TSIO.nodeNamedChildCount +{-# INLINE nodeNamedChildCount #-} + +-- | See @`TSIO.nodeChildByFieldName`@. +nodeChildByFieldName :: Node s -> FieldName -> ST s (Node s) +nodeChildByFieldName = (unsafeIOToST .) . coerce TSIO.nodeChildByFieldName +{-# INLINE nodeChildByFieldName #-} + +-- | See @`TSIO.nodeChildByFieldId`@. +nodeChildByFieldId :: Node s -> FieldId -> ST s (Node s) +nodeChildByFieldId = (unsafeIOToST .) . coerce TSIO.nodeChildByFieldId +{-# INLINE nodeChildByFieldId #-} + +-- | See @`TSIO.nodeNextSibling`@. +nodeNextSibling :: Node s -> ST s (Node s) +nodeNextSibling = unsafeIOToST . coerce TSIO.nodeNextSibling +{-# INLINE nodeNextSibling #-} + +-- | See @`TSIO.nodePrevSibling`@. +nodePrevSibling :: Node s -> ST s (Node s) +nodePrevSibling = unsafeIOToST . coerce TSIO.nodePrevSibling +{-# INLINE nodePrevSibling #-} + +-- | See @`TSIO.nodeNextNamedSibling`@. +nodeNextNamedSibling :: Node s -> ST s (Node s) +nodeNextNamedSibling = unsafeIOToST . coerce TSIO.nodeNextNamedSibling +{-# INLINE nodeNextNamedSibling #-} + +-- | See @`TSIO.nodePrevNamedSibling`@. +nodePrevNamedSibling :: Node s -> ST s (Node s) +nodePrevNamedSibling = unsafeIOToST . coerce TSIO.nodePrevNamedSibling +{-# INLINE nodePrevNamedSibling #-} + +-- | See @`TSIO.nodeFirstChildForByte`@. +nodeFirstChildForByte :: Node s -> Word32 -> ST s (Node s) +nodeFirstChildForByte = (unsafeIOToST .) . coerce TSIO.nodeFirstChildForByte +{-# INLINE nodeFirstChildForByte #-} + +-- | See @`TSIO.nodeFirstNamedChildForByte`@. +nodeFirstNamedChildForByte :: Node s -> Word32 -> ST s (Node s) +nodeFirstNamedChildForByte = (unsafeIOToST .) . coerce TSIO.nodeFirstNamedChildForByte +{-# INLINE nodeFirstNamedChildForByte #-} + +-- | See @`TSIO.nodeDescendantCount`@. +nodeDescendantCount :: Node s -> ST s Word32 +nodeDescendantCount = unsafeIOToST . coerce TSIO.nodeDescendantCount +{-# INLINE nodeDescendantCount #-} + +-- | See @`TSIO.nodeDescendantForByteRange`@. +nodeDescendantForByteRange :: Node s -> Word32 -> Word32 -> ST s (Node s) +nodeDescendantForByteRange = ((unsafeIOToST .) .) . coerce TSIO.nodeDescendantForByteRange +{-# INLINE nodeDescendantForByteRange #-} + +-- | See @`TSIO.nodeDescendantForPointRange`@. +nodeDescendantForPointRange :: Node s -> Point -> Point -> ST s (Node s) +nodeDescendantForPointRange = ((unsafeIOToST .) .) . coerce TSIO.nodeDescendantForPointRange +{-# INLINE nodeDescendantForPointRange #-} + +-- | See @`TSIO.nodeNamedDescendantForByteRange`@. +nodeNamedDescendantForByteRange :: Node s -> Word32 -> Word32 -> ST s (Node s) +nodeNamedDescendantForByteRange = ((unsafeIOToST .) .) . coerce TSIO.nodeNamedDescendantForByteRange +{-# INLINE nodeNamedDescendantForByteRange #-} + +-- | See @`TSIO.nodeNamedDescendantForPointRange`@. +nodeNamedDescendantForPointRange :: Node s -> Point -> Point -> ST s (Node s) +nodeNamedDescendantForPointRange = ((unsafeIOToST .) .) . coerce TSIO.nodeNamedDescendantForPointRange +{-# INLINE nodeNamedDescendantForPointRange #-} + +-- | See @`TSIO.nodeEdit`@. +nodeEdit :: Node s -> InputEdit -> ST s () +nodeEdit = (unsafeIOToST .) . coerce TSIO.nodeEdit +{-# INLINE nodeEdit #-} + +-- | See @`TSIO.nodeEq`@. +nodeEq :: Node s -> Node s -> ST s Bool +nodeEq = (unsafeIOToST .) . coerce TSIO.nodeEq +{-# INLINE nodeEq #-} + +-- * TreeCursor + +-- | See @`TSIO.treeCursorNew`@. +treeCursorNew :: Node s -> ST s (TreeCursor s) +treeCursorNew = unsafeIOToST . coerce TSIO.treeCursorNew + +-- | See @`TSIO.treeCursorReset`@. +treeCursorReset :: TreeCursor s -> Node s -> ST s () +treeCursorReset = (unsafeIOToST .) . coerce TSIO.treeCursorReset + +-- | See @`TSIO.treeCursorResetTo`@. +treeCursorResetTo :: TreeCursor s -> TreeCursor s -> ST s () +treeCursorResetTo = (unsafeIOToST .) . coerce TSIO.treeCursorResetTo + +-- | See @`TSIO.treeCursorCurrentNode`@. +treeCursorCurrentNode :: TreeCursor s -> ST s (Node s) +treeCursorCurrentNode = unsafeIOToST . coerce TSIO.treeCursorCurrentNode + +-- | See @`TSIO.treeCursorCurrentFieldName`@. +treeCursorCurrentFieldName :: TreeCursor s -> ST s (Maybe FieldName) +treeCursorCurrentFieldName = unsafeIOToST . coerce TSIO.treeCursorCurrentFieldName + +-- | See @`TSIO.treeCursorCurrentFieldId`@. +treeCursorCurrentFieldId :: TreeCursor s -> ST s (Maybe FieldId) +treeCursorCurrentFieldId = unsafeIOToST . coerce TSIO.treeCursorCurrentFieldId + +-- | See @`TSIO.treeCursorGotoParent`@. +treeCursorGotoParent :: TreeCursor s -> ST s Bool +treeCursorGotoParent = unsafeIOToST . coerce TSIO.treeCursorGotoParent + +-- | See @`TSIO.treeCursorGotoNextSibling`@. +treeCursorGotoNextSibling :: TreeCursor s -> ST s Bool +treeCursorGotoNextSibling = unsafeIOToST . coerce TSIO.treeCursorGotoNextSibling + +-- | See @`TSIO.treeCursorGotoPreviousSibling`@. +treeCursorGotoPreviousSibling :: TreeCursor s -> ST s Bool +treeCursorGotoPreviousSibling = unsafeIOToST . coerce TSIO.treeCursorGotoPreviousSibling + +-- | See @`TSIO.treeCursorGotoFirstChild`@. +treeCursorGotoFirstChild :: TreeCursor s -> ST s Bool +treeCursorGotoFirstChild = unsafeIOToST . coerce TSIO.treeCursorGotoFirstChild + +-- | See @`TSIO.treeCursorGotoLastChild`@. +treeCursorGotoLastChild :: TreeCursor s -> ST s Bool +treeCursorGotoLastChild = unsafeIOToST . coerce TSIO.treeCursorGotoLastChild + +-- | See @`TSIO.treeCursorGotoDescendant`@. +treeCursorGotoDescendant :: TreeCursor s -> Word32 -> ST s () +treeCursorGotoDescendant = (unsafeIOToST .) . coerce TSIO.treeCursorGotoDescendant + +-- | See @`TSIO.treeCursorCurrentDescendantIndex`@. +treeCursorCurrentDescendantIndex :: TreeCursor s -> ST s Word32 +treeCursorCurrentDescendantIndex = unsafeIOToST . coerce TSIO.treeCursorCurrentDescendantIndex + +-- | See @`TSIO.treeCursorCurrentDepth`@. +treeCursorCurrentDepth :: TreeCursor s -> ST s Word32 +treeCursorCurrentDepth = unsafeIOToST . coerce TSIO.treeCursorCurrentDepth + +-- | See @`TSIO.treeCursorGotoFirstChildForByte`@. +treeCursorGotoFirstChildForByte :: TreeCursor s -> Word32 -> ST s Int64 +treeCursorGotoFirstChildForByte = (unsafeIOToST .) . coerce TSIO.treeCursorGotoFirstChildForByte + +-- | See @`TSIO.treeCursorGotoFirstChildForPoint`@. +treeCursorGotoFirstChildForPoint :: TreeCursor s -> Point -> ST s Int64 +treeCursorGotoFirstChildForPoint = (unsafeIOToST .) . coerce TSIO.treeCursorGotoFirstChildForPoint + +-- | See @`TSIO.treeCursorCopy`@. +treeCursorCopy :: TreeCursor s -> ST s (TreeCursor s) +treeCursorCopy = unsafeIOToST . coerce TSIO.treeCursorCopy + +-- * Language + +-- | See @`C.ts_language_copy`@. +languageCopy :: Language s -> ST s (Language s) +languageCopy = unsafeIOToST . coerce TSIO.languageCopy + +-- | See @`C.ts_language_symbol_count`@. +languageSymbolCount :: Language s -> ST s Word32 +languageSymbolCount = unsafeIOToST . coerce TSIO.languageSymbolCount + +-- | See @`C.ts_language_state_count`@. +languageStateCount :: Language s -> ST s Word32 +languageStateCount = unsafeIOToST . coerce TSIO.languageStateCount + +-- | See @`C.ts_language_symbol_name`@. +languageSymbolName :: Language s -> Symbol -> ST s ByteString +languageSymbolName = (unsafeIOToST .) . coerce TSIO.languageSymbolName + +-- | See @`C.ts_language_symbol_for_name`@. +languageSymbolForGrammarType :: Language s -> ByteString -> Bool -> ST s Symbol +languageSymbolForGrammarType = ((unsafeIOToST .) .) . coerce TSIO.languageSymbolForGrammarType + +-- | See @`C.ts_language_field_count`@. +languageFieldCount :: Language s -> ST s Word32 +languageFieldCount = unsafeIOToST . coerce TSIO.languageFieldCount + +-- | See @`C.ts_language_field_name_for_id`@. +languageFieldNameForId :: Language s -> FieldId -> ST s ByteString +languageFieldNameForId = (unsafeIOToST .) . coerce TSIO.languageFieldNameForId + +-- | See @`C.ts_language_field_id_for_name`@. +languageFieldIdForName :: Language s -> ByteString -> ST s FieldId +languageFieldIdForName = (unsafeIOToST .) . coerce TSIO.languageFieldIdForName + +-- | See @`C.ts_language_symbol_type`@. +languageSymbolType :: Language s -> Symbol -> ST s SymbolType +languageSymbolType = (unsafeIOToST .) . coerce TSIO.languageSymbolType + +-- | See @`C.ts_language_version`@. +languageVersion :: Language s -> ST s Word32 +languageVersion = unsafeIOToST . coerce TSIO.languageVersion + +-- | See @`C.ts_language_next_state`@. +languageNextState :: Language s -> StateId -> Symbol -> ST s StateId +languageNextState = ((unsafeIOToST .) .) . coerce TSIO.languageNextState diff --git a/src/TreeSitter.hs b/src/TreeSitter.hs new file mode 100644 --- /dev/null +++ b/src/TreeSitter.hs @@ -0,0 +1,217 @@ +{-# LANGUAGE RankNTypes #-} + +module TreeSitter ( + -- * ABI Versioning + TREE_SITTER_LANGUAGE_VERSION, + TREE_SITTER_MIN_COMPATIBLE_LANGUAGE_VERSION, + + -- * Types + Symbol (..), + StateId (..), + GrammarType (..), + FieldId (..), + FieldName (..), + CaptureName (..), + CaptureIndex (..), + PatternIndex (..), + Language, + Parser, + Tree, + Query, + QueryCursor, + LookaheadIterator, + InputEncoding (InputEncodingUTF8, InputEncodingUTF16), + SymbolType (SymbolTypeRegular, SymbolTypeAnonymous, SymbolTypeSupertype, SymbolTypeAuxiliary), + Point (Point, pointColumn, pointRow), + Range (Range, rangeStartPoint, rangeEndPoint, rangeStartByte, rangeEndByte), + Input, + LogType (LogTypeLex, LogTypeParse), + InputEdit (InputEdit, inputEditStartByte, inputEditOldEndByte, inputEditNewEndByte, inputEditStartPoint, inputEditOldEndPoint, inputEditNewEndPoint), + Node, + NodeId (..), + nodeId, + TreeCursor, + TreeCursorId (..), + QueryCapture, + Quantifier, + QueryMatch, + QueryPredicateStepType, + QueryPredicateStep, + QueryErrorType (QueryErrorTypeSyntax, QueryErrorTypeNodeType, QueryErrorTypeField, QueryErrorTypeCapture, QueryErrorTypeStructure, QueryErrorTypeLanguage), + QueryError (..), + + -- * Parser + parserNew, + unsafeParserDelete, + withParser, + parserSetLanguage, + parserLanguage, + parserSetIncludedRanges, + parserIncludedRanges, + parserSetLogger, + parserLogger, + parserHasLogger, + parserRemoveLogger, + parserParse, + parserParseString, + parserParseByteString, + parserParseByteStringWithEncoding, + parserReset, + Microsecond (..), + parserSetTimeoutMicros, + parserTimeoutMicros, + CancellationFlag (Cancel, Continue), + CancellationFlagRef, + getCancellationFlag, + putCancellationFlag, + parserSetCancellationFlag, + parserCancellationFlag, + parserPrintDotGraphs, + + -- * Tree + treeCopy, + unsafeTreeDelete, + treeRootNode, + treeRootNodeWithOffset, + treeLanguage, + treeIncludedRanges, + treeEdit, + treeGetChangedRanges, + treePrintDotGraph, + + -- * Node + nodeType, + nodeTypeAsString, + nodeSymbol, + nodeLanguage, + nodeGrammarType, + nodeGrammarTypeAsString, + nodeGrammarSymbol, + nodeRange, + nodeStartByte, + nodeStartPoint, + nodeEndByte, + nodeEndPoint, + showNode, + showNodeAsString, + nodeIsNull, + nodeIsNamed, + nodeIsMissing, + nodeIsExtra, + nodeHasChanges, + nodeHasError, + nodeIsError, + nodeParseState, + nodeNextParseState, + nodeParent, + nodeChildWithDescendant, + nodeChild, + nodeFieldNameForChild, + nodeFieldNameForChildAsString, + nodeFieldNameForNamedChild, + nodeFieldNameForNamedChildAsString, + nodeChildCount, + nodeNamedChild, + nodeNamedChildCount, + nodeChildByFieldName, + nodeChildByFieldId, + nodeNextSibling, + nodePrevSibling, + nodeNextNamedSibling, + nodePrevNamedSibling, + nodeFirstChildForByte, + nodeFirstNamedChildForByte, + nodeDescendantCount, + nodeDescendantForByteRange, + nodeDescendantForPointRange, + nodeNamedDescendantForByteRange, + nodeNamedDescendantForPointRange, + nodeEdit, + nodeEq, + + -- * TreeCursor + treeCursorNew, + unsafeTreeCursorDelete, + treeCursorReset, + treeCursorResetTo, + treeCursorCurrentNode, + treeCursorCurrentFieldName, + treeCursorCurrentFieldId, + treeCursorGotoParent, + treeCursorGotoNextSibling, + treeCursorGotoPreviousSibling, + treeCursorGotoFirstChild, + treeCursorGotoLastChild, + treeCursorGotoDescendant, + treeCursorCurrentDescendantIndex, + treeCursorCurrentDepth, + treeCursorGotoFirstChildForByte, + treeCursorGotoFirstChildForPoint, + treeCursorCopy, + + -- * Query + queryNew, + unsafeQueryDelete, + queryPatternCount, + queryCaptureCount, + queryStringCount, + queryStartByteForPattern, + queryEndByteForPattern, + queryPredicatesForPattern, + queryIsPatternRooted, + queryIsPatternNonLocal, + queryIsPatternGuaranteedAtStep, + queryCaptureNameForIndex, + queryCaptureQuantifierForIndex, + queryStringValueForIndex, + queryDisableCapture, + queryDisablePattern, + queryCursorNew, + unsafeQueryCursorDelete, + queryCursorExec, + queryCursorDidExceedMatchLimit, + queryCursorMatchLimit, + queryCursorSetMatchLimit, + queryCursorSetTimeoutMicros, + queryCursorTimeoutMicros, + queryCursorSetByteRange, + queryCursorSetPointRange, + queryCursorNextMatch, + queryCursorRemoveMatch, + queryCursorNextCapture, + queryCursorSetMaxStartDepth, + + -- * Language + unsafeToLanguage, + unsafeLanguageDelete, + languageCopy, + languageSymbolCount, + languageStateCount, + languageSymbolName, + languageSymbolForGrammarType, + languageFieldCount, + languageFieldNameForId, + languageFieldIdForName, + languageSymbolType, + languageVersion, + languageNextState, + + -- * Lookahead Iterator + withLookaheadIteratorAsTSLookaheadIteratorPtr, + lookaheadIteratorNew, + unsafeLookaheadIteratorDelete, + lookaheadIteratorResetState, + lookaheadIteratorReset, + lookaheadIteratorLanguage, + lookaheadIteratorNext, + lookaheadIteratorCurrentSymbol, + lookaheadIteratorCurrentSymbolName, +) where + +import TreeSitter.Internal + +-------------------------------------------------------------------------------- + +{-# ANN module "HLint: ignore TreeSitter.Internal should be imported post-qualified or with an explicit import list" #-} + +--------------------------------------------------------------------------------