{-# LINE 1 "src/TreeSitter/CApi.hsc" #-}
{-# LANGUAGE CApiFFI #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}

module TreeSitter.CApi
  ( -- * ABI Versioning
    TREE_SITTER_LANGUAGE_VERSION
  , TREE_SITTER_MIN_COMPATIBLE_LANGUAGE_VERSION

    -- * Types
  , TSStateId (..)
  , TSSymbol (..)
  , TSFieldId (..)
  , TSLanguage
  , TSParser
  , TSTree
  , TSQuery
  , TSQueryCursor
  , TSLookaheadIterator
  , TSInputEncoding (TSInputEncodingUTF8, TSInputEncodingUTF16, ..)
  , TSSymbolType (TSSymbolTypeRegular, TSSymbolTypeAnonymous, TSSymbolTypeSupertype, TSSymbolTypeAuxiliary, ..)
  , TSPoint (..)
  , TSRange (..)
  , TSInput
  , TSRead
  , TSLogType (TSLogTypeParse, TSLogTypeLex, ..)
  , TSLogger
  , TSLog
  , TSInputEdit (..)
  , TSNode (..)
  , TSNodeContext (..)
  , TSTreeCursor (..)
  , TSTreeCursorContext (..)
  , TSQueryCapture (..)
  , TSQuantifier (TSQuantifierZero, TSQuantifierZeroOrOne, TSQuantifierZeroOrMore, TSQuantifierOne, TSQuantifierOneOrMore, ..)
  , TSQueryMatch (..)
  , TSQueryPredicateStepType (TSQueryPredicateStepTypeDone, TSQueryPredicateStepTypeCapture, TSQueryPredicateStepTypeString, ..)
  , TSQueryPredicateStep (..)
  , TSQueryError (TSQueryErrorNone, TSQueryErrorSyntax, TSQueryErrorNodeType, TSQueryErrorField, TSQueryErrorCapture, TSQueryErrorStructure, TSQueryErrorLanguage, ..)

    -- * Parser
  , ts_parser_new
  , ts_parser_delete
  , p_ts_parser_delete
  , ts_parser_language
  , ts_parser_set_language
  , ts_parser_set_included_ranges
  , ts_parser_included_ranges
  , ts_parser_set_logger
  , ts_parser_logger
  , ts_parser_remove_logger
  , ts_parser_parse
  , ts_parser_parse_string
  , ts_parser_parse_string_encoding
  , ts_parser_reset
  , ts_parser_set_timeout_micros
  , ts_parser_timeout_micros
  , ts_parser_set_cancellation_flag
  , ts_parser_cancellation_flag
  , ts_parser_print_dot_graphs

    -- * Tree
  , ts_tree_copy
  , ts_tree_delete
  , p_ts_tree_delete
  , ts_tree_language
  , ts_tree_included_ranges
  , ts_tree_edit
  , ts_tree_get_changed_ranges
  , ts_tree_print_dot_graph
  , ts_tree_root_node
  , ts_tree_root_node_with_offset

    -- * Node
  , ts_node_type
  , ts_node_symbol
  , ts_node_language
  , ts_node_grammar_type
  , ts_node_grammar_symbol
  , ts_node_start_byte
  , ts_node_start_point
  , ts_node_end_byte
  , ts_node_end_point
  , ts_node_string
  , ts_node_is_null
  , ts_node_is_named
  , ts_node_is_missing
  , ts_node_is_extra
  , ts_node_has_changes
  , ts_node_has_error
  , ts_node_is_error
  , ts_node_parse_state
  , ts_node_next_parse_state
  , ts_node_parent
  , ts_node_child_with_descendant
  , ts_node_child
  , ts_node_field_name_for_child
  , ts_node_field_name_for_named_child
  , ts_node_child_count
  , ts_node_named_child
  , ts_node_named_child_count
  , ts_node_child_by_field_name
  , ts_node_child_by_field_id
  , ts_node_next_sibling
  , ts_node_prev_sibling
  , ts_node_next_named_sibling
  , ts_node_prev_named_sibling
  , ts_node_first_child_for_byte
  , ts_node_first_named_child_for_byte
  , ts_node_descendant_count
  , ts_node_descendant_for_byte_range
  , ts_node_descendant_for_point_range
  , ts_node_named_descendant_for_byte_range
  , ts_node_named_descendant_for_point_range
  , ts_node_edit
  , ts_node_eq

    -- * TreeCursor
  , ts_tree_cursor_new
  , ts_tree_cursor_new_p
  , ts_tree_cursor_delete
  , p_ts_tree_cursor_delete
  , ts_tree_cursor_reset
  , ts_tree_cursor_reset_to
  , ts_tree_cursor_current_node
  , ts_tree_cursor_current_field_name
  , ts_tree_cursor_current_field_id
  , ts_tree_cursor_goto_parent
  , ts_tree_cursor_goto_next_sibling
  , ts_tree_cursor_goto_previous_sibling
  , ts_tree_cursor_goto_first_child
  , ts_tree_cursor_goto_last_child
  , ts_tree_cursor_goto_descendant
  , ts_tree_cursor_current_descendant_index
  , ts_tree_cursor_current_depth
  , ts_tree_cursor_goto_first_child_for_byte
  , ts_tree_cursor_goto_first_child_for_point
  , ts_tree_cursor_copy
  , ts_tree_cursor_copy_p

    -- * Query
  , ts_query_new
  , ts_query_delete
  , p_ts_query_delete
  , ts_query_pattern_count
  , ts_query_capture_count
  , ts_query_string_count
  , ts_query_start_byte_for_pattern
  , ts_query_end_byte_for_pattern
  , ts_query_predicates_for_pattern
  , ts_query_is_pattern_rooted
  , ts_query_is_pattern_non_local
  , ts_query_is_pattern_guaranteed_at_step
  , ts_query_capture_name_for_id
  , ts_query_capture_quantifier_for_id
  , ts_query_string_value_for_id
  , ts_query_disable_capture
  , ts_query_disable_pattern
  , ts_query_cursor_new
  , ts_query_cursor_delete
  , p_ts_query_cursor_delete
  , ts_query_cursor_exec
  , ts_query_cursor_did_exceed_match_limit
  , ts_query_cursor_match_limit
  , ts_query_cursor_set_match_limit
  , ts_query_cursor_set_timeout_micros
  , ts_query_cursor_timeout_micros
  , ts_query_cursor_set_byte_range
  , ts_query_cursor_set_point_range
  , ts_query_cursor_next_match
  , ts_query_cursor_remove_match
  , ts_query_cursor_next_capture
  , ts_query_cursor_set_max_start_depth

    -- * Language
  , ts_language_copy
  , ts_language_delete
  , p_ts_language_delete
  , ts_language_symbol_count
  , ts_language_state_count
  , ts_language_symbol_name
  , ts_language_symbol_for_name
  , ts_language_field_count
  , ts_language_field_name_for_id
  , ts_language_field_id_for_name
  , ts_language_symbol_type
  , ts_language_version
  , ts_language_next_state

    -- * Lookahead Iterator
  , ts_lookahead_iterator_new
  , ts_lookahead_iterator_delete
  , p_ts_lookahead_iterator_delete
  , ts_lookahead_iterator_reset_state
  , ts_lookahead_iterator_reset
  , ts_lookahead_iterator_language
  , ts_lookahead_iterator_next
  , ts_lookahead_iterator_current_symbol
  , ts_lookahead_iterator_current_symbol_name


{-# LINE 228 "src/TreeSitter/CApi.hsc" #-}

    -- * Global Configuration
  , ts_set_allocator
  ) where

import Control.Exception (bracket, mask_)

{-# LINE 238 "src/TreeSitter/CApi.hsc" #-}
import Data.Void (Void)
import Data.Word
import Foreign
import Foreign.C
import Foreign.C.ConstPtr.Compat (ConstPtr(..))
import GHC.TypeLits (Nat)


-- string.h: required for memcpy


{----------------------------}
{- Section - ABI Versioning -}
{----------------------------}

{-|
  The latest ABI version that is supported by the current version of the
  library. When Languages are generated by the Tree-sitter CLI, they are
  assigned an ABI version number that corresponds to the current CLI version.
  The Tree-sitter library is generally backwards-compatible with languages
  generated using older CLI versions, but is not forwards-compatible.

  > #define TREE_SITTER_LANGUAGE_VERSION 14
-}
type TREE_SITTER_LANGUAGE_VERSION :: Nat
type TREE_SITTER_LANGUAGE_VERSION = 14
{-# LINE 264 "src/TreeSitter/CApi.hsc" #-}

{-|
  The earliest ABI version that is supported by the current version of the
  library.

  > #define TREE_SITTER_MIN_COMPATIBLE_LANGUAGE_VERSION 13
-}
type TREE_SITTER_MIN_COMPATIBLE_LANGUAGE_VERSION :: Nat
type TREE_SITTER_MIN_COMPATIBLE_LANGUAGE_VERSION = 13
{-# LINE 273 "src/TreeSitter/CApi.hsc" #-}

{-------------------}
{- Section - Types -}
{-------------------}

{-|
  > typedef uint16_t TSStateId;
  -}
newtype
  {-# CTYPE "tree_sitter/api.h" "TSStateId" #-}
  TSStateId = TSStateId Word16
{-# LINE 284 "src/TreeSitter/CApi.hsc" #-}
  deriving stock (Show, Read, Eq, Ord)
  deriving newtype (Integer -> TSStateId
TSStateId -> TSStateId
TSStateId -> TSStateId -> TSStateId
(TSStateId -> TSStateId -> TSStateId)
-> (TSStateId -> TSStateId -> TSStateId)
-> (TSStateId -> TSStateId -> TSStateId)
-> (TSStateId -> TSStateId)
-> (TSStateId -> TSStateId)
-> (TSStateId -> TSStateId)
-> (Integer -> TSStateId)
-> Num TSStateId
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: TSStateId -> TSStateId -> TSStateId
+ :: TSStateId -> TSStateId -> TSStateId
$c- :: TSStateId -> TSStateId -> TSStateId
- :: TSStateId -> TSStateId -> TSStateId
$c* :: TSStateId -> TSStateId -> TSStateId
* :: TSStateId -> TSStateId -> TSStateId
$cnegate :: TSStateId -> TSStateId
negate :: TSStateId -> TSStateId
$cabs :: TSStateId -> TSStateId
abs :: TSStateId -> TSStateId
$csignum :: TSStateId -> TSStateId
signum :: TSStateId -> TSStateId
$cfromInteger :: Integer -> TSStateId
fromInteger :: Integer -> TSStateId
Num, Num TSStateId
Ord TSStateId
(Num TSStateId, Ord TSStateId) =>
(TSStateId -> Rational) -> Real TSStateId
TSStateId -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: TSStateId -> Rational
toRational :: TSStateId -> Rational
Real, Enum TSStateId
Real TSStateId
(Real TSStateId, Enum TSStateId) =>
(TSStateId -> TSStateId -> TSStateId)
-> (TSStateId -> TSStateId -> TSStateId)
-> (TSStateId -> TSStateId -> TSStateId)
-> (TSStateId -> TSStateId -> TSStateId)
-> (TSStateId -> TSStateId -> (TSStateId, TSStateId))
-> (TSStateId -> TSStateId -> (TSStateId, TSStateId))
-> (TSStateId -> Integer)
-> Integral TSStateId
TSStateId -> Integer
TSStateId -> TSStateId -> (TSStateId, TSStateId)
TSStateId -> TSStateId -> TSStateId
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: TSStateId -> TSStateId -> TSStateId
quot :: TSStateId -> TSStateId -> TSStateId
$crem :: TSStateId -> TSStateId -> TSStateId
rem :: TSStateId -> TSStateId -> TSStateId
$cdiv :: TSStateId -> TSStateId -> TSStateId
div :: TSStateId -> TSStateId -> TSStateId
$cmod :: TSStateId -> TSStateId -> TSStateId
mod :: TSStateId -> TSStateId -> TSStateId
$cquotRem :: TSStateId -> TSStateId -> (TSStateId, TSStateId)
quotRem :: TSStateId -> TSStateId -> (TSStateId, TSStateId)
$cdivMod :: TSStateId -> TSStateId -> (TSStateId, TSStateId)
divMod :: TSStateId -> TSStateId -> (TSStateId, TSStateId)
$ctoInteger :: TSStateId -> Integer
toInteger :: TSStateId -> Integer
Integral, Int -> TSStateId
TSStateId -> Int
TSStateId -> [TSStateId]
TSStateId -> TSStateId
TSStateId -> TSStateId -> [TSStateId]
TSStateId -> TSStateId -> TSStateId -> [TSStateId]
(TSStateId -> TSStateId)
-> (TSStateId -> TSStateId)
-> (Int -> TSStateId)
-> (TSStateId -> Int)
-> (TSStateId -> [TSStateId])
-> (TSStateId -> TSStateId -> [TSStateId])
-> (TSStateId -> TSStateId -> [TSStateId])
-> (TSStateId -> TSStateId -> TSStateId -> [TSStateId])
-> Enum TSStateId
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: TSStateId -> TSStateId
succ :: TSStateId -> TSStateId
$cpred :: TSStateId -> TSStateId
pred :: TSStateId -> TSStateId
$ctoEnum :: Int -> TSStateId
toEnum :: Int -> TSStateId
$cfromEnum :: TSStateId -> Int
fromEnum :: TSStateId -> Int
$cenumFrom :: TSStateId -> [TSStateId]
enumFrom :: TSStateId -> [TSStateId]
$cenumFromThen :: TSStateId -> TSStateId -> [TSStateId]
enumFromThen :: TSStateId -> TSStateId -> [TSStateId]
$cenumFromTo :: TSStateId -> TSStateId -> [TSStateId]
enumFromTo :: TSStateId -> TSStateId -> [TSStateId]
$cenumFromThenTo :: TSStateId -> TSStateId -> TSStateId -> [TSStateId]
enumFromThenTo :: TSStateId -> TSStateId -> TSStateId -> [TSStateId]
Enum)

{-|
  > typedef uint16_t TSSymbol;
  -}
newtype
  {-# CTYPE "tree_sitter/api.h" "TSSymbol" #-}
  TSSymbol = TSSymbol Word16
{-# LINE 293 "src/TreeSitter/CApi.hsc" #-}
  deriving stock (Show, Read, Eq, Ord)
  deriving newtype (Integer -> TSSymbol
TSSymbol -> TSSymbol
TSSymbol -> TSSymbol -> TSSymbol
(TSSymbol -> TSSymbol -> TSSymbol)
-> (TSSymbol -> TSSymbol -> TSSymbol)
-> (TSSymbol -> TSSymbol -> TSSymbol)
-> (TSSymbol -> TSSymbol)
-> (TSSymbol -> TSSymbol)
-> (TSSymbol -> TSSymbol)
-> (Integer -> TSSymbol)
-> Num TSSymbol
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: TSSymbol -> TSSymbol -> TSSymbol
+ :: TSSymbol -> TSSymbol -> TSSymbol
$c- :: TSSymbol -> TSSymbol -> TSSymbol
- :: TSSymbol -> TSSymbol -> TSSymbol
$c* :: TSSymbol -> TSSymbol -> TSSymbol
* :: TSSymbol -> TSSymbol -> TSSymbol
$cnegate :: TSSymbol -> TSSymbol
negate :: TSSymbol -> TSSymbol
$cabs :: TSSymbol -> TSSymbol
abs :: TSSymbol -> TSSymbol
$csignum :: TSSymbol -> TSSymbol
signum :: TSSymbol -> TSSymbol
$cfromInteger :: Integer -> TSSymbol
fromInteger :: Integer -> TSSymbol
Num, Num TSSymbol
Ord TSSymbol
(Num TSSymbol, Ord TSSymbol) =>
(TSSymbol -> Rational) -> Real TSSymbol
TSSymbol -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: TSSymbol -> Rational
toRational :: TSSymbol -> Rational
Real, Enum TSSymbol
Real TSSymbol
(Real TSSymbol, Enum TSSymbol) =>
(TSSymbol -> TSSymbol -> TSSymbol)
-> (TSSymbol -> TSSymbol -> TSSymbol)
-> (TSSymbol -> TSSymbol -> TSSymbol)
-> (TSSymbol -> TSSymbol -> TSSymbol)
-> (TSSymbol -> TSSymbol -> (TSSymbol, TSSymbol))
-> (TSSymbol -> TSSymbol -> (TSSymbol, TSSymbol))
-> (TSSymbol -> Integer)
-> Integral TSSymbol
TSSymbol -> Integer
TSSymbol -> TSSymbol -> (TSSymbol, TSSymbol)
TSSymbol -> TSSymbol -> TSSymbol
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: TSSymbol -> TSSymbol -> TSSymbol
quot :: TSSymbol -> TSSymbol -> TSSymbol
$crem :: TSSymbol -> TSSymbol -> TSSymbol
rem :: TSSymbol -> TSSymbol -> TSSymbol
$cdiv :: TSSymbol -> TSSymbol -> TSSymbol
div :: TSSymbol -> TSSymbol -> TSSymbol
$cmod :: TSSymbol -> TSSymbol -> TSSymbol
mod :: TSSymbol -> TSSymbol -> TSSymbol
$cquotRem :: TSSymbol -> TSSymbol -> (TSSymbol, TSSymbol)
quotRem :: TSSymbol -> TSSymbol -> (TSSymbol, TSSymbol)
$cdivMod :: TSSymbol -> TSSymbol -> (TSSymbol, TSSymbol)
divMod :: TSSymbol -> TSSymbol -> (TSSymbol, TSSymbol)
$ctoInteger :: TSSymbol -> Integer
toInteger :: TSSymbol -> Integer
Integral, Int -> TSSymbol
TSSymbol -> Int
TSSymbol -> [TSSymbol]
TSSymbol -> TSSymbol
TSSymbol -> TSSymbol -> [TSSymbol]
TSSymbol -> TSSymbol -> TSSymbol -> [TSSymbol]
(TSSymbol -> TSSymbol)
-> (TSSymbol -> TSSymbol)
-> (Int -> TSSymbol)
-> (TSSymbol -> Int)
-> (TSSymbol -> [TSSymbol])
-> (TSSymbol -> TSSymbol -> [TSSymbol])
-> (TSSymbol -> TSSymbol -> [TSSymbol])
-> (TSSymbol -> TSSymbol -> TSSymbol -> [TSSymbol])
-> Enum TSSymbol
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: TSSymbol -> TSSymbol
succ :: TSSymbol -> TSSymbol
$cpred :: TSSymbol -> TSSymbol
pred :: TSSymbol -> TSSymbol
$ctoEnum :: Int -> TSSymbol
toEnum :: Int -> TSSymbol
$cfromEnum :: TSSymbol -> Int
fromEnum :: TSSymbol -> Int
$cenumFrom :: TSSymbol -> [TSSymbol]
enumFrom :: TSSymbol -> [TSSymbol]
$cenumFromThen :: TSSymbol -> TSSymbol -> [TSSymbol]
enumFromThen :: TSSymbol -> TSSymbol -> [TSSymbol]
$cenumFromTo :: TSSymbol -> TSSymbol -> [TSSymbol]
enumFromTo :: TSSymbol -> TSSymbol -> [TSSymbol]
$cenumFromThenTo :: TSSymbol -> TSSymbol -> TSSymbol -> [TSSymbol]
enumFromThenTo :: TSSymbol -> TSSymbol -> TSSymbol -> [TSSymbol]
Enum)

{-|
  > typedef uint16_t TSFieldId;
  -}
newtype
  {-# CTYPE "tree_sitter/api.h" "TSFieldId" #-}
  TSFieldId = TSFieldId Word16
{-# LINE 302 "src/TreeSitter/CApi.hsc" #-}
  deriving stock (Show, Read, Eq, Ord)
  deriving newtype (Integer -> TSFieldId
TSFieldId -> TSFieldId
TSFieldId -> TSFieldId -> TSFieldId
(TSFieldId -> TSFieldId -> TSFieldId)
-> (TSFieldId -> TSFieldId -> TSFieldId)
-> (TSFieldId -> TSFieldId -> TSFieldId)
-> (TSFieldId -> TSFieldId)
-> (TSFieldId -> TSFieldId)
-> (TSFieldId -> TSFieldId)
-> (Integer -> TSFieldId)
-> Num TSFieldId
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: TSFieldId -> TSFieldId -> TSFieldId
+ :: TSFieldId -> TSFieldId -> TSFieldId
$c- :: TSFieldId -> TSFieldId -> TSFieldId
- :: TSFieldId -> TSFieldId -> TSFieldId
$c* :: TSFieldId -> TSFieldId -> TSFieldId
* :: TSFieldId -> TSFieldId -> TSFieldId
$cnegate :: TSFieldId -> TSFieldId
negate :: TSFieldId -> TSFieldId
$cabs :: TSFieldId -> TSFieldId
abs :: TSFieldId -> TSFieldId
$csignum :: TSFieldId -> TSFieldId
signum :: TSFieldId -> TSFieldId
$cfromInteger :: Integer -> TSFieldId
fromInteger :: Integer -> TSFieldId
Num, Num TSFieldId
Ord TSFieldId
(Num TSFieldId, Ord TSFieldId) =>
(TSFieldId -> Rational) -> Real TSFieldId
TSFieldId -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: TSFieldId -> Rational
toRational :: TSFieldId -> Rational
Real, Enum TSFieldId
Real TSFieldId
(Real TSFieldId, Enum TSFieldId) =>
(TSFieldId -> TSFieldId -> TSFieldId)
-> (TSFieldId -> TSFieldId -> TSFieldId)
-> (TSFieldId -> TSFieldId -> TSFieldId)
-> (TSFieldId -> TSFieldId -> TSFieldId)
-> (TSFieldId -> TSFieldId -> (TSFieldId, TSFieldId))
-> (TSFieldId -> TSFieldId -> (TSFieldId, TSFieldId))
-> (TSFieldId -> Integer)
-> Integral TSFieldId
TSFieldId -> Integer
TSFieldId -> TSFieldId -> (TSFieldId, TSFieldId)
TSFieldId -> TSFieldId -> TSFieldId
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: TSFieldId -> TSFieldId -> TSFieldId
quot :: TSFieldId -> TSFieldId -> TSFieldId
$crem :: TSFieldId -> TSFieldId -> TSFieldId
rem :: TSFieldId -> TSFieldId -> TSFieldId
$cdiv :: TSFieldId -> TSFieldId -> TSFieldId
div :: TSFieldId -> TSFieldId -> TSFieldId
$cmod :: TSFieldId -> TSFieldId -> TSFieldId
mod :: TSFieldId -> TSFieldId -> TSFieldId
$cquotRem :: TSFieldId -> TSFieldId -> (TSFieldId, TSFieldId)
quotRem :: TSFieldId -> TSFieldId -> (TSFieldId, TSFieldId)
$cdivMod :: TSFieldId -> TSFieldId -> (TSFieldId, TSFieldId)
divMod :: TSFieldId -> TSFieldId -> (TSFieldId, TSFieldId)
$ctoInteger :: TSFieldId -> Integer
toInteger :: TSFieldId -> Integer
Integral, Int -> TSFieldId
TSFieldId -> Int
TSFieldId -> [TSFieldId]
TSFieldId -> TSFieldId
TSFieldId -> TSFieldId -> [TSFieldId]
TSFieldId -> TSFieldId -> TSFieldId -> [TSFieldId]
(TSFieldId -> TSFieldId)
-> (TSFieldId -> TSFieldId)
-> (Int -> TSFieldId)
-> (TSFieldId -> Int)
-> (TSFieldId -> [TSFieldId])
-> (TSFieldId -> TSFieldId -> [TSFieldId])
-> (TSFieldId -> TSFieldId -> [TSFieldId])
-> (TSFieldId -> TSFieldId -> TSFieldId -> [TSFieldId])
-> Enum TSFieldId
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: TSFieldId -> TSFieldId
succ :: TSFieldId -> TSFieldId
$cpred :: TSFieldId -> TSFieldId
pred :: TSFieldId -> TSFieldId
$ctoEnum :: Int -> TSFieldId
toEnum :: Int -> TSFieldId
$cfromEnum :: TSFieldId -> Int
fromEnum :: TSFieldId -> Int
$cenumFrom :: TSFieldId -> [TSFieldId]
enumFrom :: TSFieldId -> [TSFieldId]
$cenumFromThen :: TSFieldId -> TSFieldId -> [TSFieldId]
enumFromThen :: TSFieldId -> TSFieldId -> [TSFieldId]
$cenumFromTo :: TSFieldId -> TSFieldId -> [TSFieldId]
enumFromTo :: TSFieldId -> TSFieldId -> [TSFieldId]
$cenumFromThenTo :: TSFieldId -> TSFieldId -> TSFieldId -> [TSFieldId]
enumFromThenTo :: TSFieldId -> TSFieldId -> TSFieldId -> [TSFieldId]
Enum)

{-|
  > typedef struct TSLanguage TSLanguage;
  -}
data
  {-# CTYPE "tree_sitter/api.h" "TSLanguage" #-}
  TSLanguage

{-|
  > typedef struct TSParser TSParser;
  -}
data
  {-# CTYPE "tree_sitter/api.h" "TSParser" #-}
  TSParser

{-|
  > typedef struct TSTree TSTree;
  -}
data
  {-# CTYPE "tree_sitter/api.h" "TSTree" #-}
  TSTree

{-|
  > typedef struct TSQuery TSQuery;
  -}
data
  {-# CTYPE "tree_sitter/api.h" "TSQuery" #-}
  TSQuery

{-|
  > typedef struct TSQueryCursor TSQueryCursor;
  -}
data
  {-# CTYPE "tree_sitter/api.h" "TSQueryCursor" #-}
  TSQueryCursor

{-|
  > typedef struct TSLookaheadIterator TSLookaheadIterator;
  -}
data
  {-# CTYPE "tree_sitter/api.h" "TSLookaheadIterator" #-}
  TSLookaheadIterator

{-|
  > typedef enum TSInputEncoding {
  >   TSInputEncodingUTF8,
  >   TSInputEncodingUTF16,
  > } TSInputEncoding;
  -}
newtype
  {-# CTYPE "tree_sitter/api.h" "TSInputEncoding" #-}
  TSInputEncoding = TSInputEncoding
    { TSInputEncoding -> Word32
unTSInputEncoding :: Word32
{-# LINE 357 "src/TreeSitter/CApi.hsc" #-}
    }
    deriving (TSInputEncoding -> TSInputEncoding -> Bool
(TSInputEncoding -> TSInputEncoding -> Bool)
-> (TSInputEncoding -> TSInputEncoding -> Bool)
-> Eq TSInputEncoding
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TSInputEncoding -> TSInputEncoding -> Bool
== :: TSInputEncoding -> TSInputEncoding -> Bool
$c/= :: TSInputEncoding -> TSInputEncoding -> Bool
/= :: TSInputEncoding -> TSInputEncoding -> Bool
Eq, Int -> TSInputEncoding -> ShowS
[TSInputEncoding] -> ShowS
TSInputEncoding -> String
(Int -> TSInputEncoding -> ShowS)
-> (TSInputEncoding -> String)
-> ([TSInputEncoding] -> ShowS)
-> Show TSInputEncoding
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TSInputEncoding -> ShowS
showsPrec :: Int -> TSInputEncoding -> ShowS
$cshow :: TSInputEncoding -> String
show :: TSInputEncoding -> String
$cshowList :: [TSInputEncoding] -> ShowS
showList :: [TSInputEncoding] -> ShowS
Show)
    deriving newtype (Ptr TSInputEncoding -> IO TSInputEncoding
Ptr TSInputEncoding -> Int -> IO TSInputEncoding
Ptr TSInputEncoding -> Int -> TSInputEncoding -> IO ()
Ptr TSInputEncoding -> TSInputEncoding -> IO ()
TSInputEncoding -> Int
(TSInputEncoding -> Int)
-> (TSInputEncoding -> Int)
-> (Ptr TSInputEncoding -> Int -> IO TSInputEncoding)
-> (Ptr TSInputEncoding -> Int -> TSInputEncoding -> IO ())
-> (forall b. Ptr b -> Int -> IO TSInputEncoding)
-> (forall b. Ptr b -> Int -> TSInputEncoding -> IO ())
-> (Ptr TSInputEncoding -> IO TSInputEncoding)
-> (Ptr TSInputEncoding -> TSInputEncoding -> IO ())
-> Storable TSInputEncoding
forall b. Ptr b -> Int -> IO TSInputEncoding
forall b. Ptr b -> Int -> TSInputEncoding -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: TSInputEncoding -> Int
sizeOf :: TSInputEncoding -> Int
$calignment :: TSInputEncoding -> Int
alignment :: TSInputEncoding -> Int
$cpeekElemOff :: Ptr TSInputEncoding -> Int -> IO TSInputEncoding
peekElemOff :: Ptr TSInputEncoding -> Int -> IO TSInputEncoding
$cpokeElemOff :: Ptr TSInputEncoding -> Int -> TSInputEncoding -> IO ()
pokeElemOff :: Ptr TSInputEncoding -> Int -> TSInputEncoding -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO TSInputEncoding
peekByteOff :: forall b. Ptr b -> Int -> IO TSInputEncoding
$cpokeByteOff :: forall b. Ptr b -> Int -> TSInputEncoding -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> TSInputEncoding -> IO ()
$cpeek :: Ptr TSInputEncoding -> IO TSInputEncoding
peek :: Ptr TSInputEncoding -> IO TSInputEncoding
$cpoke :: Ptr TSInputEncoding -> TSInputEncoding -> IO ()
poke :: Ptr TSInputEncoding -> TSInputEncoding -> IO ()
Storable)

pattern TSInputEncodingUTF8 :: TSInputEncoding
pattern $mTSInputEncodingUTF8 :: forall {r}. TSInputEncoding -> ((# #) -> r) -> ((# #) -> r) -> r
$bTSInputEncodingUTF8 :: TSInputEncoding
TSInputEncodingUTF8 = TSInputEncoding ( 0 )
{-# LINE 363 "src/TreeSitter/CApi.hsc" #-}

pattern TSInputEncodingUTF16 :: TSInputEncoding
pattern $mTSInputEncodingUTF16 :: forall {r}. TSInputEncoding -> ((# #) -> r) -> ((# #) -> r) -> r
$bTSInputEncodingUTF16 :: TSInputEncoding
TSInputEncodingUTF16 = TSInputEncoding ( 1 )
{-# LINE 366 "src/TreeSitter/CApi.hsc" #-}

{-# COMPLETE TSInputEncodingUTF8, TSInputEncodingUTF16 #-}

{-|
  > typedef enum TSSymbolType {
  >   TSSymbolTypeRegular,
  >   TSSymbolTypeAnonymous,
  >   TSSymbolTypeSupertype,
  >   TSSymbolTypeAuxiliary,
  > } TSSymbolType;
  -}
newtype
  {-# CTYPE "tree_sitter/api.h" "TSSymbolType" #-}
  TSSymbolType = TSSymbolType
    { TSSymbolType -> Word32
unTSSymbolType :: Word32
{-# LINE 381 "src/TreeSitter/CApi.hsc" #-}
    }
    deriving (TSSymbolType -> TSSymbolType -> Bool
(TSSymbolType -> TSSymbolType -> Bool)
-> (TSSymbolType -> TSSymbolType -> Bool) -> Eq TSSymbolType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TSSymbolType -> TSSymbolType -> Bool
== :: TSSymbolType -> TSSymbolType -> Bool
$c/= :: TSSymbolType -> TSSymbolType -> Bool
/= :: TSSymbolType -> TSSymbolType -> Bool
Eq, Int -> TSSymbolType -> ShowS
[TSSymbolType] -> ShowS
TSSymbolType -> String
(Int -> TSSymbolType -> ShowS)
-> (TSSymbolType -> String)
-> ([TSSymbolType] -> ShowS)
-> Show TSSymbolType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TSSymbolType -> ShowS
showsPrec :: Int -> TSSymbolType -> ShowS
$cshow :: TSSymbolType -> String
show :: TSSymbolType -> String
$cshowList :: [TSSymbolType] -> ShowS
showList :: [TSSymbolType] -> ShowS
Show)

pattern TSSymbolTypeRegular :: TSSymbolType
pattern $mTSSymbolTypeRegular :: forall {r}. TSSymbolType -> ((# #) -> r) -> ((# #) -> r) -> r
$bTSSymbolTypeRegular :: TSSymbolType
TSSymbolTypeRegular = TSSymbolType ( 0 )
{-# LINE 386 "src/TreeSitter/CApi.hsc" #-}

pattern TSSymbolTypeAnonymous :: TSSymbolType
pattern $mTSSymbolTypeAnonymous :: forall {r}. TSSymbolType -> ((# #) -> r) -> ((# #) -> r) -> r
$bTSSymbolTypeAnonymous :: TSSymbolType
TSSymbolTypeAnonymous = TSSymbolType ( 1 )
{-# LINE 389 "src/TreeSitter/CApi.hsc" #-}

pattern TSSymbolTypeSupertype :: TSSymbolType
pattern $mTSSymbolTypeSupertype :: forall {r}. TSSymbolType -> ((# #) -> r) -> ((# #) -> r) -> r
$bTSSymbolTypeSupertype :: TSSymbolType
TSSymbolTypeSupertype = TSSymbolType ( 2 )
{-# LINE 392 "src/TreeSitter/CApi.hsc" #-}

pattern TSSymbolTypeAuxiliary :: TSSymbolType
pattern $mTSSymbolTypeAuxiliary :: forall {r}. TSSymbolType -> ((# #) -> r) -> ((# #) -> r) -> r
$bTSSymbolTypeAuxiliary :: TSSymbolType
TSSymbolTypeAuxiliary = TSSymbolType ( 3 )
{-# LINE 395 "src/TreeSitter/CApi.hsc" #-}

{-# COMPLETE TSSymbolTypeRegular, TSSymbolTypeAnonymous, TSSymbolTypeSupertype, TSSymbolTypeAuxiliary #-}

{-|
  > typedef struct TSPoint {
  >   uint32_t row;
  >   uint32_t column;
  > } TSPoint;
  -}
data
  {-# CTYPE "tree_sitter/api.h" "struct TSPoint" #-}
  TSPoint = TSPoint
  { TSPoint -> Word32
row    :: {-# UNPACK #-} !( Word32 )
{-# LINE 408 "src/TreeSitter/CApi.hsc" #-}
  , column :: {-# UNPACK #-} !( Word32 )
{-# LINE 409 "src/TreeSitter/CApi.hsc" #-}
  }
  deriving (Eq TSPoint
Eq TSPoint =>
(TSPoint -> TSPoint -> Ordering)
-> (TSPoint -> TSPoint -> Bool)
-> (TSPoint -> TSPoint -> Bool)
-> (TSPoint -> TSPoint -> Bool)
-> (TSPoint -> TSPoint -> Bool)
-> (TSPoint -> TSPoint -> TSPoint)
-> (TSPoint -> TSPoint -> TSPoint)
-> Ord TSPoint
TSPoint -> TSPoint -> Bool
TSPoint -> TSPoint -> Ordering
TSPoint -> TSPoint -> TSPoint
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TSPoint -> TSPoint -> Ordering
compare :: TSPoint -> TSPoint -> Ordering
$c< :: TSPoint -> TSPoint -> Bool
< :: TSPoint -> TSPoint -> Bool
$c<= :: TSPoint -> TSPoint -> Bool
<= :: TSPoint -> TSPoint -> Bool
$c> :: TSPoint -> TSPoint -> Bool
> :: TSPoint -> TSPoint -> Bool
$c>= :: TSPoint -> TSPoint -> Bool
>= :: TSPoint -> TSPoint -> Bool
$cmax :: TSPoint -> TSPoint -> TSPoint
max :: TSPoint -> TSPoint -> TSPoint
$cmin :: TSPoint -> TSPoint -> TSPoint
min :: TSPoint -> TSPoint -> TSPoint
Ord, TSPoint -> TSPoint -> Bool
(TSPoint -> TSPoint -> Bool)
-> (TSPoint -> TSPoint -> Bool) -> Eq TSPoint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TSPoint -> TSPoint -> Bool
== :: TSPoint -> TSPoint -> Bool
$c/= :: TSPoint -> TSPoint -> Bool
/= :: TSPoint -> TSPoint -> Bool
Eq, Int -> TSPoint -> ShowS
[TSPoint] -> ShowS
TSPoint -> String
(Int -> TSPoint -> ShowS)
-> (TSPoint -> String) -> ([TSPoint] -> ShowS) -> Show TSPoint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TSPoint -> ShowS
showsPrec :: Int -> TSPoint -> ShowS
$cshow :: TSPoint -> String
show :: TSPoint -> String
$cshowList :: [TSPoint] -> ShowS
showList :: [TSPoint] -> ShowS
Show)

instance Storable TSPoint where
  alignment :: TSPoint -> Int
alignment TSPoint
_ = Int
4
{-# LINE 414 "src/TreeSitter/CApi.hsc" #-}
  sizeOf _ = (8)
{-# LINE 415 "src/TreeSitter/CApi.hsc" #-}
  peek ptr = do
    row <- (\hsc_ptr -> peekByteOff hsc_ptr 0) ptr
{-# LINE 417 "src/TreeSitter/CApi.hsc" #-}
    column <- (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr
{-# LINE 418 "src/TreeSitter/CApi.hsc" #-}
    return TSPoint{..}
  poke :: Ptr TSPoint -> TSPoint -> IO ()
poke Ptr TSPoint
ptr TSPoint{Word32
row :: TSPoint -> Word32
column :: TSPoint -> Word32
row :: Word32
column :: Word32
..} = do
    (\Ptr TSPoint
hsc_ptr -> Ptr TSPoint -> Int -> Word32 -> IO ()
forall b. Ptr b -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr TSPoint
hsc_ptr Int
0) Ptr TSPoint
ptr Word32
row
{-# LINE 421 "src/TreeSitter/CApi.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 4) ptr column
{-# LINE 422 "src/TreeSitter/CApi.hsc" #-}

{-|
  > typedef struct TSRange {
  >   TSPoint start_point;
  >   TSPoint end_point;
  >   uint32_t start_byte;
  >   uint32_t end_byte;
  > } TSRange;
  -}
data
  {-# CTYPE "tree_sitter/api.h" "struct TSRange" #-}
  TSRange = TSRange
  { TSRange -> TSPoint
start_point :: {-# UNPACK #-} !TSPoint
  , TSRange -> TSPoint
end_point   :: {-# UNPACK #-} !TSPoint
  , TSRange -> Word32
start_byte  :: {-# UNPACK #-} !( Word32 )
{-# LINE 437 "src/TreeSitter/CApi.hsc" #-}
  , end_byte    :: {-# UNPACK #-} !( Word32 )
{-# LINE 438 "src/TreeSitter/CApi.hsc" #-}
  }
  deriving (TSRange -> TSRange -> Bool
(TSRange -> TSRange -> Bool)
-> (TSRange -> TSRange -> Bool) -> Eq TSRange
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TSRange -> TSRange -> Bool
== :: TSRange -> TSRange -> Bool
$c/= :: TSRange -> TSRange -> Bool
/= :: TSRange -> TSRange -> Bool
Eq, Int -> TSRange -> ShowS
[TSRange] -> ShowS
TSRange -> String
(Int -> TSRange -> ShowS)
-> (TSRange -> String) -> ([TSRange] -> ShowS) -> Show TSRange
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TSRange -> ShowS
showsPrec :: Int -> TSRange -> ShowS
$cshow :: TSRange -> String
show :: TSRange -> String
$cshowList :: [TSRange] -> ShowS
showList :: [TSRange] -> ShowS
Show)

instance Storable TSRange where
  alignment :: TSRange -> Int
alignment TSRange
_ = Int
4
{-# LINE 443 "src/TreeSitter/CApi.hsc" #-}
  sizeOf _ = (24)
{-# LINE 444 "src/TreeSitter/CApi.hsc" #-}
  peek ptr = do
    start_point <- (\hsc_ptr -> peekByteOff hsc_ptr 0) ptr
{-# LINE 446 "src/TreeSitter/CApi.hsc" #-}
    end_point <- (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr
{-# LINE 447 "src/TreeSitter/CApi.hsc" #-}
    start_byte <- (\hsc_ptr -> peekByteOff hsc_ptr 16) ptr
{-# LINE 448 "src/TreeSitter/CApi.hsc" #-}
    end_byte <- (\hsc_ptr -> peekByteOff hsc_ptr 20) ptr
{-# LINE 449 "src/TreeSitter/CApi.hsc" #-}
    return TSRange{..}
  poke :: Ptr TSRange -> TSRange -> IO ()
poke Ptr TSRange
ptr TSRange{Word32
TSPoint
start_point :: TSRange -> TSPoint
end_point :: TSRange -> TSPoint
start_byte :: TSRange -> Word32
end_byte :: TSRange -> Word32
start_point :: TSPoint
end_point :: TSPoint
start_byte :: Word32
end_byte :: Word32
..} = do
    (\Ptr TSRange
hsc_ptr -> Ptr TSRange -> Int -> TSPoint -> IO ()
forall b. Ptr b -> Int -> TSPoint -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr TSRange
hsc_ptr Int
0) Ptr TSRange
ptr TSPoint
start_point
{-# LINE 452 "src/TreeSitter/CApi.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 8) ptr end_point
{-# LINE 453 "src/TreeSitter/CApi.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 16) ptr start_byte
{-# LINE 454 "src/TreeSitter/CApi.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 20) ptr end_byte
{-# LINE 455 "src/TreeSitter/CApi.hsc" #-}

{-|
  > typedef struct TSInput {
  >   void *payload;
  >   const char *(*read)(
  >     void *payload,
  >     uint32_t byte_index,
  >     TSPoint position,
  >     uint32_t *bytes_read
  >   );
  >   TSInputEncoding encoding;
  > } TSInput;
  -}
data
  {-# CTYPE "tree_sitter/api.h" "struct TSInput" #-}
  TSInput

{-| The type of the @`read`@ argument of the @`_wrap_ts_input_new`@ function.

  > typedef const char *(*TSRead)(
  >   uint32_t byte_index,
  >   TSPoint *position,
  >   uint32_t *bytes_read
  > );
  -}
type TSRead =
  ( Word32 ) ->
{-# LINE 482 "src/TreeSitter/CApi.hsc" #-}
  Ptr TSPoint ->
  Ptr ( Word32 ) ->
{-# LINE 484 "src/TreeSitter/CApi.hsc" #-}
  IO (ConstPtr CChar)

-- | Convert a Haskell 'TSRead' closure to a C 'TSRead' function pointer.
foreign import ccall "wrapper"
  mkTSReadFunPtr :: TSRead -> IO (FunPtr TSRead)



-- | Create a @`TSInput`@.
foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_input_new"
  _wrap_ts_input_new ::
    FunPtr TSRead ->
    TSInputEncoding ->
    IO (Ptr TSInput)





-- | Delete a @`TSInput`@.
foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_input_delete"
  _wrap_ts_input_delete ::
    Ptr TSInput ->
    IO ()



{-|
  > typedef enum TSLogType {
  >   TSLogTypeParse,
  >   TSLogTypeLex,
  > } TSLogType;
  -}
newtype
  {-# CTYPE "tree_sitter/api.h" "TSLogType" #-}
  TSLogType = TSLogType
    { TSLogType -> Word32
unTSLogType :: Word32
{-# LINE 558 "src/TreeSitter/CApi.hsc" #-}
    }
    deriving (TSLogType -> TSLogType -> Bool
(TSLogType -> TSLogType -> Bool)
-> (TSLogType -> TSLogType -> Bool) -> Eq TSLogType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TSLogType -> TSLogType -> Bool
== :: TSLogType -> TSLogType -> Bool
$c/= :: TSLogType -> TSLogType -> Bool
/= :: TSLogType -> TSLogType -> Bool
Eq, Int -> TSLogType -> ShowS
[TSLogType] -> ShowS
TSLogType -> String
(Int -> TSLogType -> ShowS)
-> (TSLogType -> String)
-> ([TSLogType] -> ShowS)
-> Show TSLogType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TSLogType -> ShowS
showsPrec :: Int -> TSLogType -> ShowS
$cshow :: TSLogType -> String
show :: TSLogType -> String
$cshowList :: [TSLogType] -> ShowS
showList :: [TSLogType] -> ShowS
Show)

pattern TSLogTypeParse :: TSLogType
pattern $mTSLogTypeParse :: forall {r}. TSLogType -> ((# #) -> r) -> ((# #) -> r) -> r
$bTSLogTypeParse :: TSLogType
TSLogTypeParse = TSLogType ( 0 )
{-# LINE 563 "src/TreeSitter/CApi.hsc" #-}

pattern TSLogTypeLex :: TSLogType
pattern $mTSLogTypeLex :: forall {r}. TSLogType -> ((# #) -> r) -> ((# #) -> r) -> r
$bTSLogTypeLex :: TSLogType
TSLogTypeLex = TSLogType ( 1 )
{-# LINE 566 "src/TreeSitter/CApi.hsc" #-}

{-# COMPLETE TSLogTypeParse, TSLogTypeLex #-}

{-|
  > typedef struct TSLogger {
  >   void *payload;
  >   void (*log)(void *payload, TSLogType log_type, const char *buffer);
  > } TSLogger;
  -}
data
  {-# CTYPE "tree_sitter/api.h" "struct TSLogger" #-}
  TSLogger



{-| The type of the @`log`@ argument of the @`_wrap_ts_logger_new`@ function.

  > void (*log)(TSLogType log_type, const char *buffer);
 -}
type TSLog =
  TSLogType ->
  ConstPtr CChar ->
  IO ()

{-|
 > TSLogger *_wrap_ts_logger_new(TSLog log);
 -}
foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_logger_new"
  _wrap_ts_logger_new ::
    FunPtr TSLog ->
    IO (Ptr TSLogger)





{-| Allocate a C function pointer for a `TSLog` function.
 -}
foreign import ccall "wrapper"
  mkTSLogFunPtr :: TSLog -> IO (FunPtr TSLog)

{-| Convert a C function pointer for a `TSLog` function
    to the corresponding Haskell function.
 -}
foreign import ccall "dynamic"
  unTSLogFunPtr :: FunPtr TSLog -> TSLog

{-|
  > typedef struct TSInputEdit {
  >   uint32_t start_byte;
  >   uint32_t old_end_byte;
  >   uint32_t new_end_byte;
  >   TSPoint start_point;
  >   TSPoint old_end_point;
  >   TSPoint new_end_point;
  > } TSInputEdit;
  -}
data
  {-# CTYPE "tree_sitter/api.h" "struct TSInputEdit" #-}
  TSInputEdit = TSInputEdit
  { TSInputEdit -> Word32
start_byte    :: {-# UNPACK #-} !( Word32 )
{-# LINE 650 "src/TreeSitter/CApi.hsc" #-}
  , TSInputEdit -> Word32
old_end_byte  :: {-# UNPACK #-} !( Word32 )
{-# LINE 651 "src/TreeSitter/CApi.hsc" #-}
  , new_end_byte  :: {-# UNPACK #-} !( Word32 )
{-# LINE 652 "src/TreeSitter/CApi.hsc" #-}
  , start_point   :: {-# UNPACK #-} !TSPoint
  , TSInputEdit -> TSPoint
old_end_point :: {-# UNPACK #-} !TSPoint
  , TSInputEdit -> TSPoint
new_end_point :: {-# UNPACK #-} !TSPoint
  }
  deriving (TSInputEdit -> TSInputEdit -> Bool
(TSInputEdit -> TSInputEdit -> Bool)
-> (TSInputEdit -> TSInputEdit -> Bool) -> Eq TSInputEdit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TSInputEdit -> TSInputEdit -> Bool
== :: TSInputEdit -> TSInputEdit -> Bool
$c/= :: TSInputEdit -> TSInputEdit -> Bool
/= :: TSInputEdit -> TSInputEdit -> Bool
Eq, Int -> TSInputEdit -> ShowS
[TSInputEdit] -> ShowS
TSInputEdit -> String
(Int -> TSInputEdit -> ShowS)
-> (TSInputEdit -> String)
-> ([TSInputEdit] -> ShowS)
-> Show TSInputEdit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TSInputEdit -> ShowS
showsPrec :: Int -> TSInputEdit -> ShowS
$cshow :: TSInputEdit -> String
show :: TSInputEdit -> String
$cshowList :: [TSInputEdit] -> ShowS
showList :: [TSInputEdit] -> ShowS
Show)

instance Storable TSInputEdit where
  alignment :: TSInputEdit -> Int
alignment TSInputEdit
_ = Int
4
{-# LINE 660 "src/TreeSitter/CApi.hsc" #-}
  sizeOf _ = (36)
{-# LINE 661 "src/TreeSitter/CApi.hsc" #-}
  peek ptr = do
    start_byte <- (\hsc_ptr -> peekByteOff hsc_ptr 0) ptr
{-# LINE 663 "src/TreeSitter/CApi.hsc" #-}
    old_end_byte <- (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr
{-# LINE 664 "src/TreeSitter/CApi.hsc" #-}
    new_end_byte <- (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr
{-# LINE 665 "src/TreeSitter/CApi.hsc" #-}
    start_point <- (\hsc_ptr -> peekByteOff hsc_ptr 12) ptr
{-# LINE 666 "src/TreeSitter/CApi.hsc" #-}
    old_end_point <- (\hsc_ptr -> peekByteOff hsc_ptr 20) ptr
{-# LINE 667 "src/TreeSitter/CApi.hsc" #-}
    new_end_point <- (\hsc_ptr -> peekByteOff hsc_ptr 28) ptr
{-# LINE 668 "src/TreeSitter/CApi.hsc" #-}
    return TSInputEdit{..}
  poke :: Ptr TSInputEdit -> TSInputEdit -> IO ()
poke Ptr TSInputEdit
ptr TSInputEdit{Word32
TSPoint
start_byte :: TSInputEdit -> Word32
old_end_byte :: TSInputEdit -> Word32
new_end_byte :: TSInputEdit -> Word32
start_point :: TSInputEdit -> TSPoint
old_end_point :: TSInputEdit -> TSPoint
new_end_point :: TSInputEdit -> TSPoint
start_byte :: Word32
old_end_byte :: Word32
new_end_byte :: Word32
start_point :: TSPoint
old_end_point :: TSPoint
new_end_point :: TSPoint
..} = do
    (\Ptr TSInputEdit
hsc_ptr -> Ptr TSInputEdit -> Int -> Word32 -> IO ()
forall b. Ptr b -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr TSInputEdit
hsc_ptr Int
0) Ptr TSInputEdit
ptr Word32
start_byte
{-# LINE 671 "src/TreeSitter/CApi.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 4) ptr old_end_byte
{-# LINE 672 "src/TreeSitter/CApi.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 8) ptr new_end_byte
{-# LINE 673 "src/TreeSitter/CApi.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 12) ptr start_point
{-# LINE 674 "src/TreeSitter/CApi.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 20) ptr old_end_point
{-# LINE 675 "src/TreeSitter/CApi.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 28) ptr new_end_point
{-# LINE 676 "src/TreeSitter/CApi.hsc" #-}

{-|
  > typedef struct TSNode {
  >   uint32_t context[4];
  >   const void *id;
  >   const TSTree *tree;
  > } TSNode;
  -}
data
  {-# CTYPE "tree_sitter/api.h" "struct TSNode" #-}
  TSNode = TSNode
  { TSNode -> TSNodeContext
_context :: {-# UNPACK #-} !TSNodeContext
  , TSNode -> ConstPtr Void
_id :: {-# UNPACK #-} !(ConstPtr Void)
  , TSNode -> ConstPtr TSTree
_tree :: {-# UNPACK #-} !(ConstPtr TSTree)
  }

instance Storable TSNode where
  alignment :: TSNode -> Int
alignment TSNode
_ = Int
8
{-# LINE 694 "src/TreeSitter/CApi.hsc" #-}
  sizeOf _ = (32)
{-# LINE 695 "src/TreeSitter/CApi.hsc" #-}
  peek ptr = do
    _context <- peekTSNodeContext ( (\hsc_ptr -> hsc_ptr `plusPtr` 0) ptr )
{-# LINE 697 "src/TreeSitter/CApi.hsc" #-}
    _id <- ConstPtr <$> (\hsc_ptr -> peekByteOff hsc_ptr 16) ptr
{-# LINE 698 "src/TreeSitter/CApi.hsc" #-}
    _tree <- ConstPtr <$> (\hsc_ptr -> peekByteOff hsc_ptr 24) ptr
{-# LINE 699 "src/TreeSitter/CApi.hsc" #-}
    return TSNode{..}
  poke :: Ptr TSNode -> TSNode -> IO ()
poke Ptr TSNode
ptr TSNode{ConstPtr Void
ConstPtr TSTree
TSNodeContext
_context :: TSNode -> TSNodeContext
_id :: TSNode -> ConstPtr Void
_tree :: TSNode -> ConstPtr TSTree
_context :: TSNodeContext
_id :: ConstPtr Void
_tree :: ConstPtr TSTree
..} = do
    Ptr Word32 -> TSNodeContext -> IO ()
pokeTSNodeContext ( (\Ptr TSNode
hsc_ptr -> Ptr TSNode
hsc_ptr Ptr TSNode -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) Ptr TSNode
ptr ) TSNodeContext
_context
{-# LINE 702 "src/TreeSitter/CApi.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 16) ptr (unConstPtr _id)
{-# LINE 703 "src/TreeSitter/CApi.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 24) ptr (unConstPtr _tree)
{-# LINE 704 "src/TreeSitter/CApi.hsc" #-}

{-| The type of the @`_context`@ field of a @`TSNode`@ struct.

 > uint32_t context[4];
 -}
data
  TSNodeContext = TSNodeContext
    {-# UNPACK #-} !( Word32 )
{-# LINE 712 "src/TreeSitter/CApi.hsc" #-}
    {-# UNPACK #-} !( Word32 )
{-# LINE 713 "src/TreeSitter/CApi.hsc" #-}
    {-# UNPACK #-} !( Word32 )
{-# LINE 714 "src/TreeSitter/CApi.hsc" #-}
    {-# UNPACK #-} !( Word32 )
{-# LINE 715 "src/TreeSitter/CApi.hsc" #-}

{-| Peek a @`TSNodeContext`@.

    This does the same as `peek` would, except that @`TSNodeContext`@ is not an instance of `Storable`.
 -}
peekTSNodeContext :: Ptr ( Word32 ) -> IO TSNodeContext
{-# LINE 721 "src/TreeSitter/CApi.hsc" #-}
peekTSNodeContext ptr = do
  [x0, x1, x2, x3] <- peekArray 4 ptr
  return $ TSNodeContext x0 x1 x2 x3

{-| Poke a @`TSNodeContext`@.

    This does the same as `poke` would, except that @`TSNodeContext`@ is not an instance of `Storable`.
 -}
pokeTSNodeContext :: Ptr ( Word32 ) -> TSNodeContext -> IO ()
{-# LINE 730 "src/TreeSitter/CApi.hsc" #-}
pokeTSNodeContext ptr (TSNodeContext x0 x1 x2 x3) = do
  pokeArray ptr [x0, x1, x2, x3]

{-|
  > typedef struct TSTreeCursor {
  >   const void *tree;
  >   const void *id;
  >   uint32_t context[3];
  > } TSTreeCursor;
  -}
data
  {-# CTYPE "tree_sitter/api.h" "struct TSTreeCursor" #-}
  TSTreeCursor = TSTreeCursor
  { TSTreeCursor -> ConstPtr Void
_tree :: {-# UNPACK #-} !(ConstPtr Void)
  , TSTreeCursor -> ConstPtr Void
_id :: {-# UNPACK #-} !(ConstPtr Void)
  , TSTreeCursor -> TSTreeCursorContext
_context :: {-# UNPACK #-} !TSTreeCursorContext
  }

instance Storable TSTreeCursor where
  alignment :: TSTreeCursor -> Int
alignment TSTreeCursor
_ = Int
8
{-# LINE 750 "src/TreeSitter/CApi.hsc" #-}
  sizeOf _ = (32)
{-# LINE 751 "src/TreeSitter/CApi.hsc" #-}
  peek ptr = do
    _tree <- ConstPtr <$> (\hsc_ptr -> peekByteOff hsc_ptr 0) ptr
{-# LINE 753 "src/TreeSitter/CApi.hsc" #-}
    _id <- ConstPtr <$> (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr
{-# LINE 754 "src/TreeSitter/CApi.hsc" #-}
    _context <- peekTSTreeCursorContext ( (\hsc_ptr -> hsc_ptr `plusPtr` 16) ptr )
{-# LINE 755 "src/TreeSitter/CApi.hsc" #-}
    return TSTreeCursor{..}
  poke :: Ptr TSTreeCursor -> TSTreeCursor -> IO ()
poke Ptr TSTreeCursor
ptr TSTreeCursor{ConstPtr Void
TSTreeCursorContext
_context :: TSTreeCursor -> TSTreeCursorContext
_tree :: TSTreeCursor -> ConstPtr Void
_id :: TSTreeCursor -> ConstPtr Void
_tree :: ConstPtr Void
_id :: ConstPtr Void
_context :: TSTreeCursorContext
..} = do
    (\Ptr TSTreeCursor
hsc_ptr -> Ptr TSTreeCursor -> Int -> Ptr Void -> IO ()
forall b. Ptr b -> Int -> Ptr Void -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr TSTreeCursor
hsc_ptr Int
0) Ptr TSTreeCursor
ptr (ConstPtr Void -> Ptr Void
forall a. ConstPtr a -> Ptr a
unConstPtr ConstPtr Void
_tree)
{-# LINE 758 "src/TreeSitter/CApi.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 8) ptr (unConstPtr _id)
{-# LINE 759 "src/TreeSitter/CApi.hsc" #-}
    pokeTSTreeCursorContext ( (\hsc_ptr -> hsc_ptr `plusPtr` 16) ptr ) _context
{-# LINE 760 "src/TreeSitter/CApi.hsc" #-}

{-| The type of the @`_context`@ field of a @`TSTreeCursor`@ struct.

 > uint32_t context[3];
 -}
data
  TSTreeCursorContext = TSTreeCursorContext
    {-# UNPACK #-} !( Word32 )
{-# LINE 768 "src/TreeSitter/CApi.hsc" #-}
    {-# UNPACK #-} !( Word32 )
{-# LINE 769 "src/TreeSitter/CApi.hsc" #-}
    {-# UNPACK #-} !( Word32 )
{-# LINE 770 "src/TreeSitter/CApi.hsc" #-}

{-| Peek a @`TSTreeCursorContext`@.

    This does the same as `peek` would, except that @`TSTreeCursorContext`@ is not an instance of `Storable`.
 -}
peekTSTreeCursorContext :: Ptr ( Word32 ) -> IO TSTreeCursorContext
{-# LINE 776 "src/TreeSitter/CApi.hsc" #-}
peekTSTreeCursorContext ptr = do
  [x0, x1, x2] <- peekArray 3 ptr
  return $ TSTreeCursorContext x0 x1 x2

{-| Poke a @`TSTreeCursorContext`@.

    This does the same as `poke` would, except that @`TSTreeCursorContext`@ is not an instance of `Storable`.
 -}
pokeTSTreeCursorContext :: Ptr ( Word32 ) -> TSTreeCursorContext -> IO ()
{-# LINE 785 "src/TreeSitter/CApi.hsc" #-}
pokeTSTreeCursorContext ptr (TSTreeCursorContext x0 x1 x2) = do
  pokeArray ptr [x0, x1, x2]

{-|
  > typedef struct TSQueryCapture {
  >   TSNode node;
  >   uint32_t index;
  > } TSQueryCapture;
  -}
data
  {-# CTYPE "tree_sitter/api.h" "struct TSQueryCapture" #-}
  TSQueryCapture = TSQueryCapture
  { TSQueryCapture -> TSNode
_node :: {-# UNPACK #-} !TSNode
  , TSQueryCapture -> Word32
_index :: {-# UNPACK #-} !( Word32 )
{-# LINE 799 "src/TreeSitter/CApi.hsc" #-}
  }

instance Storable TSQueryCapture where
  alignment :: TSQueryCapture -> Int
alignment TSQueryCapture
_ = Int
8
{-# LINE 803 "src/TreeSitter/CApi.hsc" #-}
  sizeOf _ = (40)
{-# LINE 804 "src/TreeSitter/CApi.hsc" #-}
  peek ptr = do
    _node <- (\hsc_ptr -> peekByteOff hsc_ptr 0) ptr
{-# LINE 806 "src/TreeSitter/CApi.hsc" #-}
    _index <- (\hsc_ptr -> peekByteOff hsc_ptr 32) ptr
{-# LINE 807 "src/TreeSitter/CApi.hsc" #-}
    return TSQueryCapture{..}
  poke :: Ptr TSQueryCapture -> TSQueryCapture -> IO ()
poke Ptr TSQueryCapture
ptr TSQueryCapture{Word32
TSNode
_node :: TSQueryCapture -> TSNode
_index :: TSQueryCapture -> Word32
_node :: TSNode
_index :: Word32
..} = do
    (\Ptr TSQueryCapture
hsc_ptr -> Ptr TSQueryCapture -> Int -> TSNode -> IO ()
forall b. Ptr b -> Int -> TSNode -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr TSQueryCapture
hsc_ptr Int
0) Ptr TSQueryCapture
ptr TSNode
_node
{-# LINE 810 "src/TreeSitter/CApi.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 32) ptr _index
{-# LINE 811 "src/TreeSitter/CApi.hsc" #-}

{-|
  > typedef enum TSQuantifier {
  >   TSQuantifierZero = 0, // must match the array initialization value
  >   TSQuantifierZeroOrOne,
  >   TSQuantifierZeroOrMore,
  >   TSQuantifierOne,
  >   TSQuantifierOneOrMore,
  > } TSQuantifier;
  -}
newtype
  {-# CTYPE "tree_sitter/api.h" "TSQuantifier" #-}
  TSQuantifier = TSQuantifier
    { TSQuantifier -> Word32
unTSQuantifier :: Word32
{-# LINE 825 "src/TreeSitter/CApi.hsc" #-}
    }
    deriving (TSQuantifier -> TSQuantifier -> Bool
(TSQuantifier -> TSQuantifier -> Bool)
-> (TSQuantifier -> TSQuantifier -> Bool) -> Eq TSQuantifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TSQuantifier -> TSQuantifier -> Bool
== :: TSQuantifier -> TSQuantifier -> Bool
$c/= :: TSQuantifier -> TSQuantifier -> Bool
/= :: TSQuantifier -> TSQuantifier -> Bool
Eq, Int -> TSQuantifier -> ShowS
[TSQuantifier] -> ShowS
TSQuantifier -> String
(Int -> TSQuantifier -> ShowS)
-> (TSQuantifier -> String)
-> ([TSQuantifier] -> ShowS)
-> Show TSQuantifier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TSQuantifier -> ShowS
showsPrec :: Int -> TSQuantifier -> ShowS
$cshow :: TSQuantifier -> String
show :: TSQuantifier -> String
$cshowList :: [TSQuantifier] -> ShowS
showList :: [TSQuantifier] -> ShowS
Show)
    deriving newtype (Ptr TSQuantifier -> IO TSQuantifier
Ptr TSQuantifier -> Int -> IO TSQuantifier
Ptr TSQuantifier -> Int -> TSQuantifier -> IO ()
Ptr TSQuantifier -> TSQuantifier -> IO ()
TSQuantifier -> Int
(TSQuantifier -> Int)
-> (TSQuantifier -> Int)
-> (Ptr TSQuantifier -> Int -> IO TSQuantifier)
-> (Ptr TSQuantifier -> Int -> TSQuantifier -> IO ())
-> (forall b. Ptr b -> Int -> IO TSQuantifier)
-> (forall b. Ptr b -> Int -> TSQuantifier -> IO ())
-> (Ptr TSQuantifier -> IO TSQuantifier)
-> (Ptr TSQuantifier -> TSQuantifier -> IO ())
-> Storable TSQuantifier
forall b. Ptr b -> Int -> IO TSQuantifier
forall b. Ptr b -> Int -> TSQuantifier -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: TSQuantifier -> Int
sizeOf :: TSQuantifier -> Int
$calignment :: TSQuantifier -> Int
alignment :: TSQuantifier -> Int
$cpeekElemOff :: Ptr TSQuantifier -> Int -> IO TSQuantifier
peekElemOff :: Ptr TSQuantifier -> Int -> IO TSQuantifier
$cpokeElemOff :: Ptr TSQuantifier -> Int -> TSQuantifier -> IO ()
pokeElemOff :: Ptr TSQuantifier -> Int -> TSQuantifier -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO TSQuantifier
peekByteOff :: forall b. Ptr b -> Int -> IO TSQuantifier
$cpokeByteOff :: forall b. Ptr b -> Int -> TSQuantifier -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> TSQuantifier -> IO ()
$cpeek :: Ptr TSQuantifier -> IO TSQuantifier
peek :: Ptr TSQuantifier -> IO TSQuantifier
$cpoke :: Ptr TSQuantifier -> TSQuantifier -> IO ()
poke :: Ptr TSQuantifier -> TSQuantifier -> IO ()
Storable)

pattern TSQuantifierZero :: TSQuantifier
pattern $mTSQuantifierZero :: forall {r}. TSQuantifier -> ((# #) -> r) -> ((# #) -> r) -> r
$bTSQuantifierZero :: TSQuantifier
TSQuantifierZero = TSQuantifier ( 0 )
{-# LINE 831 "src/TreeSitter/CApi.hsc" #-}

pattern TSQuantifierZeroOrOne :: TSQuantifier
pattern $mTSQuantifierZeroOrOne :: forall {r}. TSQuantifier -> ((# #) -> r) -> ((# #) -> r) -> r
$bTSQuantifierZeroOrOne :: TSQuantifier
TSQuantifierZeroOrOne = TSQuantifier ( 1 )
{-# LINE 834 "src/TreeSitter/CApi.hsc" #-}

pattern TSQuantifierZeroOrMore :: TSQuantifier
pattern $mTSQuantifierZeroOrMore :: forall {r}. TSQuantifier -> ((# #) -> r) -> ((# #) -> r) -> r
$bTSQuantifierZeroOrMore :: TSQuantifier
TSQuantifierZeroOrMore = TSQuantifier ( 2 )
{-# LINE 837 "src/TreeSitter/CApi.hsc" #-}

pattern TSQuantifierOne :: TSQuantifier
pattern $mTSQuantifierOne :: forall {r}. TSQuantifier -> ((# #) -> r) -> ((# #) -> r) -> r
$bTSQuantifierOne :: TSQuantifier
TSQuantifierOne = TSQuantifier ( 3 )
{-# LINE 840 "src/TreeSitter/CApi.hsc" #-}

pattern TSQuantifierOneOrMore :: TSQuantifier
pattern $mTSQuantifierOneOrMore :: forall {r}. TSQuantifier -> ((# #) -> r) -> ((# #) -> r) -> r
$bTSQuantifierOneOrMore :: TSQuantifier
TSQuantifierOneOrMore = TSQuantifier ( 4 )
{-# LINE 843 "src/TreeSitter/CApi.hsc" #-}

{-# COMPLETE TSQuantifierZero, TSQuantifierZeroOrOne, TSQuantifierZeroOrMore, TSQuantifierOne, TSQuantifierOneOrMore #-}

{-|
  > typedef struct TSQueryMatch {
  >   uint32_t id;
  >   uint16_t pattern_index;
  >   uint16_t capture_count;
  >   const TSQueryCapture *captures;
  > } TSQueryMatch;
  -}
data
  {-# CTYPE "tree_sitter/api.h" "struct TSQueryMatch" #-}
  TSQueryMatch = TSQueryMatch
  { TSQueryMatch -> Word32
_id :: {-# UNPACK #-} !( Word32 )
{-# LINE 858 "src/TreeSitter/CApi.hsc" #-}
  , _pattern_index :: {-# UNPACK #-} !( Word16 )
{-# LINE 859 "src/TreeSitter/CApi.hsc" #-}
  -- , _capture_count :: {-# UNPACK #-} !( #{type uint16_t} )
  -- , _captures :: {-# UNPACK #-} !(Ptr TSQueryCapture)
  , TSQueryMatch -> [TSQueryCapture]
_captures :: ![TSQueryCapture]
  }

instance Storable TSQueryMatch where
  alignment :: TSQueryMatch -> Int
alignment TSQueryMatch
_ = Int
8
{-# LINE 866 "src/TreeSitter/CApi.hsc" #-}
  sizeOf _ = (16)
{-# LINE 867 "src/TreeSitter/CApi.hsc" #-}
  peek ptr = do
    _id <- (\hsc_ptr -> peekByteOff hsc_ptr 0) ptr
{-# LINE 869 "src/TreeSitter/CApi.hsc" #-}
    _pattern_index <- (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr
{-# LINE 870 "src/TreeSitter/CApi.hsc" #-}
    _capture_count <- (\hsc_ptr -> peekByteOff hsc_ptr 6) ptr
{-# LINE 871 "src/TreeSitter/CApi.hsc" #-}
    _captures <- peekTSQueryCapture _capture_count ( (\hsc_ptr -> hsc_ptr `plusPtr` 8) ptr )
{-# LINE 872 "src/TreeSitter/CApi.hsc" #-}
    return TSQueryMatch{..}
  poke :: Ptr TSQueryMatch -> TSQueryMatch -> IO ()
poke Ptr TSQueryMatch
ptr TSQueryMatch{[TSQueryCapture]
Word16
Word32
_id :: TSQueryMatch -> Word32
_pattern_index :: TSQueryMatch -> Word16
_captures :: TSQueryMatch -> [TSQueryCapture]
_id :: Word32
_pattern_index :: Word16
_captures :: [TSQueryCapture]
..} = do
    (\Ptr TSQueryMatch
hsc_ptr -> Ptr TSQueryMatch -> Int -> Word32 -> IO ()
forall b. Ptr b -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr TSQueryMatch
hsc_ptr Int
0) Ptr TSQueryMatch
ptr Word32
_id
{-# LINE 875 "src/TreeSitter/CApi.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 4) ptr _pattern_index
{-# LINE 876 "src/TreeSitter/CApi.hsc" #-}
    let _capture_count :: ( Word16 )
{-# LINE 877 "src/TreeSitter/CApi.hsc" #-}
        _capture_count = fromIntegral $ length _captures
    (\Ptr TSQueryMatch
hsc_ptr -> Ptr TSQueryMatch -> Int -> Word16 -> IO ()
forall b. Ptr b -> Int -> Word16 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr TSQueryMatch
hsc_ptr Int
6) Ptr TSQueryMatch
ptr Word16
_capture_count
{-# LINE 879 "src/TreeSitter/CApi.hsc" #-}
    pokeTSQueryCapture ( (\hsc_ptr -> hsc_ptr `plusPtr` 8) ptr ) _captures
{-# LINE 880 "src/TreeSitter/CApi.hsc" #-}

{-| Peek an array of @`TSQueryCapture`@.

    This does the same as `peekArray`.
 -}
peekTSQueryCapture ::
  ( Word16 ) ->
{-# LINE 887 "src/TreeSitter/CApi.hsc" #-}
  Ptr TSQueryCapture ->
  IO [TSQueryCapture]
peekTSQueryCapture :: Word16 -> Ptr TSQueryCapture -> IO [TSQueryCapture]
peekTSQueryCapture Word16
capture_count Ptr TSQueryCapture
ptr =
  Int -> Ptr TSQueryCapture -> IO [TSQueryCapture]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
capture_count) Ptr TSQueryCapture
ptr

{-| Poke an array of @`TSQueryCapture`@.

    This does the same as `pokeArray`.
 -}
pokeTSQueryCapture ::
  Ptr TSQueryCapture ->
  [TSQueryCapture] ->
  IO ()
pokeTSQueryCapture :: Ptr TSQueryCapture -> [TSQueryCapture] -> IO ()
pokeTSQueryCapture Ptr TSQueryCapture
ptr [TSQueryCapture]
captures =
  Ptr TSQueryCapture -> [TSQueryCapture] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr TSQueryCapture
ptr [TSQueryCapture]
captures

{-|
  > typedef enum TSQueryPredicateStepType {
  >   TSQueryPredicateStepTypeDone,
  >   TSQueryPredicateStepTypeCapture,
  >   TSQueryPredicateStepTypeString,
  > } TSQueryPredicateStepType;
  -}
newtype
  {-# CTYPE "tree_sitter/api.h" "TSQueryPredicateStepType" #-}
  TSQueryPredicateStepType = TSQueryPredicateStepType
    { TSQueryPredicateStepType -> Word32
unTSQueryPredicateStepType :: Word32
{-# LINE 914 "src/TreeSitter/CApi.hsc" #-}
    }
    deriving (TSQueryPredicateStepType -> TSQueryPredicateStepType -> Bool
(TSQueryPredicateStepType -> TSQueryPredicateStepType -> Bool)
-> (TSQueryPredicateStepType -> TSQueryPredicateStepType -> Bool)
-> Eq TSQueryPredicateStepType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TSQueryPredicateStepType -> TSQueryPredicateStepType -> Bool
== :: TSQueryPredicateStepType -> TSQueryPredicateStepType -> Bool
$c/= :: TSQueryPredicateStepType -> TSQueryPredicateStepType -> Bool
/= :: TSQueryPredicateStepType -> TSQueryPredicateStepType -> Bool
Eq, Int -> TSQueryPredicateStepType -> ShowS
[TSQueryPredicateStepType] -> ShowS
TSQueryPredicateStepType -> String
(Int -> TSQueryPredicateStepType -> ShowS)
-> (TSQueryPredicateStepType -> String)
-> ([TSQueryPredicateStepType] -> ShowS)
-> Show TSQueryPredicateStepType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TSQueryPredicateStepType -> ShowS
showsPrec :: Int -> TSQueryPredicateStepType -> ShowS
$cshow :: TSQueryPredicateStepType -> String
show :: TSQueryPredicateStepType -> String
$cshowList :: [TSQueryPredicateStepType] -> ShowS
showList :: [TSQueryPredicateStepType] -> ShowS
Show)
    deriving newtype (Ptr TSQueryPredicateStepType -> IO TSQueryPredicateStepType
Ptr TSQueryPredicateStepType -> Int -> IO TSQueryPredicateStepType
Ptr TSQueryPredicateStepType
-> Int -> TSQueryPredicateStepType -> IO ()
Ptr TSQueryPredicateStepType -> TSQueryPredicateStepType -> IO ()
TSQueryPredicateStepType -> Int
(TSQueryPredicateStepType -> Int)
-> (TSQueryPredicateStepType -> Int)
-> (Ptr TSQueryPredicateStepType
    -> Int -> IO TSQueryPredicateStepType)
-> (Ptr TSQueryPredicateStepType
    -> Int -> TSQueryPredicateStepType -> IO ())
-> (forall b. Ptr b -> Int -> IO TSQueryPredicateStepType)
-> (forall b. Ptr b -> Int -> TSQueryPredicateStepType -> IO ())
-> (Ptr TSQueryPredicateStepType -> IO TSQueryPredicateStepType)
-> (Ptr TSQueryPredicateStepType
    -> TSQueryPredicateStepType -> IO ())
-> Storable TSQueryPredicateStepType
forall b. Ptr b -> Int -> IO TSQueryPredicateStepType
forall b. Ptr b -> Int -> TSQueryPredicateStepType -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: TSQueryPredicateStepType -> Int
sizeOf :: TSQueryPredicateStepType -> Int
$calignment :: TSQueryPredicateStepType -> Int
alignment :: TSQueryPredicateStepType -> Int
$cpeekElemOff :: Ptr TSQueryPredicateStepType -> Int -> IO TSQueryPredicateStepType
peekElemOff :: Ptr TSQueryPredicateStepType -> Int -> IO TSQueryPredicateStepType
$cpokeElemOff :: Ptr TSQueryPredicateStepType
-> Int -> TSQueryPredicateStepType -> IO ()
pokeElemOff :: Ptr TSQueryPredicateStepType
-> Int -> TSQueryPredicateStepType -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO TSQueryPredicateStepType
peekByteOff :: forall b. Ptr b -> Int -> IO TSQueryPredicateStepType
$cpokeByteOff :: forall b. Ptr b -> Int -> TSQueryPredicateStepType -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> TSQueryPredicateStepType -> IO ()
$cpeek :: Ptr TSQueryPredicateStepType -> IO TSQueryPredicateStepType
peek :: Ptr TSQueryPredicateStepType -> IO TSQueryPredicateStepType
$cpoke :: Ptr TSQueryPredicateStepType -> TSQueryPredicateStepType -> IO ()
poke :: Ptr TSQueryPredicateStepType -> TSQueryPredicateStepType -> IO ()
Storable)

pattern TSQueryPredicateStepTypeDone :: TSQueryPredicateStepType
pattern $mTSQueryPredicateStepTypeDone :: forall {r}.
TSQueryPredicateStepType -> ((# #) -> r) -> ((# #) -> r) -> r
$bTSQueryPredicateStepTypeDone :: TSQueryPredicateStepType
TSQueryPredicateStepTypeDone = TSQueryPredicateStepType ( 0 )
{-# LINE 920 "src/TreeSitter/CApi.hsc" #-}

pattern TSQueryPredicateStepTypeCapture :: TSQueryPredicateStepType
pattern $mTSQueryPredicateStepTypeCapture :: forall {r}.
TSQueryPredicateStepType -> ((# #) -> r) -> ((# #) -> r) -> r
$bTSQueryPredicateStepTypeCapture :: TSQueryPredicateStepType
TSQueryPredicateStepTypeCapture = TSQueryPredicateStepType ( 1 )
{-# LINE 923 "src/TreeSitter/CApi.hsc" #-}

pattern TSQueryPredicateStepTypeString :: TSQueryPredicateStepType
pattern $mTSQueryPredicateStepTypeString :: forall {r}.
TSQueryPredicateStepType -> ((# #) -> r) -> ((# #) -> r) -> r
$bTSQueryPredicateStepTypeString :: TSQueryPredicateStepType
TSQueryPredicateStepTypeString = TSQueryPredicateStepType ( 2 )
{-# LINE 926 "src/TreeSitter/CApi.hsc" #-}

{-# COMPLETE TSQueryPredicateStepTypeDone, TSQueryPredicateStepTypeCapture, TSQueryPredicateStepTypeString #-}

{-|
 > typedef struct TSQueryPredicateStep {
 >   TSQueryPredicateStepType type;
 >   uint32_t value_id;
 > } TSQueryPredicateStep;
 -}
data
  {-# CTYPE "tree_sitter/api.h" "struct TSQueryPredicateStep" #-}
  TSQueryPredicateStep = TSQueryPredicateStep
    { TSQueryPredicateStep -> TSQueryPredicateStepType
_type :: {-# UNPACK #-} !TSQueryPredicateStepType
    , TSQueryPredicateStep -> Word32
_value_id :: {-# UNPACK #-} !( Word32 )
{-# LINE 940 "src/TreeSitter/CApi.hsc" #-}
    }

instance Storable TSQueryPredicateStep where
  alignment :: TSQueryPredicateStep -> Int
alignment TSQueryPredicateStep
_ = Int
4
{-# LINE 944 "src/TreeSitter/CApi.hsc" #-}
  sizeOf _ = (8)
{-# LINE 945 "src/TreeSitter/CApi.hsc" #-}
  peek ptr = do
    _type <- (\hsc_ptr -> peekByteOff hsc_ptr 0) ptr
{-# LINE 947 "src/TreeSitter/CApi.hsc" #-}
    _value_id <- (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr
{-# LINE 948 "src/TreeSitter/CApi.hsc" #-}
    return TSQueryPredicateStep{..}
  poke :: Ptr TSQueryPredicateStep -> TSQueryPredicateStep -> IO ()
poke Ptr TSQueryPredicateStep
ptr TSQueryPredicateStep{Word32
TSQueryPredicateStepType
_type :: TSQueryPredicateStep -> TSQueryPredicateStepType
_value_id :: TSQueryPredicateStep -> Word32
_type :: TSQueryPredicateStepType
_value_id :: Word32
..} = do
    (\Ptr TSQueryPredicateStep
hsc_ptr -> Ptr TSQueryPredicateStep
-> Int -> TSQueryPredicateStepType -> IO ()
forall b. Ptr b -> Int -> TSQueryPredicateStepType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr TSQueryPredicateStep
hsc_ptr Int
0) Ptr TSQueryPredicateStep
ptr TSQueryPredicateStepType
_type
{-# LINE 951 "src/TreeSitter/CApi.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 4) ptr _value_id
{-# LINE 952 "src/TreeSitter/CApi.hsc" #-}

{-|
 > typedef enum TSQueryError {
 >   TSQueryErrorNone = 0,
 >   TSQueryErrorSyntax,
 >   TSQueryErrorNodeType,
 >   TSQueryErrorField,
 >   TSQueryErrorCapture,
 >   TSQueryErrorStructure,
 >   TSQueryErrorLanguage,
 > } TSQueryError;
 -}
newtype
  {-# CTYPE "tree_sitter/api.h" "TSQueryError" #-}
  TSQueryError = TSQueryError
    { TSQueryError -> Word32
unTSQueryError :: Word32
{-# LINE 968 "src/TreeSitter/CApi.hsc" #-}
    }
    deriving (TSQueryError -> TSQueryError -> Bool
(TSQueryError -> TSQueryError -> Bool)
-> (TSQueryError -> TSQueryError -> Bool) -> Eq TSQueryError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TSQueryError -> TSQueryError -> Bool
== :: TSQueryError -> TSQueryError -> Bool
$c/= :: TSQueryError -> TSQueryError -> Bool
/= :: TSQueryError -> TSQueryError -> Bool
Eq, Int -> TSQueryError -> ShowS
[TSQueryError] -> ShowS
TSQueryError -> String
(Int -> TSQueryError -> ShowS)
-> (TSQueryError -> String)
-> ([TSQueryError] -> ShowS)
-> Show TSQueryError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TSQueryError -> ShowS
showsPrec :: Int -> TSQueryError -> ShowS
$cshow :: TSQueryError -> String
show :: TSQueryError -> String
$cshowList :: [TSQueryError] -> ShowS
showList :: [TSQueryError] -> ShowS
Show)
    deriving newtype (Ptr TSQueryError -> IO TSQueryError
Ptr TSQueryError -> Int -> IO TSQueryError
Ptr TSQueryError -> Int -> TSQueryError -> IO ()
Ptr TSQueryError -> TSQueryError -> IO ()
TSQueryError -> Int
(TSQueryError -> Int)
-> (TSQueryError -> Int)
-> (Ptr TSQueryError -> Int -> IO TSQueryError)
-> (Ptr TSQueryError -> Int -> TSQueryError -> IO ())
-> (forall b. Ptr b -> Int -> IO TSQueryError)
-> (forall b. Ptr b -> Int -> TSQueryError -> IO ())
-> (Ptr TSQueryError -> IO TSQueryError)
-> (Ptr TSQueryError -> TSQueryError -> IO ())
-> Storable TSQueryError
forall b. Ptr b -> Int -> IO TSQueryError
forall b. Ptr b -> Int -> TSQueryError -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: TSQueryError -> Int
sizeOf :: TSQueryError -> Int
$calignment :: TSQueryError -> Int
alignment :: TSQueryError -> Int
$cpeekElemOff :: Ptr TSQueryError -> Int -> IO TSQueryError
peekElemOff :: Ptr TSQueryError -> Int -> IO TSQueryError
$cpokeElemOff :: Ptr TSQueryError -> Int -> TSQueryError -> IO ()
pokeElemOff :: Ptr TSQueryError -> Int -> TSQueryError -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO TSQueryError
peekByteOff :: forall b. Ptr b -> Int -> IO TSQueryError
$cpokeByteOff :: forall b. Ptr b -> Int -> TSQueryError -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> TSQueryError -> IO ()
$cpeek :: Ptr TSQueryError -> IO TSQueryError
peek :: Ptr TSQueryError -> IO TSQueryError
$cpoke :: Ptr TSQueryError -> TSQueryError -> IO ()
poke :: Ptr TSQueryError -> TSQueryError -> IO ()
Storable)

pattern TSQueryErrorNone :: TSQueryError
pattern $mTSQueryErrorNone :: forall {r}. TSQueryError -> ((# #) -> r) -> ((# #) -> r) -> r
$bTSQueryErrorNone :: TSQueryError
TSQueryErrorNone = TSQueryError ( 0 )
{-# LINE 974 "src/TreeSitter/CApi.hsc" #-}

pattern TSQueryErrorSyntax :: TSQueryError
pattern $mTSQueryErrorSyntax :: forall {r}. TSQueryError -> ((# #) -> r) -> ((# #) -> r) -> r
$bTSQueryErrorSyntax :: TSQueryError
TSQueryErrorSyntax = TSQueryError ( 1 )
{-# LINE 977 "src/TreeSitter/CApi.hsc" #-}

pattern TSQueryErrorNodeType :: TSQueryError
pattern $mTSQueryErrorNodeType :: forall {r}. TSQueryError -> ((# #) -> r) -> ((# #) -> r) -> r
$bTSQueryErrorNodeType :: TSQueryError
TSQueryErrorNodeType = TSQueryError ( 2 )
{-# LINE 980 "src/TreeSitter/CApi.hsc" #-}

pattern TSQueryErrorField :: TSQueryError
pattern $mTSQueryErrorField :: forall {r}. TSQueryError -> ((# #) -> r) -> ((# #) -> r) -> r
$bTSQueryErrorField :: TSQueryError
TSQueryErrorField = TSQueryError ( 3 )
{-# LINE 983 "src/TreeSitter/CApi.hsc" #-}

pattern TSQueryErrorCapture :: TSQueryError
pattern $mTSQueryErrorCapture :: forall {r}. TSQueryError -> ((# #) -> r) -> ((# #) -> r) -> r
$bTSQueryErrorCapture :: TSQueryError
TSQueryErrorCapture = TSQueryError ( 4 )
{-# LINE 986 "src/TreeSitter/CApi.hsc" #-}

pattern TSQueryErrorStructure :: TSQueryError
pattern $mTSQueryErrorStructure :: forall {r}. TSQueryError -> ((# #) -> r) -> ((# #) -> r) -> r
$bTSQueryErrorStructure :: TSQueryError
TSQueryErrorStructure = TSQueryError ( 5 )
{-# LINE 989 "src/TreeSitter/CApi.hsc" #-}

pattern TSQueryErrorLanguage :: TSQueryError
pattern $mTSQueryErrorLanguage :: forall {r}. TSQueryError -> ((# #) -> r) -> ((# #) -> r) -> r
$bTSQueryErrorLanguage :: TSQueryError
TSQueryErrorLanguage = TSQueryError ( 6 )
{-# LINE 992 "src/TreeSitter/CApi.hsc" #-}

{-# COMPLETE TSQueryErrorNone, TSQueryErrorSyntax, TSQueryErrorNodeType, TSQueryErrorField, TSQueryErrorCapture, TSQueryErrorStructure, TSQueryErrorLanguage #-}

{--------------------}
{- Section - Parser -}
{--------------------}

{-|
  Create a new parser.

  > TSParser *ts_parser_new(void);
-}
foreign import capi unsafe "tree_sitter/api.h ts_parser_new"
  ts_parser_new ::
    IO (Ptr TSParser)

{-|
  Delete the parser, freeing all of the memory that it used.

  > void ts_parser_delete(TSParser *self);
-}
foreign import capi unsafe "tree_sitter/api.h ts_parser_delete"
  ts_parser_delete ::
    Ptr TSParser ->
    IO ()

{-| C function pointer to @`ts_parser_delete`@.
 -}
foreign import capi unsafe "tree_sitter/api.h &ts_parser_delete"
  p_ts_parser_delete ::
    FunPtr (
      Ptr TSParser ->
      IO ()
    )

{-|
  Get the parser's current language.

  > const TSLanguage *ts_parser_language(const TSParser *self);
-}
foreign import capi unsafe "tree_sitter/api.h ts_parser_language"
  ts_parser_language ::
    ConstPtr TSParser ->
    IO (ConstPtr TSLanguage)

{-|
  Set the language that the parser should use for parsing.

  Returns a boolean indicating whether or not the language was successfully
  assigned. True means assignment succeeded. False means there was a version
  mismatch: the language was generated with an incompatible version of the
  Tree-sitter CLI. Check the language's version using @`ts_language_version`@
  and compare it to this library's @`TREE_SITTER_LANGUAGE_VERSION`@ and
  @`TREE_SITTER_MIN_COMPATIBLE_LANGUAGE_VERSION`@ constants.

  > bool ts_parser_set_language(TSParser *self, const TSLanguage *language);
-}
foreign import capi unsafe "tree_sitter/api.h ts_parser_set_language"
  ts_parser_set_language ::
    Ptr TSParser ->
    ConstPtr TSLanguage ->
    IO CBool

{-|
  Set the ranges of text that the parser should include when parsing.

  By default, the parser will always include entire documents. This function
  allows you to parse only a *portion* of a document but still return a syntax
  tree whose ranges match up with the document as a whole. You can also pass
  multiple disjoint ranges.

  The second and third parameters specify the location and length of an array
  of ranges. The parser does *not* take ownership of these ranges; it copies
  the data, so it doesn't matter how these ranges are allocated.

  If @count@ is zero, then the entire document will be parsed. Otherwise,
  the given ranges must be ordered from earliest to latest in the document,
  and they must not overlap. That is, the following must hold for all:

  > i < count - 1: ranges[i].end_byte <= ranges[i + 1].start_byte

  If this requirement is not satisfied, the operation will fail, the ranges
  will not be assigned, and this function will return @`False`@. On success,
  this function returns @`True`@.

  > bool ts_parser_set_included_ranges(
  >   TSParser *self,
  >   const TSRange *ranges,
  >   uint32_t count
  > );
-}
foreign import capi unsafe "tree_sitter/api.h ts_parser_set_included_ranges"
  ts_parser_set_included_ranges ::
    Ptr TSParser ->
    ConstPtr TSRange ->
    ( Word32 ) ->
{-# LINE 1088 "src/TreeSitter/CApi.hsc" #-}
    IO CBool

{-|
  Get the ranges of text that the parser will include when parsing.

  The returned pointer is owned by the parser. The caller should not free it
  or write to it. The length of the array will be written to the given
  @count@ pointer.

  > const TSRange *ts_parser_included_ranges(
  >   const TSParser *self,
  >   uint32_t *count
  > );
-}
foreign import capi unsafe "tree_sitter/api.h ts_parser_included_ranges"
  ts_parser_included_ranges ::
    ConstPtr TSParser ->
    Ptr ( Word32 ) ->
{-# LINE 1106 "src/TreeSitter/CApi.hsc" #-}
    IO (ConstPtr TSRange)

{-|
  Use the parser to parse some source code and create a syntax tree.

  If you are parsing this document for the first time, pass @NULL@ for the
  @old_tree@ parameter. Otherwise, if you have already parsed an earlier
  version of this document and the document has since been edited, pass the
  previous syntax tree so that the unchanged parts of it can be reused.
  This will save time and memory. For this to work correctly, you must have
  already edited the old syntax tree using the @`ts_tree_edit`@ function in a
  way that exactly matches the source code changes.

  The @t`TSInput`@ parameter lets you specify how to read the text. It has the
  following three fields:

  1. @read@: A function to retrieve a chunk of text at a given byte offset
     and (row, column) position. The function should return a pointer to the
     text and write its length to the @bytes_read@ pointer. The parser does
     not take ownership of this buffer; it just borrows it until it has
     finished reading it. The function should write a zero value to the
     @bytes_read@ pointer to indicate the end of the document.
  2. @payload@: An arbitrary pointer that will be passed to each invocation
     of the @read@ function.
  3. @encoding@: An indication of how the text is encoded. Either
     @TSInputEncodingUTF8@ or @TSInputEncodingUTF16@.

  This function returns a syntax tree on success, and @NULL@ on failure. There
  are three possible reasons for failure:

  1. The parser does not have a language assigned. Check for this using the
      @`ts_parser_language`@ function.
  2. Parsing was cancelled due to a timeout that was set by an earlier call to
     the @`ts_parser_set_timeout_micros`@ function. You can resume parsing from
     where the parser left out by calling @`ts_parser_parse`@ again with the
     same arguments. Or you can start parsing from scratch by first calling
     @`ts_parser_reset`@.
  3. Parsing was cancelled using a cancellation flag that was set by an
     earlier call to @`ts_parser_set_cancellation_flag`@. You can resume parsing
     from where the parser left out by calling @`ts_parser_parse`@ again with
     the same arguments.

  > TSTree *ts_parser_parse(
  >   TSParser *self,
  >   const TSTree *old_tree,
  >   TSInput input
  > );
-}
ts_parser_parse ::
  Ptr TSParser ->
  ConstPtr TSTree ->
  TSRead ->
  TSInputEncoding ->
  IO (Ptr TSTree)
ts_parser_parse :: Ptr TSParser
-> ConstPtr TSTree -> TSRead -> TSInputEncoding -> IO (Ptr TSTree)
ts_parser_parse = \Ptr TSParser
self ConstPtr TSTree
old_tree TSRead
readFun TSInputEncoding
encoding ->
  IO (FunPtr TSRead)
-> (FunPtr TSRead -> IO ())
-> (FunPtr TSRead -> IO (Ptr TSTree))
-> IO (Ptr TSTree)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (TSRead -> IO (FunPtr TSRead)
mkTSReadFunPtr TSRead
readFun) FunPtr TSRead -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr ((FunPtr TSRead -> IO (Ptr TSTree)) -> IO (Ptr TSTree))
-> (FunPtr TSRead -> IO (Ptr TSTree)) -> IO (Ptr TSTree)
forall a b. (a -> b) -> a -> b
$ \FunPtr TSRead
readFun_p ->
    IO (Ptr TSInput)
-> (Ptr TSInput -> IO ())
-> (Ptr TSInput -> IO (Ptr TSTree))
-> IO (Ptr TSTree)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (FunPtr TSRead -> TSInputEncoding -> IO (Ptr TSInput)
_wrap_ts_input_new FunPtr TSRead
readFun_p TSInputEncoding
encoding) Ptr TSInput -> IO ()
_wrap_ts_input_delete ((Ptr TSInput -> IO (Ptr TSTree)) -> IO (Ptr TSTree))
-> (Ptr TSInput -> IO (Ptr TSTree)) -> IO (Ptr TSTree)
forall a b. (a -> b) -> a -> b
$ \Ptr TSInput
input_p ->
      Ptr TSParser -> ConstPtr TSTree -> Ptr TSInput -> IO (Ptr TSTree)
_wrap_ts_parser_parse Ptr TSParser
self ConstPtr TSTree
old_tree Ptr TSInput
input_p

foreign import capi safe "TreeSitter/CApi_hsc.h _wrap_ts_parser_parse"
  _wrap_ts_parser_parse ::
    Ptr TSParser ->
    ConstPtr TSTree ->
    Ptr TSInput ->
    IO (Ptr TSTree)



{-|
  Use the parser to parse some source code stored in one contiguous buffer.
  The first two parameters are the same as in the @`ts_parser_parse`@ function
  above. The second two parameters indicate the location of the buffer and its
  length in bytes.

  > TSTree *ts_parser_parse_string(
  >   TSParser *self,
  >   const TSTree *old_tree,
  >   const char *string,
  >   uint32_t length
  > );
-}
foreign import capi safe "tree_sitter/api.h ts_parser_parse_string"
  ts_parser_parse_string ::
    Ptr TSParser ->
    ConstPtr TSTree ->
    ConstPtr CChar ->
    ( Word32 ) ->
{-# LINE 1202 "src/TreeSitter/CApi.hsc" #-}
    IO (Ptr TSTree)

{-|
  Use the parser to parse some source code stored in one contiguous buffer with
  a given encoding. The first four parameters work the same as in the
  @`ts_parser_parse_string`@ method above. The final parameter indicates whether
  the text is encoded as UTF8 or UTF16.

  > TSTree *ts_parser_parse_string_encoding(
  >   TSParser *self,
  >   const TSTree *old_tree,
  >   const char *string,
  >   uint32_t length,
  >   TSInputEncoding encoding
  > );
-}
foreign import capi safe "tree_sitter/api.h ts_parser_parse_string_encoding"
  ts_parser_parse_string_encoding ::
    Ptr TSParser ->
    ConstPtr TSTree ->
    ConstPtr CChar ->
    ( Word32 ) ->
{-# LINE 1224 "src/TreeSitter/CApi.hsc" #-}
    TSInputEncoding ->
    IO (Ptr TSTree)

{-|
  Instruct the parser to start the next parse from the beginning.

  If the parser previously failed because of a timeout or a cancellation, then
  by default, it will resume where it left off on the next call to
  @`ts_parser_parse`@ or other parsing functions. If you don't want to resume,
  and instead intend to use this parser to parse some other document, you must
  call @`ts_parser_reset`@ first.

  > void ts_parser_reset(TSParser *self);
-}
foreign import capi unsafe "tree_sitter/api.h ts_parser_reset"
  ts_parser_reset ::
    Ptr TSParser ->
    IO ()

{-|
  Set the maximum duration in microseconds that parsing should be allowed to
  take before halting.

  If parsing takes longer than this, it will halt early, returning @NULL@.
  See @`ts_parser_parse`@ for more information.

  > void ts_parser_set_timeout_micros(TSParser *self, uint64_t timeout_micros);
-}
foreign import capi unsafe "tree_sitter/api.h ts_parser_set_timeout_micros"
  ts_parser_set_timeout_micros ::
    Ptr TSParser ->
    ( Word64 ) ->
{-# LINE 1256 "src/TreeSitter/CApi.hsc" #-}
    IO ()

{-|
  Get the duration in microseconds that parsing is allowed to take.

  > uint64_t ts_parser_timeout_micros(const TSParser *self);
-}
foreign import capi unsafe "tree_sitter/api.h ts_parser_timeout_micros"
  ts_parser_timeout_micros ::
    Ptr TSParser ->
    IO ( Word64 )
{-# LINE 1267 "src/TreeSitter/CApi.hsc" #-}

{-|
  Set the parser's current cancellation flag pointer.

  If a non-null pointer is assigned, then the parser will periodically read
  from this pointer during parsing. If it reads a non-zero value, it will
  halt early, returning @NULL@. See @`ts_parser_parse`@ for more information.

  > void ts_parser_set_cancellation_flag(TSParser *self, const size_t *flag);
-}
foreign import capi unsafe "tree_sitter/api.h ts_parser_set_cancellation_flag"
  ts_parser_set_cancellation_flag ::
    Ptr TSParser ->
    ConstPtr CSize ->
    IO ()

{-|
  Get the parser's current cancellation flag pointer.

  > const size_t *ts_parser_cancellation_flag(const TSParser *self);
-}
foreign import capi unsafe "tree_sitter/api.h ts_parser_cancellation_flag"
  ts_parser_cancellation_flag ::
    ConstPtr TSParser ->
    IO (ConstPtr CSize)

{-|
  Set the logger that a parser should use during parsing.

  The parser does not take ownership over the logger payload. If a logger was
  previously assigned, the caller is responsible for releasing any memory
  owned by the previous logger.

  > void ts_parser_set_logger(TSParser *self, TSLogger logger);
-}
ts_parser_set_logger ::
  Ptr TSParser ->
  TSLog ->
  IO ()
ts_parser_set_logger :: Ptr TSParser -> TSLog -> IO ()
ts_parser_set_logger = \Ptr TSParser
self TSLog
logFun -> IO () -> IO ()
forall a. IO a -> IO a
mask_ (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  FunPtr TSLog
logFun_p <- TSLog -> IO (FunPtr TSLog)
mkTSLogFunPtr TSLog
logFun
  Ptr TSLogger
logger_p <- FunPtr TSLog -> IO (Ptr TSLogger)
_wrap_ts_logger_new FunPtr TSLog
logFun_p
  Ptr TSParser -> Ptr TSLogger -> IO ()
_wrap_ts_parser_set_logger Ptr TSParser
self Ptr TSLogger
logger_p



foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_parser_set_logger"
  _wrap_ts_parser_set_logger ::
    Ptr TSParser ->
    Ptr TSLogger ->
    IO ()

{-|
  Get the parser's current logger.

  > TSLogger ts_parser_logger(const TSParser *self);
-}
ts_parser_logger ::
  ConstPtr TSParser ->
  IO (Maybe TSLog)
ts_parser_logger :: ConstPtr TSParser -> IO (Maybe TSLog)
ts_parser_logger = \ConstPtr TSParser
self -> do
  FunPtr TSLog
logFun_p <- ConstPtr TSParser -> IO (FunPtr TSLog)
_wrap_ts_parser_logger ConstPtr TSParser
self
  Maybe TSLog -> IO (Maybe TSLog)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe TSLog -> IO (Maybe TSLog))
-> Maybe TSLog -> IO (Maybe TSLog)
forall a b. (a -> b) -> a -> b
$
    if FunPtr TSLog
logFun_p FunPtr TSLog -> FunPtr TSLog -> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr TSLog
forall a. FunPtr a
nullFunPtr
      then TSLog -> Maybe TSLog
forall a. a -> Maybe a
Just (TSLog -> Maybe TSLog) -> TSLog -> Maybe TSLog
forall a b. (a -> b) -> a -> b
$ FunPtr TSLog -> TSLog
unTSLogFunPtr FunPtr TSLog
logFun_p
      else Maybe TSLog
forall a. Maybe a
Nothing
{-# INLINE ts_parser_logger #-}

foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_parser_logger"
  _wrap_ts_parser_logger ::
    ConstPtr TSParser ->
    IO (FunPtr TSLog)



{-|
  Remove the parser's current logger.
-}
ts_parser_remove_logger ::
  Ptr TSParser ->
  IO (Maybe TSLog)
ts_parser_remove_logger :: Ptr TSParser -> IO (Maybe TSLog)
ts_parser_remove_logger = \Ptr TSParser
self -> IO (Maybe TSLog) -> IO (Maybe TSLog)
forall a. IO a -> IO a
mask_ (IO (Maybe TSLog) -> IO (Maybe TSLog))
-> IO (Maybe TSLog) -> IO (Maybe TSLog)
forall a b. (a -> b) -> a -> b
$ do
  FunPtr TSLog
logFun_p <- Ptr TSParser -> IO (FunPtr TSLog)
_wrap_ts_parser_remove_logger Ptr TSParser
self
  if FunPtr TSLog
logFun_p FunPtr TSLog -> FunPtr TSLog -> Bool
forall a. Eq a => a -> a -> Bool
== FunPtr TSLog
forall a. FunPtr a
nullFunPtr
    then Maybe TSLog -> IO (Maybe TSLog)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe TSLog
forall a. Maybe a
Nothing
    else do
      let logFun :: TSLog
logFun = FunPtr TSLog -> TSLog
unTSLogFunPtr FunPtr TSLog
logFun_p
      FunPtr TSLog -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr FunPtr TSLog
logFun_p
      Maybe TSLog -> IO (Maybe TSLog)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe TSLog -> IO (Maybe TSLog))
-> Maybe TSLog -> IO (Maybe TSLog)
forall a b. (a -> b) -> a -> b
$ TSLog -> Maybe TSLog
forall a. a -> Maybe a
Just TSLog
logFun

foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_parser_remove_logger"
  _wrap_ts_parser_remove_logger ::
    Ptr TSParser ->
    IO (FunPtr TSLog)



{-|
  Set the file descriptor to which the parser should write debugging graphs
  during parsing. The graphs are formatted in the DOT language. You may want
  to pipe these graphs directly to a `dot(1)` process in order to generate
  SVG output. You can turn off this logging by passing a negative number.

  > void ts_parser_print_dot_graphs(TSParser *self, int fd);
-}
foreign import capi unsafe "tree_sitter/api.h ts_parser_print_dot_graphs"
  ts_parser_print_dot_graphs ::
    Ptr TSParser ->
    ( Int32 ) ->
{-# LINE 1418 "src/TreeSitter/CApi.hsc" #-}
    IO ()

{------------------}
{- Section - Tree -}
{------------------}

{-|
  Create a shallow copy of the syntax tree. This is very fast.

  You need to copy a syntax tree in order to use it on more than one thread at
  a time, as syntax trees are not thread safe.

  > TSTree *ts_tree_copy(const TSTree *self);
-}
foreign import capi unsafe "tree_sitter/api.h ts_tree_copy"
  ts_tree_copy ::
    Ptr TSTree ->
    IO (Ptr TSTree)

{-|
  Delete the syntax tree, freeing all of the memory that it used.

  > void ts_tree_delete(TSTree *self);
-}
foreign import capi unsafe "tree_sitter/api.h ts_tree_delete"
  ts_tree_delete ::
    Ptr TSTree ->
    IO ()

{-| C function pointer to @`ts_tree_delete`@.
 -}
foreign import capi unsafe "tree_sitter/api.h &ts_tree_delete"
  p_ts_tree_delete ::
    FunPtr (
      Ptr TSTree ->
      IO ()
    )

{-|
  Get the root node of the syntax tree.

  > TSNode ts_tree_root_node(const TSTree *self);
-}
ts_tree_root_node ::
  ConstPtr TSTree ->
  IO TSNode
ts_tree_root_node :: ConstPtr TSTree -> IO TSNode
ts_tree_root_node = \ConstPtr TSTree
self ->
  (Ptr TSNode -> IO TSNode) -> IO TSNode
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr TSNode -> IO TSNode) -> IO TSNode)
-> (Ptr TSNode -> IO TSNode) -> IO TSNode
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
result_p -> do
    ConstPtr TSTree -> Ptr TSNode -> IO ()
_wrap_ts_tree_root_node ConstPtr TSTree
self Ptr TSNode
result_p
    Ptr TSNode -> IO TSNode
forall a. Storable a => Ptr a -> IO a
peek Ptr TSNode
result_p
{-# INLINE ts_tree_root_node #-}



foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_tree_root_node"
  _wrap_ts_tree_root_node ::
    ConstPtr TSTree ->
    Ptr TSNode ->
    IO ()

{-|
  Get the root node of the syntax tree, but with its position
  shifted forward by the given offset.

  > TSNode ts_tree_root_node_with_offset(
  >   const TSTree *self,
  >   uint32_t offset_bytes,
  >   TSPoint offset_extent
  > );
-}
ts_tree_root_node_with_offset ::
  ConstPtr TSTree ->
  ( Word32 ) ->
{-# LINE 1499 "src/TreeSitter/CApi.hsc" #-}
  TSPoint ->
  IO TSNode
ts_tree_root_node_with_offset :: ConstPtr TSTree -> Word32 -> TSPoint -> IO TSNode
ts_tree_root_node_with_offset = \ConstPtr TSTree
self Word32
offset_bytes TSPoint
offset_extent ->
  (Ptr TSNode -> IO TSNode) -> IO TSNode
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr TSNode -> IO TSNode) -> IO TSNode)
-> (Ptr TSNode -> IO TSNode) -> IO TSNode
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
result_p -> do
    TSPoint -> (Ptr TSPoint -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TSPoint
offset_extent ((Ptr TSPoint -> IO ()) -> IO ())
-> (Ptr TSPoint -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TSPoint
offset_extent_p ->
      ConstPtr TSTree -> Word32 -> Ptr TSPoint -> Ptr TSNode -> IO ()
_wrap_ts_tree_root_node_with_offset ConstPtr TSTree
self Word32
offset_bytes Ptr TSPoint
offset_extent_p Ptr TSNode
result_p
    Ptr TSNode -> IO TSNode
forall a. Storable a => Ptr a -> IO a
peek Ptr TSNode
result_p
{-# INLINE ts_tree_root_node_with_offset #-}



foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_tree_root_node_with_offset"
  _wrap_ts_tree_root_node_with_offset ::
    ConstPtr TSTree ->
    ( Word32 ) ->
{-# LINE 1524 "src/TreeSitter/CApi.hsc" #-}
    Ptr TSPoint ->
    Ptr TSNode ->
    IO ()

{-|
  Get the language that was used to parse the syntax tree.

  > const TSLanguage *ts_tree_language(const TSTree *self);
-}
foreign import capi unsafe "tree_sitter/api.h ts_tree_language"
  ts_tree_language ::
    Ptr TSTree ->
    IO (ConstPtr TSLanguage)

{-|
  Get the array of included ranges that was used to parse the syntax tree.

  The returned pointer must be freed by the caller.

  > TSRange *ts_tree_included_ranges(const TSTree *self, uint32_t *length);
-}
foreign import capi unsafe "tree_sitter/api.h ts_tree_included_ranges"
  ts_tree_included_ranges ::
    Ptr TSTree ->
    Ptr ( Word32 ) ->
{-# LINE 1549 "src/TreeSitter/CApi.hsc" #-}
    IO ( Ptr TSRange )

{-|
  Edit the syntax tree to keep it in sync with source code that has been
  edited.

  You must describe the edit both in terms of byte offsets and in terms of
  (row, column) coordinates.

  > void ts_tree_edit(TSTree *self, const TSInputEdit *edit);
-}
foreign import capi unsafe "tree_sitter/api.h ts_tree_edit"
  ts_tree_edit ::
    Ptr TSTree ->
    Ptr TSInputEdit ->
    IO ()

{-|
  Compare an old edited syntax tree to a new syntax tree representing the same
  document, returning an array of ranges whose syntactic structure has changed.

  For this to work correctly, the old syntax tree must have been edited such
  that its ranges match up to the new tree. Generally, you'll want to call
  this function right after calling one of the @`ts_parser_parse`@ functions.
  You need to pass the old tree that was passed to parse, as well as the new
  tree that was returned from that function.

  The returned array is allocated using @malloc@ and the caller is responsible
  for freeing it using @free@. The length of the array will be written to the
  given @length@ pointer.

  > TSRange *ts_tree_get_changed_ranges(
  >   const TSTree *old_tree,
  >   const TSTree *new_tree,
  >   uint32_t *length
  > );
-}
foreign import capi unsafe "tree_sitter/api.h ts_tree_get_changed_ranges"
  ts_tree_get_changed_ranges ::
    Ptr TSTree ->
    Ptr TSTree ->
    Ptr ( Word32 ) ->
{-# LINE 1591 "src/TreeSitter/CApi.hsc" #-}
    IO ( Ptr TSRange )

{-|
  Write a DOT graph describing the syntax tree to the given file.

  > void ts_tree_print_dot_graph(const TSTree *self, int file_descriptor);
-}
foreign import capi unsafe "tree_sitter/api.h ts_tree_print_dot_graph"
  ts_tree_print_dot_graph ::
    Ptr TSTree ->
    ( Int32 ) ->
{-# LINE 1602 "src/TreeSitter/CApi.hsc" #-}
    IO ()

{------------------}
{- Section - Node -}
{------------------}

{-|
  Get the node's type as a null-terminated string.

  > const char *ts_node_type(TSNode self);
-}
ts_node_type ::
  TSNode ->
  IO (ConstPtr CChar)
ts_node_type :: TSNode -> IO (ConstPtr CChar)
ts_node_type = \TSNode
self ->
  TSNode
-> (Ptr TSNode -> IO (ConstPtr CChar)) -> IO (ConstPtr CChar)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TSNode
self ((Ptr TSNode -> IO (ConstPtr CChar)) -> IO (ConstPtr CChar))
-> (Ptr TSNode -> IO (ConstPtr CChar)) -> IO (ConstPtr CChar)
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
self_p ->
    Ptr TSNode -> IO (ConstPtr CChar)
_wrap_ts_node_type Ptr TSNode
self_p
{-# INLINE ts_node_type #-}



foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_node_type"
  _wrap_ts_node_type ::
    Ptr TSNode ->
    IO (ConstPtr CChar)

{-|
  Get the node's type as a numerical id.

  > TSSymbol ts_node_symbol(TSNode self);
-}
ts_node_symbol ::
  TSNode ->
  IO TSSymbol
ts_node_symbol :: TSNode -> IO TSSymbol
ts_node_symbol = \TSNode
self ->
  TSNode -> (Ptr TSNode -> IO TSSymbol) -> IO TSSymbol
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TSNode
self ((Ptr TSNode -> IO TSSymbol) -> IO TSSymbol)
-> (Ptr TSNode -> IO TSSymbol) -> IO TSSymbol
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
self_p ->
    Ptr TSNode -> IO TSSymbol
_wrap_ts_node_symbol Ptr TSNode
self_p
{-# INLINE ts_node_symbol #-}



foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_node_symbol"
  _wrap_ts_node_symbol ::
    Ptr TSNode ->
    IO TSSymbol

{-|
  Get the node's language.

  > const TSLanguage *ts_node_language(TSNode self);
-}
ts_node_language ::
  TSNode ->
  IO (ConstPtr TSLanguage)
ts_node_language :: TSNode -> IO (ConstPtr TSLanguage)
ts_node_language = \TSNode
self ->
  TSNode
-> (Ptr TSNode -> IO (ConstPtr TSLanguage))
-> IO (ConstPtr TSLanguage)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TSNode
self ((Ptr TSNode -> IO (ConstPtr TSLanguage))
 -> IO (ConstPtr TSLanguage))
-> (Ptr TSNode -> IO (ConstPtr TSLanguage))
-> IO (ConstPtr TSLanguage)
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
self_p ->
    Ptr TSNode -> IO (ConstPtr TSLanguage)
_wrap_ts_node_language Ptr TSNode
self_p
{-# INLINE ts_node_language #-}



foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_node_language"
  _wrap_ts_node_language ::
    Ptr TSNode ->
    IO (ConstPtr TSLanguage)

{-|
  Get the node's type as it appears in the grammar ignoring aliases as a
  null-terminated string.

  > const char *ts_node_grammar_type(TSNode self);
-}
ts_node_grammar_type ::
  TSNode ->
  IO (ConstPtr CChar)
ts_node_grammar_type :: TSNode -> IO (ConstPtr CChar)
ts_node_grammar_type = \TSNode
self ->
  TSNode
-> (Ptr TSNode -> IO (ConstPtr CChar)) -> IO (ConstPtr CChar)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TSNode
self ((Ptr TSNode -> IO (ConstPtr CChar)) -> IO (ConstPtr CChar))
-> (Ptr TSNode -> IO (ConstPtr CChar)) -> IO (ConstPtr CChar)
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
self_p ->
    Ptr TSNode -> IO (ConstPtr CChar)
_wrap_ts_node_grammar_type Ptr TSNode
self_p
{-# INLINE ts_node_grammar_type #-}



foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_node_grammar_type"
  _wrap_ts_node_grammar_type ::
    Ptr TSNode ->
    IO (ConstPtr CChar)

{-|
  Get the node's type as a numerical id as it appears in the grammar ignoring
  aliases. This should be used in @`ts_language_next_state`@ instead of
  @`ts_node_symbol`@.

  > TSSymbol ts_node_grammar_symbol(TSNode self);
-}
ts_node_grammar_symbol ::
  TSNode ->
  IO TSSymbol
ts_node_grammar_symbol :: TSNode -> IO TSSymbol
ts_node_grammar_symbol = \TSNode
self ->
  TSNode -> (Ptr TSNode -> IO TSSymbol) -> IO TSSymbol
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TSNode
self ((Ptr TSNode -> IO TSSymbol) -> IO TSSymbol)
-> (Ptr TSNode -> IO TSSymbol) -> IO TSSymbol
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
self_p ->
    Ptr TSNode -> IO TSSymbol
_wrap_ts_node_grammar_symbol Ptr TSNode
self_p
{-# INLINE ts_node_grammar_symbol #-}



foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_node_grammar_symbol"
  _wrap_ts_node_grammar_symbol ::
    Ptr TSNode ->
    IO TSSymbol

{-|
  Get the node's start byte.

  > uint32_t ts_node_start_byte(TSNode self);
-}
ts_node_start_byte ::
  TSNode ->
  IO ( Word32 )
{-# LINE 1744 "src/TreeSitter/CApi.hsc" #-}
ts_node_start_byte :: TSNode -> IO Word32
ts_node_start_byte = \TSNode
self ->
  TSNode -> (Ptr TSNode -> IO Word32) -> IO Word32
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TSNode
self ((Ptr TSNode -> IO Word32) -> IO Word32)
-> (Ptr TSNode -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
self_p ->
    Ptr TSNode -> IO Word32
_wrap_ts_node_start_byte Ptr TSNode
self_p
{-# INLINE ts_node_start_byte #-}



foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_node_start_byte"
  _wrap_ts_node_start_byte ::
    Ptr TSNode ->
    IO ( Word32 )
{-# LINE 1760 "src/TreeSitter/CApi.hsc" #-}

{-|
  Get the node's start position in terms of rows and columns.

  > TSPoint ts_node_start_point(TSNode self);
-}
ts_node_start_point ::
  TSNode ->
  IO TSPoint
ts_node_start_point :: TSNode -> IO TSPoint
ts_node_start_point = \TSNode
self ->
  (Ptr TSPoint -> IO TSPoint) -> IO TSPoint
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr TSPoint -> IO TSPoint) -> IO TSPoint)
-> (Ptr TSPoint -> IO TSPoint) -> IO TSPoint
forall a b. (a -> b) -> a -> b
$ \Ptr TSPoint
result_p -> do
    TSNode -> (Ptr TSNode -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TSNode
self ((Ptr TSNode -> IO ()) -> IO ()) -> (Ptr TSNode -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
self_p ->
      Ptr TSNode -> Ptr TSPoint -> IO ()
_wrap_ts_node_start_point Ptr TSNode
self_p Ptr TSPoint
result_p
    Ptr TSPoint -> IO TSPoint
forall a. Storable a => Ptr a -> IO a
peek Ptr TSPoint
result_p
{-# INLINE ts_node_start_point #-}



foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_node_start_point"
  _wrap_ts_node_start_point ::
    Ptr TSNode ->
    Ptr TSPoint ->
    IO ()

{-|
  Get the node's end byte.

  > uint32_t ts_node_end_byte(TSNode self);
-}
ts_node_end_byte ::
  TSNode ->
  IO ( Word32 )
{-# LINE 1797 "src/TreeSitter/CApi.hsc" #-}
ts_node_end_byte :: TSNode -> IO Word32
ts_node_end_byte = \TSNode
self ->
  TSNode -> (Ptr TSNode -> IO Word32) -> IO Word32
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TSNode
self ((Ptr TSNode -> IO Word32) -> IO Word32)
-> (Ptr TSNode -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
self_p ->
    Ptr TSNode -> IO Word32
_wrap_ts_node_end_byte Ptr TSNode
self_p
{-# INLINE ts_node_end_byte #-}



foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_node_end_byte"
  _wrap_ts_node_end_byte ::
    Ptr TSNode ->
    IO ( Word32 )
{-# LINE 1813 "src/TreeSitter/CApi.hsc" #-}

{-|
  Get the node's end position in terms of rows and columns.

  > TSPoint ts_node_end_point(TSNode self);
-}
ts_node_end_point ::
  TSNode ->
  IO TSPoint
ts_node_end_point :: TSNode -> IO TSPoint
ts_node_end_point = \TSNode
self ->
  (Ptr TSPoint -> IO TSPoint) -> IO TSPoint
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr TSPoint -> IO TSPoint) -> IO TSPoint)
-> (Ptr TSPoint -> IO TSPoint) -> IO TSPoint
forall a b. (a -> b) -> a -> b
$ \Ptr TSPoint
result_p -> do
    TSNode -> (Ptr TSNode -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TSNode
self ((Ptr TSNode -> IO ()) -> IO ()) -> (Ptr TSNode -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
self_p ->
      Ptr TSNode -> Ptr TSPoint -> IO ()
_wrap_ts_node_end_point Ptr TSNode
self_p Ptr TSPoint
result_p
    Ptr TSPoint -> IO TSPoint
forall a. Storable a => Ptr a -> IO a
peek Ptr TSPoint
result_p
{-# INLINE ts_node_end_point #-}



foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_node_end_point"
  _wrap_ts_node_end_point ::
    Ptr TSNode ->
    Ptr TSPoint ->
    IO ()

{-|
  Get an S-expression representing the node as a string.

  This string is allocated with @malloc@ and the caller is responsible for
  freeing it using @free@.

  > char *ts_node_string(TSNode self);
-}
ts_node_string ::
  TSNode ->
  IO (Ptr CChar)
ts_node_string :: TSNode -> IO (Ptr CChar)
ts_node_string = \TSNode
self ->
  TSNode -> (Ptr TSNode -> IO (Ptr CChar)) -> IO (Ptr CChar)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TSNode
self ((Ptr TSNode -> IO (Ptr CChar)) -> IO (Ptr CChar))
-> (Ptr TSNode -> IO (Ptr CChar)) -> IO (Ptr CChar)
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
self_p ->
    Ptr TSNode -> IO (Ptr CChar)
_wrap_ts_node_string Ptr TSNode
self_p
{-# INLINE ts_node_string #-}



foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_node_string"
  _wrap_ts_node_string ::
    Ptr TSNode ->
    IO (Ptr CChar)

{-|
  Check if the node is null. Functions like @`ts_node_child`@ and
  @`ts_node_next_sibling`@ will return a null node to indicate that no such node
  was found.

  > bool ts_node_is_null(TSNode self);
-}
ts_node_is_null ::
  TSNode ->
  IO CBool
ts_node_is_null :: TSNode -> IO CBool
ts_node_is_null = \TSNode
self ->
  TSNode -> (Ptr TSNode -> IO CBool) -> IO CBool
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TSNode
self ((Ptr TSNode -> IO CBool) -> IO CBool)
-> (Ptr TSNode -> IO CBool) -> IO CBool
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
self_p ->
    Ptr TSNode -> IO CBool
_wrap_ts_node_is_null Ptr TSNode
self_p
{-# INLINE ts_node_is_null #-}



foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_node_is_null"
  _wrap_ts_node_is_null ::
    Ptr TSNode ->
    IO CBool

{-|
  Check if the node is *named*. Named nodes correspond to named rules in the
  grammar, whereas *anonymous* nodes correspond to string literals in the
  grammar.

  > bool ts_node_is_named(TSNode self);
-}
ts_node_is_named ::
  TSNode ->
  IO CBool
ts_node_is_named :: TSNode -> IO CBool
ts_node_is_named = \TSNode
self ->
  TSNode -> (Ptr TSNode -> IO CBool) -> IO CBool
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TSNode
self ((Ptr TSNode -> IO CBool) -> IO CBool)
-> (Ptr TSNode -> IO CBool) -> IO CBool
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
self_p ->
    Ptr TSNode -> IO CBool
_wrap_ts_node_is_named Ptr TSNode
self_p
{-# INLINE ts_node_is_named #-}



foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_node_is_named"
  _wrap_ts_node_is_named ::
    Ptr TSNode ->
    IO CBool

{-|
  Check if the node is *missing*. Missing nodes are inserted by the parser in
  order to recover from certain kinds of syntax errors.

  > bool ts_node_is_missing(TSNode self);
-}
ts_node_is_missing ::
  TSNode ->
  IO CBool
ts_node_is_missing :: TSNode -> IO CBool
ts_node_is_missing = \TSNode
self ->
  TSNode -> (Ptr TSNode -> IO CBool) -> IO CBool
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TSNode
self ((Ptr TSNode -> IO CBool) -> IO CBool)
-> (Ptr TSNode -> IO CBool) -> IO CBool
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
self_p ->
    Ptr TSNode -> IO CBool
_wrap_ts_node_is_missing Ptr TSNode
self_p
{-# INLINE ts_node_is_missing #-}



foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_node_is_missing"
  _wrap_ts_node_is_missing ::
    Ptr TSNode ->
    IO CBool

{-|
  Check if the node is *extra*. Extra nodes represent things like comments,
  which are not required the grammar, but can appear anywhere.

  > bool ts_node_is_extra(TSNode self);
-}
ts_node_is_extra ::
  TSNode ->
  IO CBool
ts_node_is_extra :: TSNode -> IO CBool
ts_node_is_extra = \TSNode
self ->
  TSNode -> (Ptr TSNode -> IO CBool) -> IO CBool
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TSNode
self ((Ptr TSNode -> IO CBool) -> IO CBool)
-> (Ptr TSNode -> IO CBool) -> IO CBool
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
self_p ->
    Ptr TSNode -> IO CBool
_wrap_ts_node_is_extra Ptr TSNode
self_p
{-# INLINE ts_node_is_extra #-}



foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_node_is_extra"
  _wrap_ts_node_is_extra ::
    Ptr TSNode ->
    IO CBool

{-|
  Check if a syntax node has been edited.

  > bool ts_node_has_changes(TSNode self);
-}
ts_node_has_changes ::
  TSNode ->
  IO CBool
ts_node_has_changes :: TSNode -> IO CBool
ts_node_has_changes = \TSNode
self ->
  TSNode -> (Ptr TSNode -> IO CBool) -> IO CBool
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TSNode
self ((Ptr TSNode -> IO CBool) -> IO CBool)
-> (Ptr TSNode -> IO CBool) -> IO CBool
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
self_p ->
    Ptr TSNode -> IO CBool
_wrap_ts_node_has_changes Ptr TSNode
self_p
{-# INLINE ts_node_has_changes #-}



foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_node_has_changes"
  _wrap_ts_node_has_changes ::
    Ptr TSNode ->
    IO CBool

{-|
  Check if the node is a syntax error or contains any syntax errors.

  > bool ts_node_has_error(TSNode self);
-}
ts_node_has_error ::
  TSNode ->
  IO CBool
ts_node_has_error :: TSNode -> IO CBool
ts_node_has_error = \TSNode
self ->
  TSNode -> (Ptr TSNode -> IO CBool) -> IO CBool
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TSNode
self ((Ptr TSNode -> IO CBool) -> IO CBool)
-> (Ptr TSNode -> IO CBool) -> IO CBool
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
self_p ->
    Ptr TSNode -> IO CBool
_wrap_ts_node_has_error Ptr TSNode
self_p
{-# INLINE ts_node_has_error #-}



foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_node_has_error"
  _wrap_ts_node_has_error ::
    Ptr TSNode ->
    IO CBool

{-|
  Check if the node is a syntax error.

  > bool ts_node_is_error (TSNode self)
-}
ts_node_is_error ::
  TSNode ->
  IO CBool
ts_node_is_error :: TSNode -> IO CBool
ts_node_is_error = \TSNode
self ->
  TSNode -> (Ptr TSNode -> IO CBool) -> IO CBool
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TSNode
self ((Ptr TSNode -> IO CBool) -> IO CBool)
-> (Ptr TSNode -> IO CBool) -> IO CBool
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
self_p ->
    Ptr TSNode -> IO CBool
_wrap_ts_node_is_error Ptr TSNode
self_p
{-# INLINE ts_node_is_error #-}



foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_node_is_error"
  _wrap_ts_node_is_error ::
    Ptr TSNode ->
    IO CBool

{-|
  Get this node's parse state.

  > TSStateId ts_node_parse_state (TSNode self)
-}
ts_node_parse_state ::
  TSNode ->
  IO TSStateId
ts_node_parse_state :: TSNode -> IO TSStateId
ts_node_parse_state = \TSNode
self ->
  TSNode -> (Ptr TSNode -> IO TSStateId) -> IO TSStateId
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TSNode
self ((Ptr TSNode -> IO TSStateId) -> IO TSStateId)
-> (Ptr TSNode -> IO TSStateId) -> IO TSStateId
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
self_p ->
    Ptr TSNode -> IO TSStateId
_wrap_ts_node_parse_state Ptr TSNode
self_p
{-# INLINE ts_node_parse_state #-}



foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_node_parse_state"
  _wrap_ts_node_parse_state ::
    Ptr TSNode ->
    IO TSStateId

{-|
  Get the parse state after this node.

  > TSStateId ts_node_next_parse_state (TSNode self)
-}
ts_node_next_parse_state ::
  TSNode ->
  IO TSStateId
ts_node_next_parse_state :: TSNode -> IO TSStateId
ts_node_next_parse_state = \TSNode
self ->
  TSNode -> (Ptr TSNode -> IO TSStateId) -> IO TSStateId
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TSNode
self ((Ptr TSNode -> IO TSStateId) -> IO TSStateId)
-> (Ptr TSNode -> IO TSStateId) -> IO TSStateId
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
self_p ->
    Ptr TSNode -> IO TSStateId
_wrap_ts_node_next_parse_state Ptr TSNode
self_p
{-# INLINE ts_node_next_parse_state #-}



foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_node_next_parse_state"
  _wrap_ts_node_next_parse_state ::
    Ptr TSNode ->
    IO TSStateId

{-|
  Get the node's immediate parent.

  > TSNode ts_node_parent(TSNode self);
-}
ts_node_parent ::
  TSNode ->
  IO TSNode
ts_node_parent :: TSNode -> IO TSNode
ts_node_parent = \TSNode
self ->
  (Ptr TSNode -> IO TSNode) -> IO TSNode
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr TSNode -> IO TSNode) -> IO TSNode)
-> (Ptr TSNode -> IO TSNode) -> IO TSNode
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
result_p -> do
    TSNode -> (Ptr TSNode -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TSNode
self ((Ptr TSNode -> IO ()) -> IO ()) -> (Ptr TSNode -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
self_p ->
      Ptr TSNode -> Ptr TSNode -> IO ()
_wrap_ts_node_parent Ptr TSNode
self_p Ptr TSNode
result_p
    Ptr TSNode -> IO TSNode
forall a. Storable a => Ptr a -> IO a
peek Ptr TSNode
result_p
{-# INLINE ts_node_parent #-}



foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_node_parent"
  _wrap_ts_node_parent ::
    Ptr TSNode ->
    Ptr TSNode ->
    IO ()

{-|
  Get the node that contains @descendant@.

  Note that this can return @descendant@ itself.

  > TSNode ts_node_child_with_descendant(TSNode self, TSNode descendant);
-}
ts_node_child_with_descendant ::
  TSNode ->
  TSNode ->
  IO TSNode
ts_node_child_with_descendant :: TSNode -> TSNode -> IO TSNode
ts_node_child_with_descendant = \TSNode
self TSNode
descendant ->
  (Ptr TSNode -> IO TSNode) -> IO TSNode
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr TSNode -> IO TSNode) -> IO TSNode)
-> (Ptr TSNode -> IO TSNode) -> IO TSNode
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
result_p -> do
    TSNode -> (Ptr TSNode -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TSNode
self ((Ptr TSNode -> IO ()) -> IO ()) -> (Ptr TSNode -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
self_p ->
      TSNode -> (Ptr TSNode -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TSNode
descendant ((Ptr TSNode -> IO ()) -> IO ()) -> (Ptr TSNode -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
descendant_p ->
        Ptr TSNode -> Ptr TSNode -> Ptr TSNode -> IO ()
_wrap_ts_node_child_with_descendant Ptr TSNode
self_p Ptr TSNode
descendant_p Ptr TSNode
result_p
    Ptr TSNode -> IO TSNode
forall a. Storable a => Ptr a -> IO a
peek Ptr TSNode
result_p
{-# INLINE ts_node_child_with_descendant #-}



foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_node_child_with_descendant"
  _wrap_ts_node_child_with_descendant ::
    Ptr TSNode ->
    Ptr TSNode ->
    Ptr TSNode ->
    IO ()

{-|
  Get the node's child at the given index, where zero represents the first
  child.

  > TSNode ts_node_child(TSNode self, uint32_t child_index);
-}
ts_node_child ::
  TSNode ->
  ( Word32 ) ->
{-# LINE 2171 "src/TreeSitter/CApi.hsc" #-}
  IO TSNode
ts_node_child :: TSNode -> Word32 -> IO TSNode
ts_node_child = \TSNode
self Word32
child_index ->
  (Ptr TSNode -> IO TSNode) -> IO TSNode
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr TSNode -> IO TSNode) -> IO TSNode)
-> (Ptr TSNode -> IO TSNode) -> IO TSNode
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
result_p -> do
    TSNode -> (Ptr TSNode -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TSNode
self ((Ptr TSNode -> IO ()) -> IO ()) -> (Ptr TSNode -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
self_p ->
      Ptr TSNode -> Word32 -> Ptr TSNode -> IO ()
_wrap_ts_node_child Ptr TSNode
self_p Word32
child_index Ptr TSNode
result_p
    Ptr TSNode -> IO TSNode
forall a. Storable a => Ptr a -> IO a
peek Ptr TSNode
result_p
{-# INLINE ts_node_child #-}



foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_node_child"
  _wrap_ts_node_child ::
    Ptr TSNode ->
    ( Word32 ) ->
{-# LINE 2190 "src/TreeSitter/CApi.hsc" #-}
    Ptr TSNode ->
    IO ()

{-|
  Get the field name for node's child at the given index, where zero represents
  the first child. Returns @NULL@ if no field is found.

  > const char *ts_node_field_name_for_child(TSNode self, uint32_t child_index);
-}
ts_node_field_name_for_child ::
  TSNode ->
  ( Word32 ) ->
{-# LINE 2202 "src/TreeSitter/CApi.hsc" #-}
  IO (ConstPtr CChar)
ts_node_field_name_for_child :: TSNode -> Word32 -> IO (ConstPtr CChar)
ts_node_field_name_for_child = \TSNode
self Word32
child_index ->
  TSNode
-> (Ptr TSNode -> IO (ConstPtr CChar)) -> IO (ConstPtr CChar)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TSNode
self ((Ptr TSNode -> IO (ConstPtr CChar)) -> IO (ConstPtr CChar))
-> (Ptr TSNode -> IO (ConstPtr CChar)) -> IO (ConstPtr CChar)
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
self_p ->
    Ptr TSNode -> Word32 -> IO (ConstPtr CChar)
_wrap_ts_node_field_name_for_child Ptr TSNode
self_p Word32
child_index
{-# INLINE ts_node_field_name_for_child #-}



foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_node_field_name_for_child"
  _wrap_ts_node_field_name_for_child ::
    Ptr TSNode ->
    ( Word32 ) ->
{-# LINE 2219 "src/TreeSitter/CApi.hsc" #-}
    IO (ConstPtr CChar)

{-|
  Get the field name for node's named child at the given index, where zero
  represents the first named child. Returns @NULL@, if no field is found.

  > const char *ts_node_field_name_for_named_child(TSNode self, uint32_t named_child_index);
-}
ts_node_field_name_for_named_child ::
  TSNode ->
  ( Word32 ) ->
{-# LINE 2230 "src/TreeSitter/CApi.hsc" #-}
  IO (ConstPtr CChar)
ts_node_field_name_for_named_child :: TSNode -> Word32 -> IO (ConstPtr CChar)
ts_node_field_name_for_named_child = \TSNode
self Word32
child_index ->
  TSNode
-> (Ptr TSNode -> IO (ConstPtr CChar)) -> IO (ConstPtr CChar)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TSNode
self ((Ptr TSNode -> IO (ConstPtr CChar)) -> IO (ConstPtr CChar))
-> (Ptr TSNode -> IO (ConstPtr CChar)) -> IO (ConstPtr CChar)
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
self_p ->
    Ptr TSNode -> Word32 -> IO (ConstPtr CChar)
_wrap_ts_node_field_name_for_named_child Ptr TSNode
self_p Word32
child_index
{-# INLINE ts_node_field_name_for_named_child #-}



foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_node_field_name_for_named_child"
  _wrap_ts_node_field_name_for_named_child ::
    Ptr TSNode ->
    ( Word32 ) ->
{-# LINE 2247 "src/TreeSitter/CApi.hsc" #-}
    IO (ConstPtr CChar)

{-|
  Get the node's number of children.

  > uint32_t ts_node_child_count(TSNode self);
-}
ts_node_child_count ::
  TSNode ->
  IO ( Word32 )
{-# LINE 2257 "src/TreeSitter/CApi.hsc" #-}
ts_node_child_count = \self ->
  with self $ \self_p ->
    _wrap_ts_node_child_count self_p
{-# INLINE ts_node_child_count #-}



foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_node_child_count"
  _wrap_ts_node_child_count ::
    Ptr TSNode ->
    IO ( Word32 )
{-# LINE 2273 "src/TreeSitter/CApi.hsc" #-}

{-|
  Get the node's *named* child at the given index.

  See also @`ts_node_is_named`@.

  > TSNode ts_node_named_child(TSNode self, uint32_t child_index);
-}
ts_node_named_child ::
  TSNode ->
  Word32 ->
{-# LINE 2284 "src/TreeSitter/CApi.hsc" #-}
  IO TSNode
ts_node_named_child :: TSNode -> Word32 -> IO TSNode
ts_node_named_child = \TSNode
self Word32
child_index ->
  (Ptr TSNode -> IO TSNode) -> IO TSNode
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr TSNode -> IO TSNode) -> IO TSNode)
-> (Ptr TSNode -> IO TSNode) -> IO TSNode
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
result_p -> do
    TSNode -> (Ptr TSNode -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TSNode
self ((Ptr TSNode -> IO ()) -> IO ()) -> (Ptr TSNode -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
self_p ->
      Ptr TSNode -> Word32 -> Ptr TSNode -> IO ()
_wrap_ts_node_named_child Ptr TSNode
self_p Word32
child_index Ptr TSNode
result_p
    Ptr TSNode -> IO TSNode
forall a. Storable a => Ptr a -> IO a
peek Ptr TSNode
result_p
{-# INLINE ts_node_named_child #-}



foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_node_named_child"
  _wrap_ts_node_named_child ::
    Ptr TSNode ->
    ( Word32 ) ->
{-# LINE 2303 "src/TreeSitter/CApi.hsc" #-}
    Ptr TSNode ->
    IO ()

{-|
  Get the node's number of *named* children.

  See also @`ts_node_is_named`@.

  > uint32_t ts_node_named_child_count(TSNode self);
-}
ts_node_named_child_count ::
  TSNode ->
  IO ( Word32 )
{-# LINE 2316 "src/TreeSitter/CApi.hsc" #-}
ts_node_named_child_count = \self ->
  with self $ \self_p ->
    _wrap_ts_node_named_child_count self_p
{-# INLINE ts_node_named_child_count #-}



foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_node_named_child_count"
  _wrap_ts_node_named_child_count ::
    Ptr TSNode ->
    IO ( Word32 )
{-# LINE 2332 "src/TreeSitter/CApi.hsc" #-}

{-|
  Get the node's child with the given field name.

  > TSNode ts_node_child_by_field_name(
  >   TSNode self,
  >   const char *name,
  >   uint32_t name_length
  > );
-}
ts_node_child_by_field_name ::
  TSNode ->
  ConstPtr CChar ->
  ( Word32 ) ->
{-# LINE 2346 "src/TreeSitter/CApi.hsc" #-}
  IO TSNode
ts_node_child_by_field_name :: TSNode -> ConstPtr CChar -> Word32 -> IO TSNode
ts_node_child_by_field_name = \TSNode
self ConstPtr CChar
name Word32
name_length ->
  (Ptr TSNode -> IO TSNode) -> IO TSNode
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr TSNode -> IO TSNode) -> IO TSNode)
-> (Ptr TSNode -> IO TSNode) -> IO TSNode
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
result_p -> do
    TSNode -> (Ptr TSNode -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TSNode
self ((Ptr TSNode -> IO ()) -> IO ()) -> (Ptr TSNode -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
self_p ->
      Ptr TSNode -> ConstPtr CChar -> Word32 -> Ptr TSNode -> IO ()
_wrap_ts_node_child_by_field_name Ptr TSNode
self_p ConstPtr CChar
name Word32
name_length Ptr TSNode
result_p
    Ptr TSNode -> IO TSNode
forall a. Storable a => Ptr a -> IO a
peek Ptr TSNode
result_p
{-# INLINE ts_node_child_by_field_name #-}



foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_node_child_by_field_name"
  _wrap_ts_node_child_by_field_name ::
    Ptr TSNode ->
    ConstPtr CChar ->
    ( Word32 ) ->
{-# LINE 2371 "src/TreeSitter/CApi.hsc" #-}
    Ptr TSNode ->
    IO ()

{-|
  Get the node's child with the given numerical field id.

  You can convert a field name to an id using the
  @`ts_language_field_id_for_name`@ function.

  > TSNode ts_node_child_by_field_id(TSNode self, TSFieldId field_id);
-}
ts_node_child_by_field_id ::
  TSNode ->
  TSFieldId ->
  IO TSNode
ts_node_child_by_field_id :: TSNode -> TSFieldId -> IO TSNode
ts_node_child_by_field_id = \TSNode
self TSFieldId
field_id ->
  (Ptr TSNode -> IO TSNode) -> IO TSNode
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr TSNode -> IO TSNode) -> IO TSNode)
-> (Ptr TSNode -> IO TSNode) -> IO TSNode
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
result_p -> do
    TSNode -> (Ptr TSNode -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TSNode
self ((Ptr TSNode -> IO ()) -> IO ()) -> (Ptr TSNode -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
self_p ->
      Ptr TSNode -> TSFieldId -> Ptr TSNode -> IO ()
_wrap_ts_node_child_by_field_id Ptr TSNode
self_p TSFieldId
field_id Ptr TSNode
result_p
    Ptr TSNode -> IO TSNode
forall a. Storable a => Ptr a -> IO a
peek Ptr TSNode
result_p
{-# INLINE ts_node_child_by_field_id #-}



foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_node_child_by_field_id"
  _wrap_ts_node_child_by_field_id ::
    Ptr TSNode ->
    TSFieldId ->
    Ptr TSNode ->
    IO ()

{-|
  Get the node's next sibling.

  > TSNode ts_node_next_sibling(TSNode self);
-}
ts_node_next_sibling ::
  TSNode ->
  IO TSNode
ts_node_next_sibling :: TSNode -> IO TSNode
ts_node_next_sibling = \TSNode
self ->
  (Ptr TSNode -> IO TSNode) -> IO TSNode
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr TSNode -> IO TSNode) -> IO TSNode)
-> (Ptr TSNode -> IO TSNode) -> IO TSNode
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
result_p -> do
    TSNode -> (Ptr TSNode -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TSNode
self ((Ptr TSNode -> IO ()) -> IO ()) -> (Ptr TSNode -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
self_p ->
      Ptr TSNode -> Ptr TSNode -> IO ()
_wrap_ts_node_next_sibling Ptr TSNode
self_p Ptr TSNode
result_p
    Ptr TSNode -> IO TSNode
forall a. Storable a => Ptr a -> IO a
peek Ptr TSNode
result_p
{-# INLINE ts_node_next_sibling #-}



foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_node_next_sibling"
  _wrap_ts_node_next_sibling ::
    Ptr TSNode ->
    Ptr TSNode ->
    IO ()

{-|
  Get the node's previous sibling.

  > TSNode ts_node_prev_sibling(TSNode self);
-}
ts_node_prev_sibling ::
  TSNode ->
  IO TSNode
ts_node_prev_sibling :: TSNode -> IO TSNode
ts_node_prev_sibling = \TSNode
self ->
  (Ptr TSNode -> IO TSNode) -> IO TSNode
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr TSNode -> IO TSNode) -> IO TSNode)
-> (Ptr TSNode -> IO TSNode) -> IO TSNode
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
result_p -> do
    TSNode -> (Ptr TSNode -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TSNode
self ((Ptr TSNode -> IO ()) -> IO ()) -> (Ptr TSNode -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
self_p ->
      Ptr TSNode -> Ptr TSNode -> IO ()
_wrap_ts_node_prev_sibling Ptr TSNode
self_p Ptr TSNode
result_p
    Ptr TSNode -> IO TSNode
forall a. Storable a => Ptr a -> IO a
peek Ptr TSNode
result_p
{-# INLINE ts_node_prev_sibling #-}



foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_node_prev_sibling"
  _wrap_ts_node_prev_sibling ::
    Ptr TSNode ->
    Ptr TSNode ->
    IO ()

{-|
  Get the node's next *named* sibling.

  > TSNode ts_node_next_named_sibling(TSNode self);
-}
ts_node_next_named_sibling ::
  TSNode ->
  IO TSNode
ts_node_next_named_sibling :: TSNode -> IO TSNode
ts_node_next_named_sibling = \TSNode
self ->
  (Ptr TSNode -> IO TSNode) -> IO TSNode
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr TSNode -> IO TSNode) -> IO TSNode)
-> (Ptr TSNode -> IO TSNode) -> IO TSNode
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
result_p -> do
    TSNode -> (Ptr TSNode -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TSNode
self ((Ptr TSNode -> IO ()) -> IO ()) -> (Ptr TSNode -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
self_p ->
      Ptr TSNode -> Ptr TSNode -> IO ()
_wrap_ts_node_next_named_sibling Ptr TSNode
self_p Ptr TSNode
result_p
    Ptr TSNode -> IO TSNode
forall a. Storable a => Ptr a -> IO a
peek Ptr TSNode
result_p
{-# INLINE ts_node_next_named_sibling #-}



foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_node_next_named_sibling"
  _wrap_ts_node_next_named_sibling ::
    Ptr TSNode ->
    Ptr TSNode ->
    IO ()

{-|
  Get the node's previous *named* sibling.

  > TSNode ts_node_prev_named_sibling(TSNode self);
-}
ts_node_prev_named_sibling ::
  TSNode ->
  IO TSNode
ts_node_prev_named_sibling :: TSNode -> IO TSNode
ts_node_prev_named_sibling = \TSNode
self ->
  (Ptr TSNode -> IO TSNode) -> IO TSNode
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr TSNode -> IO TSNode) -> IO TSNode)
-> (Ptr TSNode -> IO TSNode) -> IO TSNode
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
result_p -> do
    TSNode -> (Ptr TSNode -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TSNode
self ((Ptr TSNode -> IO ()) -> IO ()) -> (Ptr TSNode -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
self_p ->
      Ptr TSNode -> Ptr TSNode -> IO ()
_wrap_ts_node_prev_named_sibling Ptr TSNode
self_p Ptr TSNode
result_p
    Ptr TSNode -> IO TSNode
forall a. Storable a => Ptr a -> IO a
peek Ptr TSNode
result_p
{-# INLINE ts_node_prev_named_sibling #-}



foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_node_prev_named_sibling"
  _wrap_ts_node_prev_named_sibling ::
    Ptr TSNode ->
    Ptr TSNode ->
    IO ()

{-|
  Get the node's first child that extends beyond the given byte offset.

  > TSNode ts_node_first_child_for_byte(TSNode self, uint32_t byte);
-}
ts_node_first_child_for_byte ::
  TSNode ->
  ( Word32 ) ->
{-# LINE 2531 "src/TreeSitter/CApi.hsc" #-}
  IO TSNode
ts_node_first_child_for_byte :: TSNode -> Word32 -> IO TSNode
ts_node_first_child_for_byte = \TSNode
self Word32
byte ->
  (Ptr TSNode -> IO TSNode) -> IO TSNode
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr TSNode -> IO TSNode) -> IO TSNode)
-> (Ptr TSNode -> IO TSNode) -> IO TSNode
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
result_p -> do
    TSNode -> (Ptr TSNode -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TSNode
self ((Ptr TSNode -> IO ()) -> IO ()) -> (Ptr TSNode -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
self_p ->
      Ptr TSNode -> Word32 -> Ptr TSNode -> IO ()
_wrap_ts_node_first_child_for_byte Ptr TSNode
self_p Word32
byte Ptr TSNode
result_p
    Ptr TSNode -> IO TSNode
forall a. Storable a => Ptr a -> IO a
peek Ptr TSNode
result_p
{-# INLINE ts_node_first_child_for_byte #-}



foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_node_first_child_for_byte"
  _wrap_ts_node_first_child_for_byte ::
    Ptr TSNode ->
    ( Word32 ) ->
{-# LINE 2550 "src/TreeSitter/CApi.hsc" #-}
    Ptr TSNode ->
    IO ()

{-|
  Get the node's first named child that extends beyond the given byte offset.

  > TSNode ts_node_first_named_child_for_byte(TSNode self, uint32_t byte);
-}
ts_node_first_named_child_for_byte ::
  TSNode ->
  ( Word32 ) ->
{-# LINE 2561 "src/TreeSitter/CApi.hsc" #-}
  IO TSNode
ts_node_first_named_child_for_byte :: TSNode -> Word32 -> IO TSNode
ts_node_first_named_child_for_byte = \TSNode
self Word32
byte ->
  (Ptr TSNode -> IO TSNode) -> IO TSNode
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr TSNode -> IO TSNode) -> IO TSNode)
-> (Ptr TSNode -> IO TSNode) -> IO TSNode
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
result_p -> do
    TSNode -> (Ptr TSNode -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TSNode
self ((Ptr TSNode -> IO ()) -> IO ()) -> (Ptr TSNode -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
self_p ->
      Ptr TSNode -> Word32 -> Ptr TSNode -> IO ()
_wrap_ts_node_first_named_child_for_byte Ptr TSNode
self_p Word32
byte Ptr TSNode
result_p
    Ptr TSNode -> IO TSNode
forall a. Storable a => Ptr a -> IO a
peek Ptr TSNode
result_p
{-# INLINE ts_node_first_named_child_for_byte #-}



foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_node_first_named_child_for_byte"
  _wrap_ts_node_first_named_child_for_byte ::
    Ptr TSNode ->
    ( Word32 ) ->
{-# LINE 2580 "src/TreeSitter/CApi.hsc" #-}
    Ptr TSNode ->
    IO ()

{-|
  Get the node's number of descendants, including one for the node itself.

  > uint32_t ts_node_descendant_count(TSNode self);
-}
ts_node_descendant_count ::
  TSNode ->
  IO ( Word32 )
{-# LINE 2591 "src/TreeSitter/CApi.hsc" #-}
ts_node_descendant_count = \self ->
  with self $ \self_p ->
    _wrap_ts_node_descendant_count self_p
{-# INLINE ts_node_descendant_count #-}



foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_node_descendant_count"
  _wrap_ts_node_descendant_count ::
    Ptr TSNode ->
    IO ( Word32 )
{-# LINE 2607 "src/TreeSitter/CApi.hsc" #-}

{-|
  Get the smallest node within this node that spans the given range of bytes.

  > TSNode ts_node_descendant_for_byte_range(TSNode self, uint32_t start, uint32_t end);
-}
ts_node_descendant_for_byte_range ::
  TSNode ->
  ( Word32 ) ->
{-# LINE 2616 "src/TreeSitter/CApi.hsc" #-}
  ( Word32 ) ->
{-# LINE 2617 "src/TreeSitter/CApi.hsc" #-}
  IO TSNode
ts_node_descendant_for_byte_range :: TSNode -> Word32 -> Word32 -> IO TSNode
ts_node_descendant_for_byte_range = \TSNode
self Word32
start Word32
end ->
  (Ptr TSNode -> IO TSNode) -> IO TSNode
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr TSNode -> IO TSNode) -> IO TSNode)
-> (Ptr TSNode -> IO TSNode) -> IO TSNode
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
result_p -> do
    TSNode -> (Ptr TSNode -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TSNode
self ((Ptr TSNode -> IO ()) -> IO ()) -> (Ptr TSNode -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
self_p ->
      Ptr TSNode -> Word32 -> Word32 -> Ptr TSNode -> IO ()
_wrap_ts_node_descendant_for_byte_range Ptr TSNode
self_p Word32
start Word32
end Ptr TSNode
result_p
    Ptr TSNode -> IO TSNode
forall a. Storable a => Ptr a -> IO a
peek Ptr TSNode
result_p
{-# INLINE ts_node_descendant_for_byte_range #-}



foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_node_descendant_for_byte_range"
  _wrap_ts_node_descendant_for_byte_range ::
    Ptr TSNode ->
    ( Word32 ) ->
{-# LINE 2636 "src/TreeSitter/CApi.hsc" #-}
    ( Word32 ) ->
{-# LINE 2637 "src/TreeSitter/CApi.hsc" #-}
    Ptr TSNode ->
    IO ()

{-|
  Get the smallest node within this node that spans the given range of positions.

  > TSNode ts_node_descendant_for_point_range(TSNode self, TSPoint start, TSPoint end);
-}
ts_node_descendant_for_point_range ::
  TSNode ->
  TSPoint ->
  TSPoint ->
  IO TSNode
ts_node_descendant_for_point_range :: TSNode -> TSPoint -> TSPoint -> IO TSNode
ts_node_descendant_for_point_range = \TSNode
self TSPoint
start TSPoint
end ->
  (Ptr TSNode -> IO TSNode) -> IO TSNode
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr TSNode -> IO TSNode) -> IO TSNode)
-> (Ptr TSNode -> IO TSNode) -> IO TSNode
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
result_p -> do
    TSNode -> (Ptr TSNode -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TSNode
self ((Ptr TSNode -> IO ()) -> IO ()) -> (Ptr TSNode -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
self_p ->
      TSPoint -> (Ptr TSPoint -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TSPoint
start ((Ptr TSPoint -> IO ()) -> IO ())
-> (Ptr TSPoint -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TSPoint
start_p ->
        TSPoint -> (Ptr TSPoint -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TSPoint
end ((Ptr TSPoint -> IO ()) -> IO ())
-> (Ptr TSPoint -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TSPoint
end_p ->
          Ptr TSNode -> Ptr TSPoint -> Ptr TSPoint -> Ptr TSNode -> IO ()
_wrap_ts_node_descendant_for_point_range Ptr TSNode
self_p Ptr TSPoint
start_p Ptr TSPoint
end_p Ptr TSNode
result_p
    Ptr TSNode -> IO TSNode
forall a. Storable a => Ptr a -> IO a
peek Ptr TSNode
result_p
{-# INLINE ts_node_descendant_for_point_range #-}



foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_node_descendant_for_point_range"
  _wrap_ts_node_descendant_for_point_range ::
    Ptr TSNode ->
    Ptr TSPoint ->
    Ptr TSPoint ->
    Ptr TSNode ->
    IO ()

{-|
  Get the smallest named node within this node that spans the given range of
  bytes.

  > TSNode ts_node_named_descendant_for_byte_range(TSNode self, uint32_t start, uint32_t end);
-}
ts_node_named_descendant_for_byte_range ::
  TSNode ->
  ( Word32 ) ->
{-# LINE 2683 "src/TreeSitter/CApi.hsc" #-}
  ( Word32 ) ->
{-# LINE 2684 "src/TreeSitter/CApi.hsc" #-}
  IO TSNode
ts_node_named_descendant_for_byte_range :: TSNode -> Word32 -> Word32 -> IO TSNode
ts_node_named_descendant_for_byte_range = \TSNode
self Word32
start Word32
end ->
  (Ptr TSNode -> IO TSNode) -> IO TSNode
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr TSNode -> IO TSNode) -> IO TSNode)
-> (Ptr TSNode -> IO TSNode) -> IO TSNode
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
result_p -> do
    TSNode -> (Ptr TSNode -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TSNode
self ((Ptr TSNode -> IO ()) -> IO ()) -> (Ptr TSNode -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
self_p ->
      Ptr TSNode -> Word32 -> Word32 -> Ptr TSNode -> IO ()
_wrap_ts_node_named_descendant_for_byte_range Ptr TSNode
self_p Word32
start Word32
end Ptr TSNode
result_p
    Ptr TSNode -> IO TSNode
forall a. Storable a => Ptr a -> IO a
peek Ptr TSNode
result_p
{-# INLINE ts_node_named_descendant_for_byte_range #-}



foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_node_named_descendant_for_byte_range"
  _wrap_ts_node_named_descendant_for_byte_range ::
    Ptr TSNode ->
    ( Word32 ) ->
{-# LINE 2703 "src/TreeSitter/CApi.hsc" #-}
    ( Word32 ) ->
{-# LINE 2704 "src/TreeSitter/CApi.hsc" #-}
    Ptr TSNode ->
    IO ()

{-|
  Get the smallest named node within this node that spans the given range of positions.

  > TSNode ts_node_named_descendant_for_point_range(TSNode self, TSPoint start, TSPoint end);
-}
ts_node_named_descendant_for_point_range ::
  TSNode ->
  TSPoint ->
  TSPoint ->
  IO TSNode
ts_node_named_descendant_for_point_range :: TSNode -> TSPoint -> TSPoint -> IO TSNode
ts_node_named_descendant_for_point_range = \TSNode
self TSPoint
start TSPoint
end ->
  (Ptr TSNode -> IO TSNode) -> IO TSNode
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr TSNode -> IO TSNode) -> IO TSNode)
-> (Ptr TSNode -> IO TSNode) -> IO TSNode
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
result_p -> do
    TSNode -> (Ptr TSNode -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TSNode
self ((Ptr TSNode -> IO ()) -> IO ()) -> (Ptr TSNode -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
self_p ->
      TSPoint -> (Ptr TSPoint -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TSPoint
start ((Ptr TSPoint -> IO ()) -> IO ())
-> (Ptr TSPoint -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TSPoint
start_p ->
        TSPoint -> (Ptr TSPoint -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TSPoint
end ((Ptr TSPoint -> IO ()) -> IO ())
-> (Ptr TSPoint -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TSPoint
end_p ->
          Ptr TSNode -> Ptr TSPoint -> Ptr TSPoint -> Ptr TSNode -> IO ()
_wrap_ts_node_named_descendant_for_point_range Ptr TSNode
self_p Ptr TSPoint
start_p Ptr TSPoint
end_p Ptr TSNode
result_p
    Ptr TSNode -> IO TSNode
forall a. Storable a => Ptr a -> IO a
peek Ptr TSNode
result_p
{-# INLINE ts_node_named_descendant_for_point_range #-}



foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_node_named_descendant_for_point_range"
  _wrap_ts_node_named_descendant_for_point_range ::
    Ptr TSNode ->
    Ptr TSPoint ->
    Ptr TSPoint ->
    Ptr TSNode ->
    IO ()

{-|
  Edit the node to keep it in-sync with source code that has been edited.

  This function is only rarely needed. When you edit a syntax tree with the
  @`ts_tree_edit`@ function, all of the nodes that you retrieve from the tree
  afterward will already reflect the edit. You only need to use @`ts_node_edit`@
  when you have a @t`TSNode`@ instance that you want to keep and continue to use
  after an edit.

  > void ts_node_edit(TSNode *self, const TSInputEdit *edit);
-}
foreign import capi unsafe "TreeSitter/CApi_hsc.h ts_node_edit"
  ts_node_edit ::
    Ptr TSNode ->
    ConstPtr TSInputEdit ->
    IO ()

{-|
  Check if two nodes are identical.

  > bool ts_node_eq(TSNode self, TSNode other);
-}
ts_node_eq ::
  TSNode ->
  TSNode ->
  IO CBool
ts_node_eq :: TSNode -> TSNode -> IO CBool
ts_node_eq = \TSNode
self TSNode
other ->
  TSNode -> (Ptr TSNode -> IO CBool) -> IO CBool
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TSNode
self ((Ptr TSNode -> IO CBool) -> IO CBool)
-> (Ptr TSNode -> IO CBool) -> IO CBool
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
self_p ->
    TSNode -> (Ptr TSNode -> IO CBool) -> IO CBool
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TSNode
other ((Ptr TSNode -> IO CBool) -> IO CBool)
-> (Ptr TSNode -> IO CBool) -> IO CBool
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
other_p ->
        Ptr TSNode -> Ptr TSNode -> IO CBool
_wrap_ts_node_eq Ptr TSNode
self_p Ptr TSNode
other_p
{-# INLINE ts_node_eq #-}



foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_node_eq"
  _wrap_ts_node_eq ::
    Ptr TSNode ->
    Ptr TSNode ->
    IO CBool

{- Section - TreeCursor -}

{-|
  Create a new tree cursor starting from the given node.

  A tree cursor allows you to walk a syntax tree more efficiently than is
  possible using the @t`TSNode`@ functions. It is a mutable object that is always
  on a certain syntax node, and can be moved imperatively to different nodes.

  > TSTreeCursor ts_tree_cursor_new(TSNode node);
-}
ts_tree_cursor_new ::
  TSNode ->
  IO TSTreeCursor
ts_tree_cursor_new :: TSNode -> IO TSTreeCursor
ts_tree_cursor_new = \TSNode
node ->
  (Ptr TSTreeCursor -> IO TSTreeCursor) -> IO TSTreeCursor
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr TSTreeCursor -> IO TSTreeCursor) -> IO TSTreeCursor)
-> (Ptr TSTreeCursor -> IO TSTreeCursor) -> IO TSTreeCursor
forall a b. (a -> b) -> a -> b
$ \Ptr TSTreeCursor
result_p -> do
    TSNode -> Ptr TSTreeCursor -> IO ()
ts_tree_cursor_new_p TSNode
node Ptr TSTreeCursor
result_p
    Ptr TSTreeCursor -> IO TSTreeCursor
forall a. Storable a => Ptr a -> IO a
peek Ptr TSTreeCursor
result_p
{-# INLINE ts_tree_cursor_new #-}

-- | Create a new tree cursor starting from the given node.
--
--   Variant of 'ts_tree_cursor_new' that writes the tree cursor to the provided pointer.
ts_tree_cursor_new_p ::
  TSNode ->
  Ptr TSTreeCursor -> -- ^ Output pointer for the new tree cursor.
  IO ()
ts_tree_cursor_new_p :: TSNode -> Ptr TSTreeCursor -> IO ()
ts_tree_cursor_new_p = \TSNode
node Ptr TSTreeCursor
result_p ->
  TSNode -> (Ptr TSNode -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TSNode
node ((Ptr TSNode -> IO ()) -> IO ()) -> (Ptr TSNode -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
node_p ->
    Ptr TSNode -> Ptr TSTreeCursor -> IO ()
_wrap_ts_tree_cursor_new Ptr TSNode
node_p Ptr TSTreeCursor
result_p
{-# INLINE ts_tree_cursor_new_p #-}



foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_tree_cursor_new"
  _wrap_ts_tree_cursor_new ::
    Ptr TSNode ->
    Ptr TSTreeCursor ->
    IO ()

{-|
  Delete a tree cursor, freeing all of the memory that it used.

  > void ts_tree_cursor_delete(TSTreeCursor *self);
-}
foreign import capi unsafe "tree_sitter/api.h ts_tree_cursor_delete"
  ts_tree_cursor_delete ::
    Ptr TSTreeCursor ->
    IO ()

{-| C function pointer to @`ts_tree_cursor_delete`@.
 -}
foreign import capi unsafe "tree_sitter/api.h &ts_tree_cursor_delete"
  p_ts_tree_cursor_delete ::
    FunPtr (
      Ptr TSTreeCursor ->
      IO ()
    )

{-|
  Re-initialize a tree cursor to start at the original node that the cursor was
  constructed with.

  > void ts_tree_cursor_reset(TSTreeCursor *self, TSNode node);
-}
ts_tree_cursor_reset ::
  Ptr TSTreeCursor ->
  TSNode ->
  IO ()
ts_tree_cursor_reset :: Ptr TSTreeCursor -> TSNode -> IO ()
ts_tree_cursor_reset = \Ptr TSTreeCursor
self TSNode
node ->
  TSNode -> (Ptr TSNode -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TSNode
node ((Ptr TSNode -> IO ()) -> IO ()) -> (Ptr TSNode -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
node_p ->
    Ptr TSTreeCursor -> Ptr TSNode -> IO ()
_wrap_ts_tree_cursor_reset Ptr TSTreeCursor
self Ptr TSNode
node_p
{-# INLINE ts_tree_cursor_reset #-}



foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_tree_cursor_reset"
  _wrap_ts_tree_cursor_reset ::
    Ptr TSTreeCursor ->
    Ptr TSNode ->
    IO ()

{-|
  Re-initialize a tree cursor to the same position as another cursor.

  Unlike @`ts_tree_cursor_reset`@, this will not lose parent information and
  allows reusing already created cursors.

  > void ts_tree_cursor_reset_to(TSTreeCursor *dst, const TSTreeCursor *src);
-}
foreign import capi unsafe "tree_sitter/api.h ts_tree_cursor_reset_to"
  ts_tree_cursor_reset_to ::
    Ptr TSTreeCursor ->
    ConstPtr TSTreeCursor ->
    IO ()

{-|
  Get the tree cursor's current node.

  > TSNode ts_tree_cursor_current_node(const TSTreeCursor *self);
-}
ts_tree_cursor_current_node ::
  ConstPtr TSTreeCursor ->
  IO TSNode
ts_tree_cursor_current_node :: ConstPtr TSTreeCursor -> IO TSNode
ts_tree_cursor_current_node = \ConstPtr TSTreeCursor
self ->
  (Ptr TSNode -> IO TSNode) -> IO TSNode
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr TSNode -> IO TSNode) -> IO TSNode)
-> (Ptr TSNode -> IO TSNode) -> IO TSNode
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
result_p -> do
    ConstPtr TSTreeCursor -> Ptr TSNode -> IO ()
_wrap_ts_tree_cursor_current_node ConstPtr TSTreeCursor
self Ptr TSNode
result_p
    Ptr TSNode -> IO TSNode
forall a. Storable a => Ptr a -> IO a
peek Ptr TSNode
result_p
{-# INLINE ts_tree_cursor_current_node #-}



foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_tree_cursor_current_node"
  _wrap_ts_tree_cursor_current_node ::
    ConstPtr TSTreeCursor ->
    Ptr TSNode ->
    IO ()

{-|
  Get the field name of the tree cursor's current node.

  This returns @NULL@ if the current node doesn't have a field.
  See also @`ts_node_child_by_field_name`@.

  > const char *ts_tree_cursor_current_field_name(const TSTreeCursor *self);
-}
foreign import capi unsafe "tree_sitter/api.h ts_tree_cursor_current_field_name"
  ts_tree_cursor_current_field_name ::
    ConstPtr TSTreeCursor ->
    IO (ConstPtr CChar)

{-|
  Get the field id of the tree cursor's current node.

  This returns zero if the current node doesn't have a field.
  See also @`ts_node_child_by_field_id`@, @`ts_language_field_id_for_name`@.

  > TSFieldId ts_tree_cursor_current_field_id(const TSTreeCursor *self);
-}
foreign import capi unsafe "tree_sitter/api.h ts_tree_cursor_current_field_id"
  ts_tree_cursor_current_field_id ::
    ConstPtr TSTreeCursor ->
    IO TSFieldId

{-|
  Move the cursor to the parent of its current node.

  This returns @true@ if the cursor successfully moved, and returns @false@
  if there was no parent node (the cursor was already on the root node).

  > bool ts_tree_cursor_goto_parent(TSTreeCursor *self);
-}
foreign import capi unsafe "tree_sitter/api.h ts_tree_cursor_goto_parent"
  ts_tree_cursor_goto_parent ::
    Ptr TSTreeCursor ->
    IO CBool

{-|
  Move the cursor to the next sibling of its current node.

  This returns @true@ if the cursor successfully moved, and returns @false@
  if there was no next sibling node.

  > bool ts_tree_cursor_goto_next_sibling(TSTreeCursor *self);
-}
foreign import capi unsafe "tree_sitter/api.h ts_tree_cursor_goto_next_sibling"
  ts_tree_cursor_goto_next_sibling ::
    Ptr TSTreeCursor ->
    IO CBool

{-|
  Move the cursor to the previous sibling of its current node.

  This returns @true@ if the cursor successfully moved, and returns @false@ if
  there was no previous sibling node.

  Note, that this function may be slower than
  @`ts_tree_cursor_goto_next_sibling`@ due to how node positions are stored. In
  the worst case, this will need to iterate through all the children upto the
  previous sibling node to recalculate its position.

  > bool ts_tree_cursor_goto_previous_sibling(TSTreeCursor *self);
-}
foreign import capi unsafe "tree_sitter/api.h ts_tree_cursor_goto_previous_sibling"
  ts_tree_cursor_goto_previous_sibling ::
    Ptr TSTreeCursor ->
    IO CBool

{-|
  Move the cursor to the first child of its current node.

  This returns @true@ if the cursor successfully moved, and returns @false@
  if there were no children.

  > bool ts_tree_cursor_goto_first_child(TSTreeCursor *self);
-}
foreign import capi unsafe "tree_sitter/api.h ts_tree_cursor_goto_first_child"
  ts_tree_cursor_goto_first_child ::
    Ptr TSTreeCursor ->
    IO CBool

{-|
  Move the cursor to the last child of its current node.

  This returns @true@ if the cursor successfully moved, and returns @false@ if
  there were no children.

  Note that this function may be slower than @`ts_tree_cursor_goto_first_child`@
  because it needs to iterate through all the children to compute the child's
  position.

  > bool ts_tree_cursor_goto_last_child(TSTreeCursor *self);
-}
foreign import capi unsafe "tree_sitter/api.h ts_tree_cursor_goto_last_child"
  ts_tree_cursor_goto_last_child ::
    Ptr TSTreeCursor ->
    IO CBool

{-|
  Move the cursor to the node that is the nth descendant of
  the original node that the cursor was constructed with, where
  zero represents the original node itself.

  > void ts_tree_cursor_goto_descendant(TSTreeCursor *self, uint32_t goal_descendant_index);
-}
foreign import capi unsafe "tree_sitter/api.h ts_tree_cursor_goto_descendant"
  ts_tree_cursor_goto_descendant ::
    Ptr TSTreeCursor ->
    ( Word32 ) ->
{-# LINE 3030 "src/TreeSitter/CApi.hsc" #-}
    IO ()

{-|
  Get the index of the cursor's current node out of all of the
  descendants of the original node that the cursor was constructed with.

  > uint32_t ts_tree_cursor_current_descendant_index(const TSTreeCursor *self);
-}
foreign import capi unsafe "tree_sitter/api.h ts_tree_cursor_current_descendant_index"
  ts_tree_cursor_current_descendant_index ::
    ConstPtr TSTreeCursor ->
    IO ( Word32 )
{-# LINE 3042 "src/TreeSitter/CApi.hsc" #-}

{-|
  Get the depth of the cursor's current node relative to the original
  node that the cursor was constructed with.

  > uint32_t ts_tree_cursor_current_depth(const TSTreeCursor *self);
-}
foreign import capi unsafe "tree_sitter/api.h ts_tree_cursor_current_depth"
  ts_tree_cursor_current_depth ::
    ConstPtr TSTreeCursor ->
    IO ( Word32 )
{-# LINE 3053 "src/TreeSitter/CApi.hsc" #-}

{-|
  Move the cursor to the first child of its current node that extends beyond
  the given byte offset.

  This returns the index of the child node if one was found, and returns -1
  if no such child was found.

  > int64_t ts_tree_cursor_goto_first_child_for_byte(TSTreeCursor *self, uint32_t goal_byte);
-}
foreign import capi unsafe "tree_sitter/api.h ts_tree_cursor_goto_first_child_for_byte"
  ts_tree_cursor_goto_first_child_for_byte ::
    Ptr TSTreeCursor ->
    ( Word32 ) ->
{-# LINE 3067 "src/TreeSitter/CApi.hsc" #-}
    IO ( Int64 )
{-# LINE 3068 "src/TreeSitter/CApi.hsc" #-}

{-|
  Move the cursor to the first child of its current node that extends beyond
  the given byte point.

  This returns the index of the child node if one was found, and returns -1
  if no such child was found.

  > int64_t ts_tree_cursor_goto_first_child_for_point(TSTreeCursor *self, TSPoint goal_point);
-}
ts_tree_cursor_goto_first_child_for_point ::
    Ptr TSTreeCursor ->
    TSPoint ->
    IO ( Int64 )
{-# LINE 3082 "src/TreeSitter/CApi.hsc" #-}
ts_tree_cursor_goto_first_child_for_point = \self goal_point ->
  with goal_point $ \goal_point_p ->
    _wrap_ts_tree_cursor_goto_first_child_for_point self goal_point_p
{-# INLINE ts_tree_cursor_goto_first_child_for_point #-}



foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_tree_cursor_goto_first_child_for_point"
  _wrap_ts_tree_cursor_goto_first_child_for_point ::
    Ptr TSTreeCursor ->
    Ptr TSPoint ->
    IO ( Int64 )
{-# LINE 3099 "src/TreeSitter/CApi.hsc" #-}

{-|
  > TSTreeCursor ts_tree_cursor_copy(const TSTreeCursor *cursor);
  -}
ts_tree_cursor_copy ::
    Ptr TSTreeCursor ->
    IO TSTreeCursor
ts_tree_cursor_copy :: Ptr TSTreeCursor -> IO TSTreeCursor
ts_tree_cursor_copy = \Ptr TSTreeCursor
self ->
  (Ptr TSTreeCursor -> IO TSTreeCursor) -> IO TSTreeCursor
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr TSTreeCursor -> IO TSTreeCursor) -> IO TSTreeCursor)
-> (Ptr TSTreeCursor -> IO TSTreeCursor) -> IO TSTreeCursor
forall a b. (a -> b) -> a -> b
$ \Ptr TSTreeCursor
result_p -> do
    Ptr TSTreeCursor -> Ptr TSTreeCursor -> IO ()
_wrap_ts_tree_cursor_copy Ptr TSTreeCursor
self Ptr TSTreeCursor
result_p
    Ptr TSTreeCursor -> IO TSTreeCursor
forall a. Storable a => Ptr a -> IO a
peek Ptr TSTreeCursor
result_p
{-# INLINE ts_tree_cursor_copy #-}

-- | Copy a tree cursor.
--
--   Variant of 'ts_tree_cursor_copy' that writes the tree cursor to the provided pointer.
ts_tree_cursor_copy_p ::
  Ptr TSTreeCursor ->
  Ptr TSTreeCursor -> -- ^ Output pointer for the new tree cursor.
  IO ()
ts_tree_cursor_copy_p :: Ptr TSTreeCursor -> Ptr TSTreeCursor -> IO ()
ts_tree_cursor_copy_p = Ptr TSTreeCursor -> Ptr TSTreeCursor -> IO ()
_wrap_ts_tree_cursor_copy
{-# INLINE ts_tree_cursor_copy_p #-}




foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_tree_cursor_copy"
  _wrap_ts_tree_cursor_copy ::
    Ptr TSTreeCursor ->
    Ptr TSTreeCursor ->
    IO ()

{- Section - Query -}

{-|
  Create a new query from a string containing one or more S-expression
  patterns. The query is associated with a particular language, and can
  only be run on syntax nodes parsed with that language.

  If all of the given patterns are valid, this returns a @t`TSQuery`@.
  If a pattern is invalid, this returns @NULL@, and provides two pieces
  of information about the problem:
  1. The byte offset of the error is written to the @error_offset@ parameter.
  2. The type of error is written to the @error_type@ parameter.

  > TSQuery *ts_query_new(
  >   const TSLanguage *language,
  >   const char *source,
  >   uint32_t source_len,
  >   uint32_t *error_offset,
  >   TSQueryError *error_type
  > );
-}
foreign import capi unsafe "tree_sitter/api.h ts_query_new"
  ts_query_new ::
    ConstPtr TSLanguage ->
    ConstPtr CChar ->
    ( Word32 ) ->
{-# LINE 3162 "src/TreeSitter/CApi.hsc" #-}
    Ptr ( Word32 ) ->
{-# LINE 3163 "src/TreeSitter/CApi.hsc" #-}
    Ptr TSQueryError ->
    IO (Ptr TSQuery)

{-|
  Delete a query, freeing all of the memory that it used.

  > void ts_query_delete(TSQuery *self);
-}
foreign import capi unsafe "tree_sitter/api.h ts_query_delete"
  ts_query_delete ::
    Ptr TSQuery ->
    IO ()

{-| C function pointer to @`ts_query_delete`@.
 -}
foreign import capi unsafe "tree_sitter/api.h &ts_query_delete"
  p_ts_query_delete ::
    FunPtr (
      Ptr TSQuery ->
      IO ()
    )

{-|
  Get the number of patterns in the query.

  > uint32_t ts_query_pattern_count(const TSQuery *self);
-}
foreign import capi unsafe "tree_sitter/api.h ts_query_pattern_count"
  ts_query_pattern_count ::
    ConstPtr TSQuery ->
    IO ( Word32 )
{-# LINE 3194 "src/TreeSitter/CApi.hsc" #-}

{-|
  Get the number of captures in the query.

  > uint32_t ts_query_capture_count(const TSQuery *self);
-}
foreign import capi unsafe "tree_sitter/api.h ts_query_capture_count"
  ts_query_capture_count ::
    ConstPtr TSQuery ->
    IO ( Word32 )
{-# LINE 3204 "src/TreeSitter/CApi.hsc" #-}

{-|
  Get the number of string literals in the query.

  > uint32_t ts_query_string_count(const TSQuery *self);
-}
foreign import capi unsafe "tree_sitter/api.h ts_query_string_count"
  ts_query_string_count ::
    ConstPtr TSQuery ->
    IO ( Word32 )
{-# LINE 3214 "src/TreeSitter/CApi.hsc" #-}

{-|
  Get the byte offset where the given pattern starts in the query's source.

  This can be useful when combining queries by concatenating their source
  code strings.

  > uint32_t ts_query_start_byte_for_pattern(const TSQuery *self, uint32_t pattern_index);
-}
foreign import capi unsafe "tree_sitter/api.h ts_query_start_byte_for_pattern"
  ts_query_start_byte_for_pattern ::
    ConstPtr TSQuery ->
    ( Word32 ) ->
{-# LINE 3227 "src/TreeSitter/CApi.hsc" #-}
    IO ( Word32 )
{-# LINE 3228 "src/TreeSitter/CApi.hsc" #-}

{-|
  Get the byte offset where the given pattern ends in the query's source.

  This can be useful when combining queries by concatenating their source
  code strings.

  > uint32_t ts_query_end_byte_for_pattern(const TSQuery *self, uint32_t pattern_index);
-}
foreign import capi unsafe "tree_sitter/api.h ts_query_end_byte_for_pattern"
  ts_query_end_byte_for_pattern ::
    ConstPtr TSQuery ->
    ( Word32 ) ->
{-# LINE 3241 "src/TreeSitter/CApi.hsc" #-}
    IO ( Word32 )
{-# LINE 3242 "src/TreeSitter/CApi.hsc" #-}

{-|
  Get all of the predicates for the given pattern in the query.

  The predicates are represented as a single array of steps. There are three
  types of steps in this array, which correspond to the three legal values for
  the `type` field:
  - @`TSQueryPredicateStepTypeCapture`@ - Steps with this type represent names
     of captures. Their @value_id@ can be used with the
    @`ts_query_capture_name_for_id`@ function to obtain the name of the capture.
  - @`TSQueryPredicateStepTypeString`@ - Steps with this type represent literal
     strings. Their @value_id@ can be used with the
     @`ts_query_string_value_for_id`@ function to obtain their string value.
  - @`TSQueryPredicateStepTypeDone`@ - Steps with this type are *sentinels*
     that represent the end of an individual predicate. If a pattern has two
     predicates, then there will be two steps with this `type` in the array.

  > const TSQueryPredicateStep *ts_query_predicates_for_pattern(
  >   const TSQuery *self,
  >   uint32_t pattern_index,
  >   uint32_t *step_count
  > );
-}
foreign import capi unsafe "tree_sitter/api.h ts_query_predicates_for_pattern"
  ts_query_predicates_for_pattern ::
    ConstPtr TSQuery ->
    ( Word32 ) ->
{-# LINE 3269 "src/TreeSitter/CApi.hsc" #-}
    Ptr ( Word32 ) ->
{-# LINE 3270 "src/TreeSitter/CApi.hsc" #-}
    IO (ConstPtr TSQueryPredicateStep)

{-|
  Check if the given pattern in the query has a single root node.

  > bool ts_query_is_pattern_rooted(const TSQuery *self, uint32_t pattern_index);
-}
foreign import capi unsafe "tree_sitter/api.h ts_query_is_pattern_rooted"
  ts_query_is_pattern_rooted ::
    ConstPtr TSQuery ->
    ( Word32 ) ->
{-# LINE 3281 "src/TreeSitter/CApi.hsc" #-}
    IO CBool

{-|
  Check if the given pattern in the query is non-local.

  A non-local pattern has multiple root nodes and can match within a
  repeating sequence of nodes, as specified by the grammar. Non-local
  patterns disable certain optimizations that would otherwise be possible
  when executing a query on a specific range of a syntax tree.

  > bool ts_query_is_pattern_non_local(const TSQuery *self, uint32_t pattern_index);
-}
foreign import capi unsafe "tree_sitter/api.h ts_query_is_pattern_non_local"
  ts_query_is_pattern_non_local ::
    ConstPtr TSQuery ->
    ( Word32 ) ->
{-# LINE 3297 "src/TreeSitter/CApi.hsc" #-}
    IO CBool

{-|
  Check if a given pattern is guaranteed to match once a given step is reached.
  The step is specified by its byte offset in the query's source code.

  > bool ts_query_is_pattern_guaranteed_at_step(const TSQuery *self, uint32_t byte_offset);
-}
foreign import capi unsafe "tree_sitter/api.h ts_query_is_pattern_guaranteed_at_step"
  ts_query_is_pattern_guaranteed_at_step ::
    ConstPtr TSQuery ->
    ( Word32 ) ->
{-# LINE 3309 "src/TreeSitter/CApi.hsc" #-}
    IO CBool

{-|
  Get the name and length of one of the query's captures, or one of the
  query's string literals. Each capture and string is associated with a
  numeric id based on the order that it appeared in the query's source.

  > const char *ts_query_capture_name_for_id(
  >   const TSQuery *self,
  >   uint32_t index,
  >   uint32_t *length
  > );
-}
foreign import capi unsafe "tree_sitter/api.h ts_query_capture_name_for_id"
  ts_query_capture_name_for_id ::
    ConstPtr TSQuery ->
    ( Word32 ) ->
{-# LINE 3326 "src/TreeSitter/CApi.hsc" #-}
    Ptr ( Word32 ) ->
{-# LINE 3327 "src/TreeSitter/CApi.hsc" #-}
    IO (ConstPtr CChar)

{-|
  Get the quantifier of the query's captures. Each capture is * associated
  with a numeric id based on the order that it appeared in the query's source.

  > TSQuantifier ts_query_capture_quantifier_for_id(
  >   const TSQuery *self,
  >   uint32_t pattern_index,
  >   uint32_t capture_index
  > );
-}
foreign import capi unsafe "tree_sitter/api.h ts_query_capture_quantifier_for_id"
  ts_query_capture_quantifier_for_id ::
    ConstPtr TSQuery ->
    ( Word32 ) ->
{-# LINE 3343 "src/TreeSitter/CApi.hsc" #-}
    ( Word32 ) ->
{-# LINE 3344 "src/TreeSitter/CApi.hsc" #-}
    IO TSQuantifier

{-|
  > const char *ts_query_string_value_for_id(
  >   const TSQuery *self,
  >   uint32_t index,
  >   uint32_t *length
  > );
  -}
foreign import capi unsafe "tree_sitter/api.h ts_query_string_value_for_id"
  ts_query_string_value_for_id ::
    ConstPtr TSQuery ->
    ( Word32 ) ->
{-# LINE 3357 "src/TreeSitter/CApi.hsc" #-}
    Ptr ( Word32 ) ->
{-# LINE 3358 "src/TreeSitter/CApi.hsc" #-}
    IO (ConstPtr CChar)

{-|
  Disable a certain capture within a query.

  This prevents the capture from being returned in matches, and also avoids
  any resource usage associated with recording the capture. Currently, there
  is no way to undo this.

  > void ts_query_disable_capture(TSQuery *self, const char *name, uint32_t length);
-}
foreign import capi unsafe "tree_sitter/api.h ts_query_disable_capture"
  ts_query_disable_capture ::
    Ptr TSQuery ->
    ConstPtr CChar ->
    ( Word32 ) ->
{-# LINE 3374 "src/TreeSitter/CApi.hsc" #-}
    IO ()

{-|
  Disable a certain pattern within a query.

  This prevents the pattern from matching and removes most of the overhead
  associated with the pattern. Currently, there is no way to undo this.

  > void ts_query_disable_pattern(TSQuery *self, uint32_t pattern_index);
-}
foreign import capi unsafe "tree_sitter/api.h ts_query_disable_pattern"
  ts_query_disable_pattern ::
    Ptr TSQuery ->
    ( Word32 ) ->
{-# LINE 3388 "src/TreeSitter/CApi.hsc" #-}
    IO ()

{-|
  Create a new cursor for executing a given query.

  The cursor stores the state that is needed to iteratively search
  for matches. To use the query cursor, first call @`ts_query_cursor_exec`@
  to start running a given query on a given syntax node. Then, there are
  two options for consuming the results of the query:
  1. Repeatedly call @`ts_query_cursor_next_match`@ to iterate over all of the
     *matches* in the order that they were found. Each match contains the
     index of the pattern that matched, and an array of captures. Because
     multiple patterns can match the same set of nodes, one match may contain
     captures that appear *before* some of the captures from a previous match.
  2. Repeatedly call @`ts_query_cursor_next_capture`@ to iterate over all of the
     individual *captures* in the order that they appear. This is useful if
     don't care about which pattern matched, and just want a single ordered
     sequence of captures.

  If you don't care about consuming all of the results, you can stop calling
  @`ts_query_cursor_next_match`@ or @`ts_query_cursor_next_capture`@ at any point.
   You can then start executing another query on another node by calling
   @`ts_query_cursor_exec`@ again.

    > TSQueryCursor *ts_query_cursor_new(void);
-}
foreign import capi unsafe "tree_sitter/api.h ts_query_cursor_new"
  ts_query_cursor_new ::
    IO (Ptr TSQueryCursor)

{-|
  Delete a query cursor, freeing all of the memory that it used.

  > void ts_query_cursor_delete(TSQueryCursor *self);
-}
foreign import capi unsafe "tree_sitter/api.h ts_query_cursor_delete"
  ts_query_cursor_delete ::
    Ptr TSQueryCursor ->
    IO ()

{-| C function pointer to @`ts_query_cursor_delete`@.
 -}
foreign import capi unsafe "tree_sitter/api.h &ts_query_cursor_delete"
  p_ts_query_cursor_delete ::
    FunPtr (
      Ptr TSQueryCursor ->
      IO ()
    )

{-|
  Start running a given query on a given node.

  > void ts_query_cursor_exec(TSQueryCursor *self, const TSQuery *query, TSNode node);
-}
ts_query_cursor_exec ::
  Ptr TSQueryCursor ->
  ConstPtr TSQuery ->
  TSNode ->
  IO ()
ts_query_cursor_exec :: Ptr TSQueryCursor -> ConstPtr TSQuery -> TSNode -> IO ()
ts_query_cursor_exec = \Ptr TSQueryCursor
self ConstPtr TSQuery
query TSNode
node ->
  TSNode -> (Ptr TSNode -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TSNode
node ((Ptr TSNode -> IO ()) -> IO ()) -> (Ptr TSNode -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TSNode
node_p ->
    Ptr TSQueryCursor -> ConstPtr TSQuery -> Ptr TSNode -> IO ()
_wrap_ts_query_cursor_exec Ptr TSQueryCursor
self ConstPtr TSQuery
query Ptr TSNode
node_p
{-# INLINE ts_query_cursor_exec #-}



foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_query_cursor_exec"
  _wrap_ts_query_cursor_exec ::
    Ptr TSQueryCursor ->
    ConstPtr TSQuery ->
    Ptr TSNode ->
    IO ()

{-|
  Check whether the maximum number of in-progress matches allowed by this query cursor was exceeded.

  Query cursors have an optional maximum capacity for storing lists of
  in-progress captures. If this capacity is exceeded, then the
  earliest-starting match will silently be dropped to make room for further
  matches. This maximum capacity is optional — by default, query cursors allow
  any number of pending matches, dynamically allocating new space for them as
  needed as the query is executed.

  > bool ts_query_cursor_did_exceed_match_limit(const TSQueryCursor *self);
-}
foreign import capi unsafe "tree_sitter/api.h ts_query_cursor_did_exceed_match_limit"
  ts_query_cursor_did_exceed_match_limit ::
    ConstPtr TSQueryCursor ->
    IO CBool

{-|
  Get the maximum number of in-progress matches allowed by this query cursor.

  > uint32_t ts_query_cursor_match_limit(const TSQueryCursor *self);
-}
foreign import capi unsafe "tree_sitter/api.h ts_query_cursor_match_limit"
  ts_query_cursor_match_limit ::
    ConstPtr TSQueryCursor ->
    IO ( Word32 )
{-# LINE 3492 "src/TreeSitter/CApi.hsc" #-}

{-|
  Set the maximum number of in-progress matches allowed by this query cursor.

  > void ts_query_cursor_set_match_limit(TSQueryCursor *self, uint32_t limit);
-}
foreign import capi unsafe "tree_sitter/api.h ts_query_cursor_set_match_limit"
  ts_query_cursor_set_match_limit ::
    Ptr TSQueryCursor ->
    ( Word32 ) ->
{-# LINE 3502 "src/TreeSitter/CApi.hsc" #-}
    IO ()

{-|
  Set the maximum duration in microseconds that query execution should be allowed to
  take before halting.

  If query execution takes longer than this, it will halt early, returning @NULL@.
  See @`ts_query_cursor_next_match`@ or @`ts_query_cursor_next_capture`@ for more information.

  > void ts_query_cursor_set_timeout_micros(TSQueryCursor *self, uint64_t timeout_micros);
-}
foreign import capi unsafe "tree_sitter/api.h ts_query_cursor_set_timeout_micros"
  ts_query_cursor_set_timeout_micros ::
    Ptr TSQueryCursor ->
    ( Word64 ) ->
{-# LINE 3517 "src/TreeSitter/CApi.hsc" #-}
    IO ()

{-|
  Get the duration in microseconds that query execution is allowed to take.

  This is set via @`ts_query_cursor_set_timeout_micros`@.

  > uint64_t ts_query_cursor_timeout_micros(const TSQueryCursor *self);
-}
foreign import capi unsafe "tree_sitter/api.h ts_query_cursor_timeout_micros"
  ts_query_cursor_timeout_micros ::
    ConstPtr TSQueryCursor ->
    IO ( Word64 )
{-# LINE 3530 "src/TreeSitter/CApi.hsc" #-}

{-|
  Set the range of bytes in which the query will be executed.

  > void ts_query_cursor_set_byte_range(TSQueryCursor *self, uint32_t start_byte, uint32_t end_byte);
-}
foreign import capi unsafe "tree_sitter/api.h ts_query_cursor_set_byte_range"
  ts_query_cursor_set_byte_range ::
    Ptr TSQueryCursor ->
    ( Word32 ) ->
{-# LINE 3540 "src/TreeSitter/CApi.hsc" #-}
    ( Word32 ) ->
{-# LINE 3541 "src/TreeSitter/CApi.hsc" #-}
    IO ()

{-|
  Set the range of positions in which the query will be executed.

  > void ts_query_cursor_set_point_range(TSQueryCursor *self, TSPoint start_point, TSPoint end_point);
-}
ts_query_cursor_set_point_range ::
    Ptr TSQueryCursor ->
    TSPoint ->
    TSPoint ->
    IO ()
ts_query_cursor_set_point_range :: Ptr TSQueryCursor -> TSPoint -> TSPoint -> IO ()
ts_query_cursor_set_point_range = \Ptr TSQueryCursor
self TSPoint
start_point TSPoint
end_point ->
  TSPoint -> (Ptr TSPoint -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TSPoint
start_point ((Ptr TSPoint -> IO ()) -> IO ())
-> (Ptr TSPoint -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TSPoint
start_point_p ->
    TSPoint -> (Ptr TSPoint -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TSPoint
end_point ((Ptr TSPoint -> IO ()) -> IO ())
-> (Ptr TSPoint -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TSPoint
end_point_p ->
      Ptr TSQueryCursor -> Ptr TSPoint -> Ptr TSPoint -> IO ()
_wrap_ts_query_cursor_set_point_range Ptr TSQueryCursor
self Ptr TSPoint
start_point_p Ptr TSPoint
end_point_p
{-# INLINE ts_query_cursor_set_point_range #-}



foreign import capi unsafe "TreeSitter/CApi_hsc.h _wrap_ts_query_cursor_set_point_range"
  _wrap_ts_query_cursor_set_point_range ::
    Ptr TSQueryCursor ->
    Ptr TSPoint ->
    Ptr TSPoint ->
    IO ()

{-|
  Advance to the next match of the currently running query.

  If there is a match, write it to `*match` and return @true@.
  Otherwise, return @false@.

  > bool ts_query_cursor_next_match(TSQueryCursor *self, TSQueryMatch *match);
-}
foreign import capi unsafe "tree_sitter/api.h ts_query_cursor_next_match"
  ts_query_cursor_next_match ::
    Ptr TSQueryCursor ->
    Ptr TSQueryMatch ->
    IO CBool

{-|
  Remove a match of the currently running query.

  > void ts_query_cursor_remove_match(TSQueryCursor *self, uint32_t match_id);
-}
foreign import capi unsafe "tree_sitter/api.h ts_query_cursor_remove_match"
  ts_query_cursor_remove_match ::
    Ptr TSQueryCursor ->
    ( Word32 ) ->
{-# LINE 3596 "src/TreeSitter/CApi.hsc" #-}
    IO ()

{-|
  Advance to the next capture of the currently running query.

  If there is a capture, write its match to `*match` and its index within
  the matche's capture list to `*capture_index`. Otherwise, return @false@.

  > bool ts_query_cursor_next_capture(
  >   TSQueryCursor *self,
  >   TSQueryMatch *match,
  >   uint32_t *capture_index
  > );
-}
foreign import capi unsafe "tree_sitter/api.h ts_query_cursor_next_capture"
  ts_query_cursor_next_capture ::
    Ptr TSQueryCursor ->
    Ptr TSQueryMatch ->
    Ptr ( Word32 ) ->
{-# LINE 3615 "src/TreeSitter/CApi.hsc" #-}
    IO CBool

{-|
  Set the maximum start depth for a query cursor.

  This prevents cursors from exploring children nodes at a certain depth.
  Note if a pattern includes many children, then they will still be checked.

  The zero max start depth value can be used as a special behavior and
  it helps to destructure a subtree by staying on a node and using captures
  for interested parts. Note that the zero max start depth only limit a search
  depth for a pattern's root node but other nodes that are parts of the pattern
  may be searched at any depth what defined by the pattern structure.

  Set to @UINT32_MAX@ to remove the maximum start depth.

  > void ts_query_cursor_set_max_start_depth(TSQueryCursor *self, uint32_t max_start_depth);
-}
foreign import capi unsafe "tree_sitter/api.h ts_query_cursor_set_max_start_depth"
  ts_query_cursor_set_max_start_depth ::
    Ptr TSQueryCursor ->
    ( Word32 ) ->
{-# LINE 3637 "src/TreeSitter/CApi.hsc" #-}
    IO ()

{- Section - Language -}

{-|
  Get another reference to the given language.

  > const TSLanguage *ts_language_copy(const TSLanguage *self);
-}
foreign import capi unsafe "tree_sitter/api.h ts_language_copy"
  ts_language_copy ::
    ConstPtr TSLanguage ->
    IO (ConstPtr TSLanguage)

{-|
  Free any dynamically-allocated resources for this language, if
  this is the last reference.

  > void ts_language_delete(const TSLanguage *self);
-}
foreign import capi unsafe "tree_sitter/api.h ts_language_delete"
  ts_language_delete ::
    ConstPtr TSLanguage ->
    IO ()

{-| C function pointer to @`ts_language_delete`@.
 -}
foreign import capi unsafe "tree_sitter/api.h &ts_language_delete"
  p_ts_language_delete ::
    FunPtr (
      ConstPtr TSLanguage ->
      IO ()
    )

{-|
  Get the number of distinct node types in the language.

  > uint32_t ts_language_symbol_count(const TSLanguage *self);
-}
foreign import capi unsafe "tree_sitter/api.h ts_language_symbol_count"
  ts_language_symbol_count ::
    ConstPtr TSLanguage ->
    IO ( Word32 )
{-# LINE 3680 "src/TreeSitter/CApi.hsc" #-}

{-|
  Get the number of valid states in this language.

  > uint32_t ts_language_state_count(const TSLanguage *self);
-}
foreign import capi unsafe "tree_sitter/api.h ts_language_state_count"
  ts_language_state_count ::
    ConstPtr TSLanguage ->
    IO ( Word32 )
{-# LINE 3690 "src/TreeSitter/CApi.hsc" #-}

{-|
  Get a node type string for the given numerical id.

  > const char *ts_language_symbol_name(const TSLanguage *self, TSSymbol symbol);
-}
foreign import capi unsafe "tree_sitter/api.h ts_language_symbol_name"
  ts_language_symbol_name ::
    ConstPtr TSLanguage ->
    TSSymbol ->
    IO (ConstPtr CChar)

{-|
  Get the numerical id for the given node type string.

  > TSSymbol ts_language_symbol_for_name(
  >   const TSLanguage *self,
  >   const char *string,
  >   uint32_t length,
  >   bool is_named
  > );
-}
foreign import capi unsafe "tree_sitter/api.h ts_language_symbol_for_name"
  ts_language_symbol_for_name ::
    ConstPtr TSLanguage ->
    ConstPtr CChar ->
    ( Word32 ) ->
{-# LINE 3717 "src/TreeSitter/CApi.hsc" #-}
    CBool ->
    IO TSSymbol

{-|
  Get the number of distinct field names in the language.

  > uint32_t ts_language_field_count(const TSLanguage *self);
-}
foreign import capi unsafe "tree_sitter/api.h ts_language_field_count"
  ts_language_field_count ::
    ConstPtr TSLanguage ->
    IO ( Word32 )
{-# LINE 3729 "src/TreeSitter/CApi.hsc" #-}

{-|
  Get the field name string for the given numerical id.

  > const char *ts_language_field_name_for_id(const TSLanguage *self, TSFieldId id);
-}
foreign import capi unsafe "tree_sitter/api.h ts_language_field_name_for_id"
  ts_language_field_name_for_id ::
    ConstPtr TSLanguage ->
    TSFieldId ->
    IO (ConstPtr CChar)

{-|
  Get the numerical id for the given field name string.

  > TSFieldId ts_language_field_id_for_name(const TSLanguage *self, const char *name, uint32_t name_length);
-}
foreign import capi unsafe "tree_sitter/api.h ts_language_field_id_for_name"
  ts_language_field_id_for_name ::
    ConstPtr TSLanguage ->
    ConstPtr CChar ->
    ( Word32 ) ->
{-# LINE 3751 "src/TreeSitter/CApi.hsc" #-}
    IO TSFieldId

{-|
  Check whether the given node type id belongs to named nodes, anonymous nodes,
  or a hidden nodes.

  See also @`ts_node_is_named`@. Hidden nodes are never returned from the API.

  > TSSymbolType ts_language_symbol_type(const TSLanguage *self, TSSymbol symbol);
-}
foreign import capi unsafe "tree_sitter/api.h ts_language_symbol_type"
  ts_language_symbol_type ::
    ConstPtr TSLanguage ->
    TSSymbol ->
    IO TSSymbolType

{-|
  Get the ABI version number for this language. This version number is used
  to ensure that languages were generated by a compatible version of
  Tree-sitter.

  See also @`ts_parser_set_language`@.

  > uint32_t ts_language_version(const TSLanguage *self);
-}
foreign import capi unsafe "tree_sitter/api.h ts_language_version"
  ts_language_version ::
    ConstPtr TSLanguage ->
    IO ( Word32 )
{-# LINE 3780 "src/TreeSitter/CApi.hsc" #-}

{-|
  Get the next parse state. Combine this with lookahead iterators to generate
  completion suggestions or valid symbols in error nodes. Use
  @`ts_node_grammar_symbol`@ for valid symbols.

  > TSStateId ts_language_next_state(const TSLanguage *self, TSStateId state, TSSymbol symbol);
-}
foreign import capi unsafe "tree_sitter/api.h ts_language_next_state"
  ts_language_next_state ::
    ConstPtr TSLanguage ->
    TSStateId ->
    TSSymbol ->
    IO TSStateId

{--------------------------------}
{- Section - Lookahead Iterator -}
{--------------------------------}

{-|
  Create a new lookahead iterator for the given language and parse state.

  This returns @NULL@ if state is invalid for the language.

  Repeatedly using @`ts_lookahead_iterator_next`@ and
  @`ts_lookahead_iterator_current_symbol`@ will generate valid symbols in the
  given parse state. Newly created lookahead iterators will contain the @ERROR@
  symbol.

  Lookahead iterators can be useful to generate suggestions and improve syntax
  error diagnostics. To get symbols valid in an ERROR node, use the lookahead
  iterator on its first leaf node state. For @MISSING@ nodes, a lookahead
  iterator created on the previous non-extra leaf node may be appropriate.

  > TSLookaheadIterator *ts_lookahead_iterator_new(const TSLanguage *self, TSStateId state);
-}
foreign import capi unsafe "tree_sitter/api.h ts_lookahead_iterator_new"
  ts_lookahead_iterator_new ::
    ConstPtr TSLanguage ->
    TSStateId ->
    IO (Ptr TSLookaheadIterator)

{-|
  Delete a lookahead iterator freeing all the memory used.

  > void ts_lookahead_iterator_delete(TSLookaheadIterator *self);
-}
foreign import capi unsafe "tree_sitter/api.h ts_lookahead_iterator_delete"
  ts_lookahead_iterator_delete ::
    Ptr TSLookaheadIterator ->
    IO ()

{-| C function pointer to @`ts_lookahead_iterator_delete`@.
 -}
foreign import capi unsafe "tree_sitter/api.h &ts_lookahead_iterator_delete"
  p_ts_lookahead_iterator_delete ::
    FunPtr (
      Ptr TSLookaheadIterator ->
      IO ()
    )

{-|
  Reset the lookahead iterator to another state.

  This returns @true@ if the iterator was reset to the given state and @false@
  otherwise.

  > bool ts_lookahead_iterator_reset_state(TSLookaheadIterator *self, TSStateId state);
-}
foreign import capi unsafe "tree_sitter/api.h ts_lookahead_iterator_reset_state"
  ts_lookahead_iterator_reset_state ::
    Ptr TSLookaheadIterator ->
    TSStateId ->
    IO CBool

{-|
  Reset the lookahead iterator.

  This returns @true@ if the language was set successfully and @false@
  otherwise.

  > bool ts_lookahead_iterator_reset(TSLookaheadIterator *self, const TSLanguage *language, TSStateId state);
-}
foreign import capi unsafe "tree_sitter/api.h ts_lookahead_iterator_reset"
  ts_lookahead_iterator_reset ::
    Ptr TSLookaheadIterator ->
    ConstPtr TSLanguage ->
    TSStateId ->
    IO CBool

{-|
  Get the current language of the lookahead iterator.

  > const TSLanguage *ts_lookahead_iterator_language(const TSLookaheadIterator *self);
-}
foreign import capi unsafe "tree_sitter/api.h ts_lookahead_iterator_language"
  ts_lookahead_iterator_language ::
    Ptr TSLookaheadIterator ->
    IO (ConstPtr TSLanguage)

{-|
  Advance the lookahead iterator to the next symbol.

  This returns @true@ if there is a new symbol and @false@ otherwise.

  > bool ts_lookahead_iterator_next(TSLookaheadIterator *self);
-}
foreign import capi unsafe "tree_sitter/api.h ts_lookahead_iterator_next"
  ts_lookahead_iterator_next ::
    Ptr TSLookaheadIterator ->
    IO CBool

{-|
  Get the current symbol of the lookahead iterator;

  > TSSymbol ts_lookahead_iterator_current_symbol(const TSLookaheadIterator *self);
-}
foreign import capi unsafe "tree_sitter/api.h ts_lookahead_iterator_current_symbol"
  ts_lookahead_iterator_current_symbol ::
    ConstPtr TSLookaheadIterator ->
    IO TSSymbol

{-|
  Get the current symbol type of the lookahead iterator as a null terminated
  string.

  > const char *ts_lookahead_iterator_current_symbol_name(const TSLookaheadIterator *self);
-}
foreign import capi unsafe "tree_sitter/api.h ts_lookahead_iterator_current_symbol_name"
  ts_lookahead_iterator_current_symbol_name ::
    ConstPtr TSLookaheadIterator ->
    IO (ConstPtr CChar)

{-------------------------------------}
{- Section - WebAssembly Integration -}
{-------------------------------------}

-- def TREE_SITTER_FEATURE_WASM

{-# LINE 4098 "src/TreeSitter/CApi.hsc" #-}

{----------------------------------}
{- Section - Global Configuration -}
{----------------------------------}

{-|
  Set the allocation functions used by the library.

  By default, Tree-sitter uses the standard libc allocation functions,
  but aborts the process when an allocation fails. This function lets
  you supply alternative allocation functions at runtime.

  If you pass @NULL@ for any parameter, Tree-sitter will switch back to
  its default implementation of that function.

  If you call this function after the library has already been used, then
  you must ensure that either:

    1. All the existing objects have been freed.
    2. The new allocator shares its state with the old one, so it is capable of freeing memory that was allocated by the old allocator.

  > void ts_set_allocator(
  >   void *(*new_malloc)(size_t),
  >   void *(*new_calloc)(size_t, size_t),
  >   void *(*new_realloc)(void *, size_t),
  >   void (*new_free)(void *)
  > );
-}
foreign import capi unsafe "tree_sitter/api.h ts_set_allocator"
  ts_set_allocator ::
    FunPtr (CSize -> IO ()) ->
    FunPtr (CSize -> CSize -> IO ()) ->
    FunPtr (Ptr a -> CSize -> IO ()) ->
    FunPtr (Ptr a -> IO ()) ->
    IO ()