jpath.hs

module Text.JSON.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 deriving (Show)

-- Parses (maybe) string and retrieves (maybe) value
jPath :: String -> String -> Maybe JSValue
jPath query s = let json = (decode s) :: Result JSValue
	in case json of
		Error s -> Nothing
		Ok json' -> jPath' query json'

expression = do
	result <- element `sepBy` slash
	eof
	return $ concat result

slash = string "/"

element :: GenParser Char st [Element]
element = do
	parsedName <- optionMaybe name
	parsedIndex <- optionMaybe index
	return $ catMaybes [parsedName, parsedIndex]

name = do
	parsedName <- many1 (noneOf "/[]")
	return $ ObjectLookup parsedName

index = do
	result <- between (string "[") (string "]") (many1 digit)
	return $ ArrayLookup $ read result

parseExpression = parse expression "(unknown)"

jPath' :: String -> JSValue -> Maybe JSValue
jPath' query v = let parsedQuery = parseExpression query
	in either (const Nothing) ((flip jPathP) v) parsedQuery

jPathP :: [Element] -> JSValue -> Maybe JSValue
jPathP [] v = Just v
jPathP (e:es) v = case e of
	ObjectLookup s -> case v of
		JSObject wtf -> maybe (Nothing) (jPathP es) $ s `lookup` (fromJSObject wtf)
		otherwise -> Nothing
	ArrayLookup i -> case v of
		JSArray vs -> if length vs > i then jPathP es $ vs !! i else Nothing
		otherwise -> Nothing