rezoom-0.0.2: Rezoom/JSON.hs

module Rezoom.JSON(
    parse
    , extractList, extractString
    , getOr
    , hasKey
    
    -- * JSON object accessors
    , ($$), ($$!)
    ) where
    import Text.JSON
    import Data.Maybe
    import Data.List
    import Control.Applicative ((<$>))
    
    parse :: String -> Either String JSValue
    parse = resultToEither . decode
    
    -- Look up a value in a JSON object
    ($$) :: JSValue -> String -> Maybe JSValue
    tree $$ idx = case filter (\x -> idx == (fst x)) (extractObject tree) of
        x:_ -> Just $ snd x
        [] -> Nothing
    
    -- Unsafe version of $$
    ($$!) :: JSValue -> String -> JSValue
    tree $$! idx = fromJust $ tree $$ idx
    
    hasKey :: String -> JSValue -> Bool
    hasKey idx tree = isJust $ tree $$ idx
    
    -- Version of $$ that allows you to provide an alternative value
    getOr :: String -> String -> JSValue -> String
    getOr alt index tree = maybe alt id $ extractString <$> tree $$ index
    
    -- map applied to a JSON list
    mapJ :: (JSValue -> a) -> JSValue -> [a]
    mapJ fn list = map fn $ extractList list
    
    -- sort applied to a JSON list
    sortJ :: (JSValue -> JSValue -> Ordering) -> JSValue -> [JSValue]
    sortJ fn list = sortBy fn $ extractList list
    
    -- Text.JSON's structure kind of sucks, so we need a bunch of
    -- generic extractor functions here
    extractObject :: JSValue -> [(String, JSValue)]
    extractObject (JSObject e) = fromJSObject e
    extractObject _ = error "invalid input"
    
    extractString :: JSValue -> String
    extractString (JSString e) = fromJSString e
    extractString _ = error "invalid input"
    
    extractList :: JSValue -> [JSValue]
    extractList (JSArray xs) = xs
    extractList _ = error "invalid input"