module Text.JSON.Combinators where

import Text.JSON
import Text.JSON.Types

import Prelude hiding ((.),id)
import Control.Category
import Control.Applicative
import Data.Partial
import Control.Monad

type JSObjTo a = Partial String (JSObject JSValue) a
type JSValTo a = Partial String JSValue a

valJS :: JSON a => JSValTo a
valJS = Partial (resultToEither . readJSON)

strJS :: JSValTo String
strJS = Partial str
    where str (JSString s) = Right (fromJSString s)
          str v = Left ("Not a JSString:\n\n" ++ show v)

arrJS :: JSValTo a -> JSValTo [a]
arrJS pa = Partial arr
    where arr (JSArray as) = mapM (apply pa) as -- !!! Would rather not use apply here
          arr v = Left ("Not a JSArray:\n\n" ++ show v)

-- orEmpty :: MonadPlus m => Partial String a (m b) -> Partial String a (m b)
-- orEmpty pa = pa <|> return mzero

objJS :: JSValTo (JSObject JSValue)
objJS = Partial obj
    where obj (JSObject o) = Right o
          obj v = Left ("Not a JSObject:\n\n" ++ show v)

lookupJS :: String -> JSObjTo JSValue
lookupJS s = Partial (\obj->
    case get_field obj s of
        Just v -> Right v
        Nothing -> Left ("Could not find field: " ++ s ++ "\nIn object:\n\n" ++ show obj))

inObj :: String -> JSObjTo a -> JSObjTo a
inObj s pa = pa . objJS . lookupJS s

objOf :: JSObjTo a -> JSValTo a
objOf pa = pa . objJS

-- | Lookup a field and apply a partial function to the result
-- eg 'll "artist" strJS' returns the string value of the field '"artist"'
ll :: String -> JSValTo a -> JSObjTo a
ll s pa = pa . lookupJS s

-- | Accounts for all the lazy ways of using json arrays.
-- If s is not found returns [].
-- If s is mapped to a single value returns a singleton list
-- If s is mapped to an array returns the array as a list
llArr :: String -> JSValTo a -> JSObjTo [a]
llArr s pa = (arrJS pa <|> fmap (:[]) pa) . (lookupJS s <|> return (JSArray []))