-----------------------------------------------------------------------------
-- |
-- Module      :  Response.hs
--
-- Maintainer  :  adam.smyczek@gmail.com
-- Stability   :  experimental
-- Portability :  portable
--
-- This is an optional module that provides additional functionality
-- to simplify handling of ReviewBoard responses.
--
-----------------------------------------------------------------------------

module ReviewBoard.Response (

    -- * JSON response utils
    js4name,
    js4path,
    js4spath,
    js2v,

    -- * Basic Response DSL
 
    -- | The DSL provides a function for most ReviewBoard JSObject members
    -- that directly returns the value of the member. The function name is equivalent
    -- to the name of the member element, for example values of a response:
    --
    -- > { "stat": "fail", 
    -- >   "err": {
    -- >     "msg": "You are not logged in", 
    -- >     "code": 103
    -- >   }
    -- > }
    -- 
    -- may be accessed as following:
    --
    -- > (msg . err) response
    -- > -- returns 'You are not logged in' :: String
    --
    -- > (code . err) response
    -- > -- returns 103 :: Integer
    -- 
    -- If the entry name represented by the function does not exist,
    -- an error is thrown.
    --
    -- The current function list is build by screen scraping ReviewBoard
    -- source code, so it's likely that some elements are missing. 
    -- The missing function can be added using 'mkrb' function. 
    -- Please drop me an email if you find one and I will include 
    -- this in the next version.
    --
    -- This approach for handling responses may change if I find a way
    -- to generate the DSL methods directly from ReviewBoard code.
    --
    mkrb,

    id,
    stat,
    err,
    msg,
    code,
    last_updated,
    summary,
    description,
    bugs_closed,
    branch,
    target_groups,
    target_people,
    public,
    name,
    timestamp,
    timesince,
    text,
    draft,
    username,
    first_name,
    last_name,
    fullname,
    email,
    repository,
    repositories,
    display_name,
    mailing_list,
    url,
    submitter,
    time_added,
    status,
    changenum,
    review_request,
    review_requests,
    testing_done,
    user,
    users,
    ship_it,
    body_top,
    body_bottom,
    comments,
    path,
    tool,
    filediff,
    interfilediff,
    first_line,
    last_line,
    num_lines,
    caption,
    title,
    image_url,
    screenshot,
    x,
    y,
    w,
    h,
    diffset,
    source_file,
    dest_file,
    source_revision,
    dest_detail,
    revision,
    head, 
    body

    ) where

import Prelude hiding (id, head)
import Text.JSON

-- ---------------------------------------------------------------------------
-- Some JSON helpers

-- | Get value for name from a JSObject or Nothing
-- if JSValue is not a JSObject
--
js4name :: String -> JSValue -> Maybe JSValue
js4name n (JSObject o) = findValue n (fromJSObject o)
js4name n _            = Nothing

-- | Get JSValue for name path, for example
-- for JSON object '{ \"obj1\" : { \"str\" : \"test\" } }'
-- js4path [\"obj1\", \"str\"] returns Just 'test'
--
js4path :: [String] -> JSValue -> Maybe JSValue
js4path []     v = Just v
js4path (x:xs) v = maybe Nothing (js4path xs) $ js4name x v

-- | Get JSValue for string path of the form
-- @reviewrequests.5.delete@. Dots inside a name
-- are not supported.
--
js4spath :: String -> JSValue -> Maybe JSValue
js4spath = js4path . split
    where
        split s | xs == []  = [x]
                | otherwise = x : split (tail xs)
                where (x, xs) = span (/='.') s

-- | Find value in object map
--
findValue :: String -> [(String, JSValue)] -> Maybe JSValue
findValue s []          = Nothing
findValue s ((n, v):xs) | s == n    = Just v
                        | otherwise = findValue s xs

-- | Extract value from JSValue or throw error
--
js2v :: (JSON a) => JSValue -> a
js2v v = case readJSON v of
    Ok a    -> a
    Error s -> error s

-- ---------------------------------------------------------------------------
-- Minimalistic DSL for parsing JSON response values

-- | Constructor for DSL functions
--
mkrb :: (JSON a) => String -> (JSValue -> a)
mkrb s = \v -> (js2v . fromJustWithError  s) (js4name s v)
    where
      fromJustWithError e Nothing  = error $ "Invalid response attribute " ++ e
      fromJustWithError _ (Just v) = v

-- TODO: the dsl should be generated from ReviewBoard source

-- Common attributes
id               = (mkrb "id")               :: JSValue -> Integer
last_updated     = (mkrb "last_updated")     :: JSValue -> String
summary          = (mkrb "summary")          :: JSValue -> String
description      = (mkrb "description")      :: JSValue -> String
bugs_closed      = (mkrb "bugs_closed")      :: JSValue -> JSValue
branch           = (mkrb "branch")           :: JSValue -> String
target_groups    = (mkrb "target_groups")    :: JSValue -> JSValue
target_people    = (mkrb "target_people")    :: JSValue -> JSValue
public           = (mkrb "public")           :: JSValue -> Bool
name             = (mkrb "name")             :: JSValue -> String
timestamp        = (mkrb "timestamp")        :: JSValue -> JSValue
timesince        = (mkrb "timesince")        :: JSValue -> String
text             = (mkrb "text")             :: JSValue -> String
draft            = (mkrb "draft")            :: JSValue -> JSValue
repository       = (mkrb "repository")       :: JSValue -> JSValue
repositories     = (mkrb "repositories")     :: JSValue -> [JSValue]

-- Attribute of status object
stat             = (mkrb "stat")             :: JSValue -> String
err              = (mkrb "err")              :: JSValue -> JSValue
msg              = (mkrb "msg")              :: JSValue -> String
code             = (mkrb "code")             :: JSValue -> String

-- Attributes of Group object
display_name     = (mkrb "display_name")     :: JSValue -> String
mailing_list     = (mkrb "mailing_list")     :: JSValue -> String
url              = (mkrb "url")              :: JSValue -> String

-- Attributes of User object
username         = (mkrb "username")         :: JSValue -> String
first_name       = (mkrb "first_name")       :: JSValue -> String
last_name        = (mkrb "last_name")        :: JSValue -> String
fullname         = (mkrb "fullname")         :: JSValue -> String
email            = (mkrb "email")            :: JSValue -> String

-- Attributes of ReviewRequest object
submitter        = (mkrb "submitter")        :: JSValue -> JSValue
time_added       = (mkrb "time_added")       :: JSValue -> String
status           = (mkrb "status")           :: JSValue -> String
changenum        = (mkrb "changenum")        :: JSValue -> Integer

-- Attributes of ReviewRequestDraft object
review_request   = (mkrb "review_request")   :: JSValue -> JSValue
review_requests  = (mkrb "review_requests")  :: JSValue -> [JSValue]
testing_done     = (mkrb "testing_done")     :: JSValue -> String

-- Attributes of Review
user             = (mkrb "user")             :: JSValue -> JSValue
users            = (mkrb "users")            :: JSValue -> [JSValue]
ship_it          = (mkrb "ship_it")          :: JSValue -> Bool
body_top         = (mkrb "body_top")         :: JSValue -> String
body_bottom      = (mkrb "body_bottom")      :: JSValue -> String
comments         = (mkrb "comments")         :: JSValue -> JSValue

-- Attributes of Repository object
path             = (mkrb "path")             :: JSValue -> String
tool             = (mkrb "tool")             :: JSValue -> String

-- Attributes of Comment object
filediff         = (mkrb "filediff")         :: JSValue -> JSValue
interfilediff    = (mkrb "interfilediff")    :: JSValue -> JSValue
first_line       = (mkrb "first_line")       :: JSValue -> Integer
last_line        = (mkrb "last_line")        :: JSValue -> Integer
num_lines        = (mkrb "num_lines")        :: JSValue -> Integer

-- Attributes of Comment object
caption          = (mkrb "caption")          :: JSValue -> String
title            = (mkrb "title")            :: JSValue -> String
image_url        = (mkrb "image_url")        :: JSValue -> String

-- Attributes of ScreenshotComment object
screenshot         = (mkrb "screenshot")     :: JSValue -> JSValue
x                  = (mkrb "x")              :: JSValue -> Integer
y                  = (mkrb "y")              :: JSValue -> Integer
w                  = (mkrb "w")              :: JSValue -> Integer
h                  = (mkrb "h")              :: JSValue -> Integer

-- Attributes of FileDiff object
diffset            = (mkrb "diffset")        :: JSValue -> JSValue
source_file        = (mkrb "source_file")    :: JSValue -> String
dest_file          = (mkrb "dest_file")      :: JSValue -> String
source_revision    = (mkrb "source_revision"):: JSValue -> String
dest_detail        = (mkrb "dest_detail")    :: JSValue -> String

-- Attributes of DiffSet object
revision           = (mkrb "revision")       :: JSValue -> Integer

-- Attributes of http response


head               = (mkrb "head")          :: JSValue -> [JSValue]
body               = (mkrb "body")          :: JSValue -> String