{- |
Module      : Data.Aeson.JSONPath
Description : Run JSONPath queries on Data.Aeson
Copyright   : (c) 2024-2025 Taimoor Zaeem
License     : MIT
Maintainer  : Taimoor Zaeem <mtaimoorzaeem@gmail.com>
Stability   : Experimental
Portability : Portable

Run JSONPath queries on Aeson Values using methods exported in this module.
-}
module Data.Aeson.JSONPath
  (
  -- * Using this library
  -- $use

  -- * API
    query
  , queryQQ
  , queryLocated
  , queryLocatedQQ

  -- * QuasiQuoter
  , jsonPath
  )
  where

import qualified Text.ParserCombinators.Parsec as P

import Data.Aeson                   (Value)
import Data.Vector                  (Vector)
import Language.Haskell.TH.Quote    (QuasiQuoter (..))
import Language.Haskell.TH.Syntax   (lift)

import Data.Aeson.JSONPath.Query.Types (Query (..))
import Data.Aeson.JSONPath.Query       (Queryable (..))
import Data.Aeson.JSONPath.Parser      (pQuery)

import Prelude

-- |
-- A 'QuasiQuoter' for checking valid JSONPath syntax at compile time
--
-- @
-- path :: Query
-- path = [jsonPath|$.store.records[0,1]|]
-- @
jsonPath :: QuasiQuoter
jsonPath :: QuasiQuoter
jsonPath = QuasiQuoter
  { quoteExp :: String -> Q Exp
quoteExp = \String
q -> case Parsec String () Query
-> String -> String -> Either ParseError Query
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
P.parse Parsec String () Query
pQuery (String
"failed to parse query: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
q) String
q of
      Left ParseError
err -> String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ ParseError -> String
forall a. Show a => a -> String
show ParseError
err
      Right Query
ex -> Query -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Query -> m Exp
lift Query
ex
  , quotePat :: String -> Q Pat
quotePat = String -> String -> Q Pat
forall a. HasCallStack => String -> a
error String
"Error: quotePat"
  , quoteType :: String -> Q Type
quoteType = String -> String -> Q Type
forall a. HasCallStack => String -> a
error String
"Error: quoteType"
  , quoteDec :: String -> Q [Dec]
quoteDec = String -> String -> Q [Dec]
forall a. HasCallStack => String -> a
error String
"Error: quoteDec"
  }

-- |
-- Use when query string is not known at compile time
--
-- @
-- >>> query "$.artist" json
-- Right [String "David Bowie"]
--
-- >>> query "$.art[ist" json
-- Left "failed to parse query: $.art[ist" (line 1, column 7)
-- @
-- For detailed usage examples, see: <https://github.com/taimoorzaeem/aeson-jsonpath?tab=readme-ov-file#aeson-jsonpath>
query :: String -> Value -> Either P.ParseError (Vector Value)
query :: String -> Value -> Either ParseError (Vector Value)
query String
q Value
root = do
  Query
parsedQuery <- Parsec String () Query
-> String -> String -> Either ParseError Query
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
P.parse Parsec String () Query
pQuery (String
"failed to parse query: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
q) String
q
  Vector Value -> Either ParseError (Vector Value)
forall a. a -> Either ParseError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector Value -> Either ParseError (Vector Value))
-> Vector Value -> Either ParseError (Vector Value)
forall a b. (a -> b) -> a -> b
$ Query -> Value -> Vector Value
queryQQ Query
parsedQuery Value
root


-- |
-- Use when query string is known at compile time
--
-- @
-- artist = queryQQ [jsonPath|$.artist|] json -- successfully compiles
--
-- >>> artist
-- [String "David Bowie"]
-- @
-- @
-- artist = queryQQ [jsonPath|$.art[ist|] json -- fails at compilation time
-- @
queryQQ :: Query -> Value -> Vector Value
queryQQ :: Query -> Value -> Vector Value
queryQQ Query
q Value
root = Query -> Value -> Value -> Vector Value
forall a. Queryable a => a -> Value -> Value -> Vector Value
query' Query
q Value
root Value
root

-- |
-- Get the location of the returned nodes along with the node
--
-- @
-- >>> queryLocated "$.title" json
-- Right [("$[\'title\']",String "Space Oddity")]
-- @
queryLocated :: String -> Value -> Either P.ParseError (Vector (String, Value))
queryLocated :: String -> Value -> Either ParseError (Vector (String, Value))
queryLocated String
q Value
root = do
  Query
parsedQuery <- Parsec String () Query
-> String -> String -> Either ParseError Query
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
P.parse Parsec String () Query
pQuery (String
"failed to parse query: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
q) String
q
  Vector (String, Value)
-> Either ParseError (Vector (String, Value))
forall a. a -> Either ParseError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector (String, Value)
 -> Either ParseError (Vector (String, Value)))
-> Vector (String, Value)
-> Either ParseError (Vector (String, Value))
forall a b. (a -> b) -> a -> b
$ Query -> Value -> Vector (String, Value)
queryLocatedQQ Query
parsedQuery Value
root

-- |
-- Same as 'queryLocated' but allows QuasiQuoter
--
-- @
-- artist = queryLocatedQQ [jsonPath|$.*|] json -- successfully compiles
--
-- >>> artist
-- [("$[\'artist\']",String "David Bowie"),
--  ("$[\'title\']",String "Space Oddity")]
-- @
queryLocatedQQ :: Query -> Value -> Vector (String, Value)
queryLocatedQQ :: Query -> Value -> Vector (String, Value)
queryLocatedQQ Query
q Value
root = Query -> Value -> Value -> String -> Vector (String, Value)
forall a.
Queryable a =>
a -> Value -> Value -> String -> Vector (String, Value)
queryLocated' Query
q Value
root Value
root String
"$"

-- $use
--
-- To use this package, I would suggest that you import this module like:
--
-- > {-# LANGUAGE QuasiQuotes #-}
-- > import qualified Data.Aeson.JSONPath as JSONPath
-- > import           Data.Aeson.JSONPath (jsonPath)
--
-- For this module, consider this json for the example queries
--
-- > { "artist": "David Bowie", "title": "Space Oddity" }