module Text.JSON.JPath (jPath, jPath', jPathModify, jPathModify') 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 Element = ObjectLookup String | ArrayLookup Integer | WildcardLookup | DeepLookup deriving (Show)
jPath :: String
-> String
-> Either String [Json]
jPath query s = let json = JSON.fromString s
in either (Left) (Right . jPath' query) json
jPath' :: String
-> Json
-> [Json]
jPath' query v = let parsedQuery = parseExpression query
in either (const []) (\q -> jPathP q v) parsedQuery
jPathModify :: String
-> (Json -> Json)
-> String
-> Either String String
jPathModify query modifier json = either (Left) (Right . JSON.toString . jPathModify' query modifier) $ JSON.fromString json
jPathModify' :: String
-> (Json -> Json)
-> Json
-> Json
jPathModify' query modifier json = either (const json) (\q -> (jPathModifyP q modifier json)) $ parseExpression query
expression = do
result <- element `sepBy` slash
eof
return $ concat result
slash = string "/"
element :: GenParser Char st [Element]
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 :: [Element] -> 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 :: [Element] -> (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)