module Text.JSON.JPath (jPath, jPathModify, Json(..), QueryElement(..), HJsonLike, QueryLike) where
import qualified Data.Map as Map
import Data.List
import Data.Maybe
import Text.HJson as JSON
import Text.ParserCombinators.Parsec.Combinator
import Text.ParserCombinators.Parsec.Char
import Text.ParserCombinators.Parsec.Prim
data QueryElement
= ObjectLookup String
| ArrayLookup Integer
| WildcardLookup
| DeepLookup
deriving (Show)
class QueryLike a where
toQuery :: a -> [QueryElement]
instance QueryLike String where
toQuery = either (const []) (id) . parseExpression
instance QueryLike QueryElement where
toQuery e = [e]
instance QueryLike [QueryElement] where
toQuery = id
class HJsonLike a where
toHJson :: a -> Json
fromHJson :: Json -> a
instance HJsonLike String where
toHJson = either (const JNull) (id) . JSON.fromString
fromHJson = JSON.toString
instance HJsonLike Json where
toHJson = id
fromHJson = id
jPath :: (HJsonLike j, QueryLike q) =>
q
-> j
-> [j]
jPath q j =
let json = toHJson j;
query = toQuery q
in map (fromHJson) $ jPathP query json
jPathModify :: (HJsonLike j, QueryLike q) => q
-> (Json -> Json)
-> j
-> j
jPathModify q modifier j =
let json = toHJson j;
query = toQuery q
in fromHJson $ jPathModifyP query modifier json
expression = do
result <- element `sepBy` slash
eof
return $ concat result
slash = string "/"
element :: GenParser Char st [QueryElement]
element = do
parsedName <- optionMaybe (deepLookup <|> wildcard <|> name)
parsedIndex <- optionMaybe index
return $ catMaybes [parsedName, parsedIndex]
name = do
parsedName <- many1 (noneOf "/[]")
return $ ObjectLookup parsedName
deepLookup = do
string "**"
return DeepLookup
wildcard = do
string "*"
return WildcardLookup
integer = do
minus <- optionMaybe (string "-")
number <- many1 digit
return $ (fromMaybe "" minus) ++ number
index = do
result <- between (string "[") (string "]") integer
return $ ArrayLookup $ read result
parseExpression = parse expression "JPath query"
jPathP :: [QueryElement] -> Json -> [Json]
jPathP [] v = [v]
jPathP (e:es) v = case e of
ObjectLookup s -> case v of
JObject wtf -> maybe [] (jPathP es) $ s `Map.lookup` wtf
otherwise -> []
ArrayLookup i -> case v of
JArray vs -> if i >= genericLength vs || i < 0 genericLength vs then
[]
else
jPathP es $ vs `genericIndex` (if i < 0 then genericLength vs abs i else i)
otherwise -> []
WildcardLookup -> case v of
JObject wtf -> concat $ map (jPathP es) (Map.elems wtf)
JArray vs -> concat $ map (jPathP es) vs
otherwise -> []
DeepLookup -> concat [jPathP (WildcardLookup:es) v, jPathP ([WildcardLookup, DeepLookup] ++ es) v]
jPathModifyP :: [QueryElement] -> (Json -> Json) -> Json -> Json
jPathModifyP [] modifier v = modifier v
jPathModifyP (e:es) modifier v = let traverse = jPathModifyP es modifier in case e of
ObjectLookup s -> case v of
JObject wtf -> JObject $ Map.alter (Just . traverse . fromMaybe (JObject Map.empty)) s wtf
otherwise -> v
ArrayLookup i -> case v of
JArray vs -> if i >= genericLength vs || i < 0 genericLength vs then
JArray vs
else
let num = if i < 0 then genericLength vs abs i else i;
(hd, tl) = genericSplitAt (num + 1) vs
in JArray $ concat [init hd, [traverse (last hd)], tl]
otherwise -> v
WildcardLookup -> case v of
JObject wtf -> JObject $ Map.map (traverse) wtf
JArray vs -> JArray $ map (traverse) vs
otherwise -> v
DeepLookup -> jPathModifyP (WildcardLookup:es) modifier (jPathModifyP ([WildcardLookup, DeepLookup] ++ es) modifier v)