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)

-- |Evaluates JPath query on JSON String
jPath :: String -- ^ JPath query
	-> String 	-- ^ JSON as String
	-> Either String [JSValue] -- ^ Either error text or list of results
jPath query s = let json = (decode s) :: Result JSValue
	in case json of
		Error s -> Left s
		Ok json' -> jPath' query json'

-- |Evaluates JPath query on pre-parsed JSON
jPath' :: String  -- ^ JPath query
	-> JSValue -- ^ Parsed JSON
	-> Either String [JSValue] -- ^ Either error text or list of results
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]