-----------------------------------------------------------------------------
-- |
-- Module      :  Api.hs
--
-- Maintainer  :  adam.smyczek@gmail.com
-- Stability   :  experimental
-- Portability :  portable
--
-- ReviewBoard API
--
-- This module provides the basic ReviewBoard API calls.
-- All calls are executed inside the 'RBAction' monad that represents 
-- a session to the ReviewBoard server. A login to the server is performed
-- in the 'RBAction' run method 'runRBAction'.
--
-- All actions return the 'RBResponse' object that can be a 'RBok' with 
-- the response 'JSValue' or 'RBerr' containing the error message and
-- the encoded response, if received. Errors are handled in 
-- two ways:
--
-- * Network errors, for example connection errors throw an exception.
--
-- * Response errors resulting in for example invalid request parameters are
--   handled using the 'rbErrHandler' (by default print to stdin).
--
-- For details see ReviewBoard project page <http://code.google.com/p/reviewboard/>
--
-----------------------------------------------------------------------------

--  TODO: find a generic way to build API calls based on path

module ReviewBoard.Api (

    -- Modules
    module ReviewBoard.Core,
    module ReviewBoard.Browser,

    -- * API calls
    
    -- ** Users and groups
    userList,
    groupList,
    groupStar,
    groupUnstar,

    -- ** Review request
    reviewRequest,
    reviewRequestByChangenum,
    reviewRequestNew,
    reviewRequestDelete,
    reviewRequestSet,
    reviewRequestSetField,
    reviewRequestSaveDraft,
    reviewRequestDiscardDraft,
    reviewRequestStar,
    reviewRequestUnstar,
    reviewRequestDiffNew,
    reviewRequestScreenshotNew,
    reviewRequestListAll,
    reviewRequestListToGroup,
    reviewRequestListToUser,
    reviewRequestListFromUser,

    -- ** Review
    reviewAll,
    reviewSaveDraft,
    reviewDeleteDraft,
    reviewPublishDraft,

    -- ** Others
    repositoryList,

    -- * Types
    RRField(..),

    -- * Util functions
    execRBAction,
    rbPostRequest,
    rbGetRequest

    -- * Example
    -- $example1

    ) where

import ReviewBoard.Core
import ReviewBoard.Browser
import Network.URI
import Network.HTTP
import qualified Network.Browser as NB
import Data.Maybe
import Control.Monad.Error
import Control.Monad.State

-- ---------------------------------------------------------------------------
-- User handling API calls

-- | Search for a user or list all users if user is Nothing
--
userList :: Maybe String -> RBAction RBResponse
userList (Just u) =  rbGetRequest "users" [("query", u)]
userList Nothing  =  rbGetRequest "users" []

-- | Search for a group or list all group if Nothing
--
groupList :: Maybe String -> RBAction RBResponse
groupList (Just g) =  rbGetRequest "groups" [("query", g)]
groupList Nothing  =  rbGetRequest "groups" []

-- | Star group for group name
--
groupStar :: String -> RBAction RBResponse
groupStar g = rbGetRequest (concat ["groups/", g, "/star"]) []

-- | Unstar group for group name
--
groupUnstar :: String -> RBAction RBResponse
groupUnstar g = rbGetRequest (concat ["groups/", g, "/unstar"]) []

-- ---------------------------------------------------------------------------
-- Review request API calls

-- | Create new review request using the provided repository path and an optional
-- submit_as user. The returned response contains the @id@ of the new created
-- review request that can be accessed using 'rrId' helper function.
--
reviewRequestNew :: String -> Maybe String -> RBAction RBResponse
reviewRequestNew p (Just u) = rbPostRequest "reviewrequests/new" [("repository_path", p), ("submit_as", u)]
reviewRequestNew p Nothing  = rbPostRequest "reviewrequests/new" [("repository_path", p)]

-- | Delete review request with request @id@.
--
reviewRequestDelete :: Integer -> RBAction RBResponse
reviewRequestDelete id = rbPostRequest ("reviewrequests/" ++ show id ++ "/delete") []

-- | Get review request by @id@.
--
reviewRequest :: Integer -> RBAction RBResponse
reviewRequest id = rbPostRequest ("reviewrequests/" ++ show id ) []

-- | Get review request by repository @id@ and changenum @id@
--
reviewRequestByChangenum :: Integer -> Integer -> RBAction RBResponse
reviewRequestByChangenum rId cId = rbPostRequest (concat["reviewrequests/repository/", show rId, "/changenum/", show cId]) []

-- | Discard review request draft for @id@.
--
reviewRequestSaveDraft :: Integer -> RBAction RBResponse
reviewRequestSaveDraft id = rbPostRequest ("reviewrequests/" ++ show id ++ "/draft/save") []

-- | Save review request draft whith @id@.
--
reviewRequestDiscardDraft :: Integer -> RBAction RBResponse
reviewRequestDiscardDraft id = rbPostRequest ("reviewrequests/" ++ show id ++ "/draft/discard") []

-- | Set fields to review request draft with @id@.
--
reviewRequestSet :: Integer -> [(RRField, String)] -> RBAction RBResponse
reviewRequestSet id fs = rbPostRequest (concat ["reviewrequests/", show id, "/draft/set/"]) (map (\(f, v) -> (show f, v)) fs)

-- | Set one field for review request draft with @id@.
--
reviewRequestSetField :: Integer -> RRField -> String -> RBAction RBResponse
reviewRequestSetField id f v = rbPostRequest (concat ["reviewrequests/", show id, "/draft/set/", show f]) [("value", v)]

-- | Star review request for id
--
reviewRequestStar :: Integer -> RBAction RBResponse
reviewRequestStar id = rbGetRequest (concat ["reviewrequests/", show id, "/star"]) []

-- | Star review request for id
--
reviewRequestUnstar :: Integer -> RBAction RBResponse
reviewRequestUnstar id = rbGetRequest (concat ["reviewrequests/", show id, "/unstar"]) []

-- | Add a new diff to a review request with @id@, file path and the basedir parameter.
--
reviewRequestDiffNew :: Integer -> String -> FilePath -> RBAction RBResponse
reviewRequestDiffNew id bd fp = do
    uri  <- mkURI $ concat ["reviewrequests/", show id, "/diff/new"]
    let form = Form POST uri [fileUpload "path" fp "text/plain", textField "basedir" bd]
    runRequest form return

-- | Add a new screenshot with @file path@ to a review request with @id@
--
reviewRequestScreenshotNew :: Integer -> FilePath -> RBAction RBResponse
reviewRequestScreenshotNew id fp = do
    uri  <- mkURI $ concat ["reviewrequests/", show id, "/screenshot/new"]
    let form = Form POST uri [fileUpload "path" fp ((contentType . extension) fp)]
    runRequest form return
    where
        extension = reverse . takeWhile (/= '.') . reverse
        contentType "png"   = "image/png"
        contentType "gif"   = "image/gif"
        contentType "jpg"   = "image/jpeg"
        contentType "jpeg"  = "image/jpeg"
        contentType _       = "text/plain" -- fallback

-- | List all review requests with an optional status
--
reviewRequestListAll :: Maybe String -> RBAction RBResponse
reviewRequestListAll (Just s) = rbGetRequest "reviewrequests/all" [(show STATUS, s)]
reviewRequestListAll Nothing  = rbGetRequest "reviewrequests/all" []

-- | List review request assigned to a group with an optional status
--
reviewRequestListToGroup :: String -> Maybe String -> RBAction RBResponse
reviewRequestListToGroup g (Just s) = rbGetRequest ("reviewrequests/to/group/" ++ g) [(show STATUS, s)]
reviewRequestListToGroup g Nothing  = rbGetRequest ("reviewrequests/to/group/" ++ g) []

-- | List review request assigned to a user, directly or not with an optional status
--
reviewRequestListToUser :: String -> Bool -> Maybe String -> RBAction RBResponse
reviewRequestListToUser u True  (Just s) = rbGetRequest ("reviewrequests/to/user/" ++ u ++ "/directly") [(show STATUS, s)]
reviewRequestListToUser u True  Nothing  = rbGetRequest ("reviewrequests/to/user/" ++ u ++ "/directly") []
reviewRequestListToUser u False (Just s) = rbGetRequest ("reviewrequests/to/user/" ++ u) [(show STATUS, s)]
reviewRequestListToUser u False Nothing  = rbGetRequest ("reviewrequests/to/user/" ++ u) []

-- | Liste review request from a user with an optional status
--
reviewRequestListFromUser :: String  -> Maybe String -> RBAction RBResponse
reviewRequestListFromUser u (Just s) = rbGetRequest ("reviewrequests/from/user/" ++ u) [(show STATUS, s)]
reviewRequestListFromUser u Nothing  = rbGetRequest ("reviewrequests/from/user/" ++ u) []

-- ---------------------------------------------------------------------------
-- Review API calls

-- | List all reviews for review request @id@
--
reviewAll :: Integer -> RBAction RBResponse
reviewAll id = rbGetRequest ("reviewrequests/" ++ show id ++ "/reviews") []

-- | Publish review request draft for id
--
reviewPublishDraft :: Integer -> RBAction RBResponse
reviewPublishDraft id = rbPostRequest ("reviewrequests/" ++ show id ++ "/reviews/draft/publish") [("shipit", "False")]

-- | Save review draft for review request @id@
--
reviewSaveDraft :: Integer -> RBAction RBResponse
reviewSaveDraft id = rbPostRequest ("reviewrequests/" ++ show id ++ "/reviews/draft/save") []

-- | Delete review draft for review request @id@
--
reviewDeleteDraft :: Integer -> RBAction RBResponse
reviewDeleteDraft id = rbPostRequest ("reviewrequests/" ++ show id ++ "/reviews/draft/delete") []

-- ---------------------------------------------------------------------------
-- Other API calls

-- | List repositories
--
repositoryList :: RBAction RBResponse
repositoryList =  rbGetRequest "repositories" []

-- ---------------------------------------------------------------------------
-- Types

-- | Review request field type.
--
data RRField 
    = STATUS
    | PUBLIC
    | SUMMARY
    | DESCRIPTION
    | TESTING_DONE
    | BUGS_CLOSED
    | BRANCH
    | TARGET_GROUPS
    | TARGET_PEOPLE
    deriving (Eq, Enum, Bounded)

-- | Request field to name map.
--
rrFieldMap :: [(RRField, String)]
rrFieldMap =
    [ (STATUS,          "status")
    , (PUBLIC,          "public")
    , (SUMMARY,         "summary")
    , (DESCRIPTION,     "description")
    , (TESTING_DONE,    "testing_done")
    , (BUGS_CLOSED,     "bugs_closed")
    , (BRANCH,          "branch")
    , (TARGET_GROUPS,   "target_groups")
    , (TARGET_PEOPLE,   "target_people") ]

instance Show RRField where
    show = fromJust . flip lookup rrFieldMap

-- ---------------------------------------------------------------------------
-- API uitl functions

-- | Execute a ReviewBoard action using the provided URL, user
-- and password.
--
execRBAction :: String -> String -> String -> (RBAction a) -> IO a
execRBAction url user password action = do
    r <- runRBAction url user password action
    either error return $ fst r

-- | Default POST request builder for text field parameters only.
--
rbPostRequest :: String -> [(String, String)] -> RBAction RBResponse
rbPostRequest = rbRequest POST

-- | Default GET request builder for text field parameters only.
--
rbGetRequest :: String -> [(String, String)] -> RBAction RBResponse
rbGetRequest = rbRequest GET

-- | Generalized request runner for text field parameters only.
--
rbRequest :: RequestMethod -> String -> [(String, String)] -> RBAction RBResponse
rbRequest rm apiUrl attrs = do
    uri  <- mkURI apiUrl
    let form = Form rm uri (map (\(n, v) -> textField n v) attrs)
    runRequest form return

{- $example1

The following RBAction creates a new review request draft, sets some fields
and uploads a diff file:

>    import ReviewBoard.Api
>    import qualified ReviewBoard.Response as R

>    newRRAction :: RBAction ()
>    newRRAction = do
>        rsp <- reviewRequestNew "repository" Nothing
>        case rsp of
>            RBok r -> do
>                let id = R.id . R.review_request $ r
>                reviewRequestsSetField id TARGET_PEOPLE "reviewers"
>                reviewRequestsSetField id DESCRIPTION "Request description"
>                reviewRequestsDiffNew  id "basedir" "diffFileName"
>                reviewRequestSaveDraft id
>                liftIO $ print "Done."
>            RBerr s -> throwError s

To run this action, execute:

>   execRBAction "url" "user" "password" newRRAction

-}