/Text/JSONQ.hs

  1{-# LANGUAGE OverloadedStrings #-}
  2module Text.JSONQ (
  3    JSONV, JSONQ, JSONS,
  4    jsonv, jsonv_,
  5    parseQ, parseQ_, check,
  6    showJSON, showQuery,
  7    query, query_,
  8) where
  9
 10import Data.Maybe
 11import qualified Data.ByteString.Char8 as B
 12import qualified Data.Map as M
 13
 14-- import Text.Regex.Posix -- To be added
 15import Text.JSON.AttoJSON
 16import Text.Parsec
 17import Text.Parsec.ByteString
 18
 19import System.IO.Unsafe
 20
 21-- | A JSONV (value) is a synonym for Text.JSON.AttoJSON.JSValue
 22type JSONV = JSValue
 23
 24-- | A JSONQ (query) is just a list of selectors.
 25type JSONQ = [JSONS]
 26
 27-- | A JSONS (selector)
 28data JSONS = Key B.ByteString
 29           | Pat B.ByteString
 30           | Idx Int
 31    deriving (Show)
 32
 33-- | Convert a string to either a JSONS or a parse error.
 34jsonv :: B.ByteString -> Either String JSONV
 35jsonv s = parseJSON s
 36
 37-- | Convert a string to a JSONS. If there is a parse
 38-- error, an IO error will be raised.
 39jsonv_ :: B.ByteString -> JSONV
 40jsonv_ s = case jsonv s of
 41                Right j -> j
 42                Left e -> error e
 43
 44-- | Renders a query back to a string that would
 45-- reproduce the query when parsed.
 46showQuery :: JSONQ -> String
 47showQuery [] = ""
 48showQuery (q:rest) = 
 49    let c = one q
 50        r = map dot rest
 51    in c ++ concat r
 52    where
 53        one q' = case q' of
 54                    (Key k) -> "'" ++ B.unpack k ++ "'"
 55                    (Idx i) -> "[" ++ show i ++ "]"
 56                    (Pat p) -> "<" ++ B.unpack p ++ ">"
 57        dot q' = case q' of
 58                    (Idx _) -> one q'
 59                    _       -> "." ++ one q'
 60
 61-- | Tries to parse a query. True if valid, False if broken.
 62check :: B.ByteString -> Bool
 63check s = case parseQ s of
 64            Left _ -> False
 65            Right _ -> True
 66
 67{- query and query_ only support exact paths into the tree -}
 68
 69-- | Run a raw query string against a JSONV.
 70query :: JSONV -> B.ByteString -> Either String JSONV
 71query v l' = runQuery v l
 72    where Right l = parseQ l'
 73
 74-- | Run a raw query string against a JSONV. Errors
 75-- are raised in IO.
 76query_ :: JSONV -> B.ByteString -> JSONV
 77query_ val l = case query val l of
 78                    Left e -> error e
 79                    Right v -> v
 80
 81queryMany :: JSONV -> B.ByteString -> Either String [JSONV]
 82queryMany = undefined
 83
 84queryMany_ :: JSONV -> B.ByteString -> [JSONV]
 85queryMany_ val l = case queryMany val l of
 86                            Left e -> error e
 87                            Right v -> v
 88
 89{- Non-exported functions. -}
 90
 91-- | Parse a JSONQ from an input string.
 92parseJSONQ :: Parser JSONQ
 93parseJSONQ = do
 94    qry <- parseGroup `sepBy1` (char '.')
 95    eof
 96    
 97    return $ concat qry
 98
 99-- | Parse a key and 0 to many indicies.
100parseGroup :: Parser [JSONS]
101parseGroup = do
102    k <- choice [parsePat,parseKey]
103    i <- many $ parseIdx
104
105    return (k : i)
106
107parsePat :: Parser JSONS
108parsePat = do
109    _ <- char '<'
110    pat <- many1 $ noneOf ">"
111    _ <- char '>'
112    return $ Pat $ B.pack pat
113
114-- | Parse a key
115parseKey :: Parser JSONS
116parseKey = try parseQuotedKey
117       <|> try parseNormKey
118
119-- | Parse an unquoted, alpha-numeric, key
120parseNormKey :: Parser JSONS
121parseNormKey = many1 alphaNum >>= return . Key . B.pack
122
123-- | Parse a quoted string.
124parseQuotedKey :: Parser JSONS
125parseQuotedKey = do
126    _ <- char '\''
127    k <- many (noneOf "\\'")
128    _ <- char '\''
129    return . Key . B.pack $ k
130
131-- | Parse an index
132parseIdx :: Parser JSONS
133parseIdx = do
134    _ <- char '['
135    d <- many1 digit
136    _ <- char ']'
137
138    return . Idx . read $ d
139
140-- | Shorthand to parse a query
141parseQ :: B.ByteString -> Either ParseError JSONQ
142parseQ = parse parseJSONQ "json-query"
143
144parseQ_ :: B.ByteString -> JSONQ
145parseQ_ s = case parseQ s of
146                (Left e) -> error $ show e
147                (Right q) -> q
148
149-- | Takes a value and a query. Applies the first selector
150-- and returns the remaining query and the selected value.
151decompose :: JSONV -> JSONQ -> Maybe (JSONQ, JSONV)
152decompose v [] = Just ([],v)
153decompose v (s:ss) = case (s,v) of
154                        (Key k, JSObject m) -> [g_map k m]
155                        (Pat p, JSObject m) -> extractMatch p m
156                        (Idx i, JSArray a)  -> [g_ary i a]
157    where
158        g_map k m = case M.member k m of
159                        True -> Just (ss, fromJust $ M.lookup k m)
160                        False -> Nothing
161        g_ary i a = case i < length a of
162                        True -> Just (ss, a !! i)
163                        False -> Nothing
164
165extractMatch :: B.ByteString -> (M.Map B.ByteString JSValue) -> Maybe (JSONQ, [JSONV])
166extractMatch p m = undefined
167
168-- | Run a query against a JSONV.
169runQuery :: JSONV -> JSONQ -> Either String JSONV
170runQuery v qry = case decompose v qry of
171                    (Just ([],   v')) -> Right $ v'
172                    (Just (rest, v')) -> runQuery v' rest
173                    Nothing -> Left $ "Unable to find " ++ (show qry)
174
175{- Test data -}
176
177input :: B.ByteString
178input = unsafePerformIO $ B.readFile "sw17ch.comments.json"
179
180{- An example using this data:
181 - jsonv_ input `q` "pets[0].name"
182 - > Right (JSString {fromJSString = "Malcolm"})
183 -}
184