module Text.JSON.Combinators where

import Text.JSON
import Text.JSON.Types
import Text.JSON.Pretty

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

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

abbrevObj o =
    let ls = lines $ show $ pp_js_object o
    in  unlines $ if length ls > 40
                  then (take 20 ls ++ ["..."] ++ drop (length ls - 20) ls)
                  else ls

tracePartial (Partial f) = Partial (\ o -> left (++ ("\n\nFrom:\n\n" ++ abbrevObj o)) (f o))

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

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

arrJS = Partial arr
    where arr (JSArray as) = Right as
          arr v = Left ("Not a JSArray:\n\n" ++ show v)

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 = tracePartial (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 = tracePartial (pa . lookupJS s)

-- | Accounts for all the weird ways that lastFM use 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 =
    tracePartial (mapPartial pa . someOrNothing)
    where mapPartial = Partial . mapM . apply
          someOrNothing = (lazyArray . lookupJS s) <|> return []
          lazyArray = arrJS  <|> arr (:[])