{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- @JsonPath@ is a simple class implementing the JSONPath syntax for extracting
-- data out of a JSON tree.
-- 
-- While the semantics of the JSONPath expressions are heavily borrowed by the
-- XPath specification for XML, the syntax follows the ECMAScript origins of
-- JSON.
-- 
-- Once a @JsonPath@ instance has been created, it has to compile a JSONPath
-- expression using 'GI.Json.Objects.Path.pathCompile' before being able to match it to
-- a JSON tree; the same @JsonPath@ instance can be used to match multiple JSON
-- trees. It it also possible to compile a new JSONPath expression using the
-- same @JsonPath@ instance; the previous expression will be discarded only if
-- the compilation of the new expression is successful.
-- 
-- The simple convenience function [func/@json@/.Path.query] can be used for
-- one-off matching.
-- 
-- == Syntax of the JSONPath expressions
-- 
-- A JSONPath expression is composed by path indices and operators.
-- Each path index can either be a member name or an element index inside
-- a JSON tree. A JSONPath expression must start with the @$@ operator; each
-- path index is separated using either the dot notation or the bracket
-- notation, e.g.:
-- 
-- >// dot notation
-- >$.store.book[0].title
-- >
-- >// bracket notation
-- >$['store']['book'][0]['title']
-- 
-- 
-- The available operators are:
-- 
-- * The @$@ character represents the root node of the JSON tree, and
--   matches the entire document.
-- 
-- * Child nodes can either be matched using @.@ or @[]@. For instance,
--   both @$.store.book@ and @$[\'store\'][\'book\']@ match the contents of
--   the book member of the store object.
-- 
-- * Child nodes can be reached without specifying the whole tree structure
--   through the recursive descent operator, or @..@. For instance,
--   @$..author@ matches all author member in every object.
-- 
-- * Child nodes can grouped through the wildcard operator, or @*@. For
--   instance, @$.store.book[*].author@ matches all author members of any
--   object element contained in the book array of the store object.
-- 
-- * Element nodes can be accessed using their index (starting from zero)
--   in the subscript operator @[]@. For instance, @$.store.book[0]@ matches
--   the first element of the book array of the store object.
-- 
-- * Subsets of element nodes can be accessed using the set notation
--   operator @[i,j,...]@. For instance, @$.store.book[0,2]@ matches the
--   elements 0 and 2 (the first and third) of the book array of the store
--   object.
-- 
-- * Slices of element nodes can be accessed using the slice notation
--   operation @[start:end:step]@. If start is omitted, the starting index
--   of the slice is implied to be zero; if end is omitted, the ending index
--   of the slice is implied to be the length of the array; if step is
--   omitted, the step of the slice is implied to be 1. For instance,
--   @$.store.book[:2]@ matches the first two elements of the book array
--   of the store object.
-- 
-- More information about JSONPath is available on Stefan Gössner\'s
-- <http://goessner.net/articles/JsonPath/ JSONPath website>.
-- 
-- == Example of JSONPath matches
-- 
-- The following example shows some of the results of using @JsonPath@
-- on a JSON tree. We use the following JSON description of a bookstore:
-- 
-- 
-- === /json code/
-- >{ "store": {
-- >    "book": [
-- >      { "category": "reference", "author": "Nigel Rees",
-- >        "title": "Sayings of the Century", "price": "8.95"  },
-- >      { "category": "fiction", "author": "Evelyn Waugh",
-- >        "title": "Sword of Honour", "price": "12.99" },
-- >      { "category": "fiction", "author": "Herman Melville",
-- >        "title": "Moby Dick", "isbn": "0-553-21311-3",
-- >        "price": "8.99" },
-- >      { "category": "fiction", "author": "J. R. R. Tolkien",
-- >        "title": "The Lord of the Rings", "isbn": "0-395-19395-8",
-- >        "price": "22.99" }
-- >    ],
-- >    "bicycle": { "color": "red", "price": "19.95" }
-- >  }
-- >}
-- 
-- 
-- We can parse the JSON using t'GI.Json.Objects.Parser.Parser':
-- 
-- 
-- === /c code/
-- >JsonParser *parser = json_parser_new ();
-- >json_parser_load_from_data (parser, json_data, -1, NULL);
-- 
-- 
-- If we run the following code:
-- 
-- 
-- === /c code/
-- >JsonNode *result;
-- >JsonPath *path = json_path_new ();
-- >json_path_compile (path, "$.store..author", NULL);
-- >result = json_path_match (path, json_parser_get_root (parser));
-- 
-- 
-- The @result@ node will contain an array with all values of the
-- author member of the objects in the JSON tree. If we use a
-- t'GI.Json.Objects.Generator.Generator' to convert the @result@ node to a string
-- and print it:
-- 
-- 
-- === /c code/
-- >JsonGenerator *generator = json_generator_new ();
-- >json_generator_set_root (generator, result);
-- >char *str = json_generator_to_data (generator, NULL);
-- >g_print ("Results: %s\n", str);
-- 
-- 
-- The output will be:
-- 
-- 
-- === /json code/
-- >["Nigel Rees","Evelyn Waugh","Herman Melville","J. R. R. Tolkien"]
-- 
-- 
-- /Since: 0.14/

#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif

module GI.Json.Objects.Path
    ( 

-- * Exported types
    Path(..)                                ,
    IsPath                                  ,
    toPath                                  ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [compile]("GI.Json.Objects.Path#g:method:compile"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [match]("GI.Json.Objects.Path#g:method:match"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolvePathMethod                       ,
#endif

-- ** compile #method:compile#

#if defined(ENABLE_OVERLOADING)
    PathCompileMethodInfo                   ,
#endif
    pathCompile                             ,


-- ** match #method:match#

#if defined(ENABLE_OVERLOADING)
    PathMatchMethodInfo                     ,
#endif
    pathMatch                               ,


-- ** new #method:new#

    pathNew                                 ,


-- ** query #method:query#

    pathQuery                               ,




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Json.Structs.Node as Json.Node

-- | Memory-managed wrapper type.
newtype Path = Path (SP.ManagedPtr Path)
    deriving (Path -> Path -> Bool
(Path -> Path -> Bool) -> (Path -> Path -> Bool) -> Eq Path
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Path -> Path -> Bool
== :: Path -> Path -> Bool
$c/= :: Path -> Path -> Bool
/= :: Path -> Path -> Bool
Eq)

instance SP.ManagedPtrNewtype Path where
    toManagedPtr :: Path -> ManagedPtr Path
toManagedPtr (Path ManagedPtr Path
p) = ManagedPtr Path
p

foreign import ccall "json_path_get_type"
    c_json_path_get_type :: IO B.Types.GType

instance B.Types.TypedObject Path where
    glibType :: IO GType
glibType = IO GType
c_json_path_get_type

instance B.Types.GObject Path

-- | Type class for types which can be safely cast to `Path`, for instance with `toPath`.
class (SP.GObject o, O.IsDescendantOf Path o) => IsPath o
instance (SP.GObject o, O.IsDescendantOf Path o) => IsPath o

instance O.HasParentTypes Path
type instance O.ParentTypes Path = '[GObject.Object.Object]

-- | Cast to `Path`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toPath :: (MIO.MonadIO m, IsPath o) => o -> m Path
toPath :: forall (m :: * -> *) o. (MonadIO m, IsPath o) => o -> m Path
toPath = IO Path -> m Path
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Path -> m Path) -> (o -> IO Path) -> o -> m Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr Path -> Path) -> o -> IO Path
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr Path -> Path
Path

-- | Convert 'Path' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe Path) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_json_path_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Path -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Path
P.Nothing = Ptr GValue -> Ptr Path -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr Path
forall a. Ptr a
FP.nullPtr :: FP.Ptr Path)
    gvalueSet_ Ptr GValue
gv (P.Just Path
obj) = Path -> (Ptr Path -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Path
obj (Ptr GValue -> Ptr Path -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Path)
gvalueGet_ Ptr GValue
gv = do
        Ptr Path
ptr <- Ptr GValue -> IO (Ptr Path)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr Path)
        if Ptr Path
ptr Ptr Path -> Ptr Path -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Path
forall a. Ptr a
FP.nullPtr
        then Path -> Maybe Path
forall a. a -> Maybe a
P.Just (Path -> Maybe Path) -> IO Path -> IO (Maybe Path)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Path -> Path) -> Ptr Path -> IO Path
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Path -> Path
Path Ptr Path
ptr
        else Maybe Path -> IO (Maybe Path)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Path
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolvePathMethod (t :: Symbol) (o :: *) :: * where
    ResolvePathMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolvePathMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolvePathMethod "compile" o = PathCompileMethodInfo
    ResolvePathMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolvePathMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolvePathMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolvePathMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolvePathMethod "match" o = PathMatchMethodInfo
    ResolvePathMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolvePathMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolvePathMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolvePathMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolvePathMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolvePathMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolvePathMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolvePathMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolvePathMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolvePathMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolvePathMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolvePathMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolvePathMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolvePathMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolvePathMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolvePathMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolvePathMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolvePathMethod t Path, O.OverloadedMethod info Path p) => OL.IsLabel t (Path -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolvePathMethod t Path, O.OverloadedMethod info Path p, R.HasField t Path p) => R.HasField t Path p where
    getField = O.overloadedMethod @info

#endif

instance (info ~ ResolvePathMethod t Path, O.OverloadedMethodInfo info Path) => OL.IsLabel t (O.MethodProxy info Path) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Path
type instance O.AttributeList Path = PathAttributeList
type PathAttributeList = ('[ ] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Path = PathSignalList
type PathSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method Path::new
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Json" , name = "Path" })
-- throws : False
-- Skip return : False

foreign import ccall "json_path_new" json_path_new :: 
    IO (Ptr Path)

-- | Creates a new @JsonPath@ instance.
-- 
-- Once created, the @JsonPath@ object should be used with
-- 'GI.Json.Objects.Path.pathCompile' and 'GI.Json.Objects.Path.pathMatch'.
-- 
-- /Since: 0.14/
pathNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Path
    -- ^ __Returns:__ the newly created path
pathNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Path
pathNew  = IO Path -> m Path
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Path -> m Path) -> IO Path -> m Path
forall a b. (a -> b) -> a -> b
$ do
    Ptr Path
result <- IO (Ptr Path)
json_path_new
    Text -> Ptr Path -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"pathNew" Ptr Path
result
    Path
result' <- ((ManagedPtr Path -> Path) -> Ptr Path -> IO Path
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Path -> Path
Path) Ptr Path
result
    Path -> IO Path
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Path
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Path::compile
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "path"
--           , argType = TInterface Name { namespace = "Json" , name = "Path" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a path" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "expression"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a JSONPath expression"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "json_path_compile" json_path_compile :: 
    Ptr Path ->                             -- path : TInterface (Name {namespace = "Json", name = "Path"})
    CString ->                              -- expression : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Validates and decomposes the given expression.
-- 
-- A JSONPath expression must be compiled before calling
-- 'GI.Json.Objects.Path.pathMatch'.
-- 
-- /Since: 0.14/
pathCompile ::
    (B.CallStack.HasCallStack, MonadIO m, IsPath a) =>
    a
    -- ^ /@path@/: a path
    -> T.Text
    -- ^ /@expression@/: a JSONPath expression
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
pathCompile :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPath a) =>
a -> Text -> m ()
pathCompile a
path Text
expression = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Path
path' <- a -> IO (Ptr Path)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
path
    CString
expression' <- Text -> IO CString
textToCString Text
expression
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Path -> CString -> Ptr (Ptr GError) -> IO CInt
json_path_compile Ptr Path
path' CString
expression'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
path
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
expression'
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
expression'
     )

#if defined(ENABLE_OVERLOADING)
data PathCompileMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsPath a) => O.OverloadedMethod PathCompileMethodInfo a signature where
    overloadedMethod = pathCompile

instance O.OverloadedMethodInfo PathCompileMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Json.Objects.Path.pathCompile",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-json-1.0.3/docs/GI-Json-Objects-Path.html#v:pathCompile"
        })


#endif

-- method Path::match
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "path"
--           , argType = TInterface Name { namespace = "Json" , name = "Path" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a compiled path" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "root"
--           , argType = TInterface Name { namespace = "Json" , name = "Node" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the root node of the JSON data to match"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Json" , name = "Node" })
-- throws : False
-- Skip return : False

foreign import ccall "json_path_match" json_path_match :: 
    Ptr Path ->                             -- path : TInterface (Name {namespace = "Json", name = "Path"})
    Ptr Json.Node.Node ->                   -- root : TInterface (Name {namespace = "Json", name = "Node"})
    IO (Ptr Json.Node.Node)

-- | Matches the JSON tree pointed by @root@ using the expression compiled
-- into the @JsonPath@.
-- 
-- The nodes matching the expression will be copied into an array.
-- 
-- /Since: 0.14/
pathMatch ::
    (B.CallStack.HasCallStack, MonadIO m, IsPath a) =>
    a
    -- ^ /@path@/: a compiled path
    -> Json.Node.Node
    -- ^ /@root@/: the root node of the JSON data to match
    -> m Json.Node.Node
    -- ^ __Returns:__ a newly-created node of type
    --   @JSON_NODE_ARRAY@ containing the array of matching nodes
pathMatch :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPath a) =>
a -> Node -> m Node
pathMatch a
path Node
root = IO Node -> m Node
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Node -> m Node) -> IO Node -> m Node
forall a b. (a -> b) -> a -> b
$ do
    Ptr Path
path' <- a -> IO (Ptr Path)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
path
    Ptr Node
root' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Node
root
    Ptr Node
result <- Ptr Path -> Ptr Node -> IO (Ptr Node)
json_path_match Ptr Path
path' Ptr Node
root'
    Text -> Ptr Node -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"pathMatch" Ptr Node
result
    Node
result' <- ((ManagedPtr Node -> Node) -> Ptr Node -> IO Node
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Node -> Node
Json.Node.Node) Ptr Node
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
path
    Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Node
root
    Node -> IO Node
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Node
result'

#if defined(ENABLE_OVERLOADING)
data PathMatchMethodInfo
instance (signature ~ (Json.Node.Node -> m Json.Node.Node), MonadIO m, IsPath a) => O.OverloadedMethod PathMatchMethodInfo a signature where
    overloadedMethod = pathMatch

instance O.OverloadedMethodInfo PathMatchMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Json.Objects.Path.pathMatch",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-json-1.0.3/docs/GI-Json-Objects-Path.html#v:pathMatch"
        })


#endif

-- method Path::query
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "expression"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a JSONPath expression"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "root"
--           , argType = TInterface Name { namespace = "Json" , name = "Node" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the root of a JSON tree"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Json" , name = "Node" })
-- throws : True
-- Skip return : False

foreign import ccall "json_path_query" json_path_query :: 
    CString ->                              -- expression : TBasicType TUTF8
    Ptr Json.Node.Node ->                   -- root : TInterface (Name {namespace = "Json", name = "Node"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Json.Node.Node)

-- | Queries a JSON tree using a JSONPath expression.
-- 
-- This function is a simple wrapper around 'GI.Json.Objects.Path.pathNew',
-- 'GI.Json.Objects.Path.pathCompile', and 'GI.Json.Objects.Path.pathMatch'. It implicitly
-- creates a @JsonPath@ instance, compiles the given expression and matches
-- it against the JSON tree pointed by @root@.
-- 
-- /Since: 0.14/
pathQuery ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@expression@/: a JSONPath expression
    -> Json.Node.Node
    -- ^ /@root@/: the root of a JSON tree
    -> m Json.Node.Node
    -- ^ __Returns:__ a newly-created node of type
    --   @JSON_NODE_ARRAY@ containing the array of matching nodes /(Can throw 'Data.GI.Base.GError.GError')/
pathQuery :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Node -> m Node
pathQuery Text
expression Node
root = IO Node -> m Node
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Node -> m Node) -> IO Node -> m Node
forall a b. (a -> b) -> a -> b
$ do
    CString
expression' <- Text -> IO CString
textToCString Text
expression
    Ptr Node
root' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Node
root
    IO Node -> IO () -> IO Node
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Node
result <- (Ptr (Ptr GError) -> IO (Ptr Node)) -> IO (Ptr Node)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Node)) -> IO (Ptr Node))
-> (Ptr (Ptr GError) -> IO (Ptr Node)) -> IO (Ptr Node)
forall a b. (a -> b) -> a -> b
$ CString -> Ptr Node -> Ptr (Ptr GError) -> IO (Ptr Node)
json_path_query CString
expression' Ptr Node
root'
        Text -> Ptr Node -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"pathQuery" Ptr Node
result
        Node
result' <- ((ManagedPtr Node -> Node) -> Ptr Node -> IO Node
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Node -> Node
Json.Node.Node) Ptr Node
result
        Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Node
root
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
expression'
        Node -> IO Node
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Node
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
expression'
     )

#if defined(ENABLE_OVERLOADING)
#endif