module Text.JSON.JPath (jPath, jPath') where
import qualified Data.Map as Map
import Data.Maybe
import Text.JSON
import Text.ParserCombinators.Parsec.Combinator
import Text.ParserCombinators.Parsec.Char
import Text.ParserCombinators.Parsec.Prim
data Element = ObjectLookup String | ArrayLookup Int | WildcardLookup | DeepLookup deriving (Show)
jPath :: String
-> String
-> Either String [JSValue]
jPath query s = let json = (decode s) :: Result JSValue
in case json of
Error s -> Left s
Ok json' -> jPath' query json'
jPath' :: String
-> JSValue
-> Either String [JSValue]
jPath' query v = let parsedQuery = parseExpression query
in either (Left . show) (\q -> Right $ jPathP q v) parsedQuery
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] -> JSValue -> [JSValue]
jPathP [] v = [v]
jPathP (e:es) v = case e of
ObjectLookup s -> case v of
JSObject wtf -> maybe [] (jPathP es) $ s `lookup` (fromJSObject wtf)
otherwise -> []
ArrayLookup i -> case v of
JSArray vs -> if i >= length vs || i < 0 length vs then
[]
else
jPathP es $ vs !! (if i < 0 then length vs abs i else i)
otherwise -> []
WildcardLookup -> case v of
JSObject wtf -> concat $ map (jPathP es) (map (snd) $ fromJSObject wtf)
JSArray vs -> concat $ map (jPathP es) vs
otherwise -> []
DeepLookup -> concat [jPathP (WildcardLookup:es) v, jPathP ([WildcardLookup, DeepLookup] ++ es) v]