-----------------------------------------------------------------------------
-- |
-- Module      :  Request.hs
--
-- Maintainer  :  adam.smyczek@gmail.com
-- Stability   :  experimental
-- Portability :  portable
--
-- This module provides util functions to build ReviewBoard requests.
-- The current implementation for this small project is maybe an overkill, but it 
-- provides constants for URL path elements and
-- simplifies building API calls.
--
-- The call format is @method (path1 . path2 . path3) [form var]@
-- , for example the API GET call to
-- @\/api\/json\/reviewrequests\/5\/delete\/@ can be executed by calling
--
-- > get (reviewrequests (Just 5) . delete) []
--
-- The current approach to handle request may change if I find a way
-- to automatically generate API calls from ReviewBoard code.
--
-----------------------------------------------------------------------------
module ReviewBoard.Request (
    -- * URL path elements
    new,
    delete,
    save,
    discard,
    publish,
    update_from_changenum,
    star,
    unstar,
    all,
    to,
    from,
    count,
    directly,
    repositories,
    reviewrequest,
    comments,
    replies,
    draft,
    diff,
    screenshot,
    reviewrequests,
    reviews,
    groups,
    group,
    users,
    user,
    set,
    file,
    line,
    repository,
    changenum,

    -- * Types
    RRField(..),

    -- * Request methods
    get,
    post,

    -- * Util types and functions
    UrlPath,
    mkup,
    mkpup

    ) where

import Prelude hiding (all)
import ReviewBoard.Browser
import ReviewBoard.Core
import Network.HTTP hiding (user)
import Control.Monad.Trans
import Data.Maybe

-- ---------------------------------------------------------------------------
-- URL path elements

-- Constant definitions (UrlPath -> UrlPath)
new                     = mkup "new"
delete                  = mkup "delete"
save                    = mkup "save"
discard                 = mkup "discard"
publish                 = mkup "publish"
update_from_changenum   = mkup "repositories"

star                    = mkup "star"
unstar                  = mkup "unstar"

all                     = mkup "all"
to                      = mkup "to"
from                    = mkup "from"
count                   = mkup "count"
directly                = mkup "directly"

repositories            = mkup "repositories"
reviewrequest           = mkup "reviewrequest"
comments                = mkup "comments"
replies                 = mkup "replies"
draft                   = mkup "draft"
diff                    = mkup "diff"
screenshot              = mkup "screenshot"

-- Path elements with optional parameter
reviewrequests          = mkpup "reviewrequests" :: (Maybe Integer -> UrlPath -> UrlPath)
reviews                 = mkpup "reviews"        :: (Maybe Integer -> UrlPath -> UrlPath)
groups                  = mkpup "groups"         :: (Maybe String  -> UrlPath -> UrlPath)
group                   = mkpup "group"          :: (Maybe String  -> UrlPath -> UrlPath)
users                   = mkpup "users"          :: (Maybe String  -> UrlPath -> UrlPath)
user                    = mkpup "user"           :: (Maybe String  -> UrlPath -> UrlPath)
set                     = mkpup "set"            :: (Maybe RRField -> UrlPath -> UrlPath)
file                    = mkpup "file"           :: (Maybe Integer -> UrlPath -> UrlPath)
line                    = mkpup "line"           :: (Maybe Integer -> UrlPath -> UrlPath)

-- Other definitions
repository id   = mkup "repository" . mkup (show id)
changenum n     = mkup "changenum " . mkup (show n)

-- ---------------------------------------------------------------------------
-- 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

-- ---------------------------------------------------------------------------
-- Request functions

-- | GET request method
--
get :: (UrlPath -> UrlPath) -> [FormVar] -> RBAction RBResponse
get u vs = rbRequest GET (u "") vs

-- | GET request method
--
post :: (UrlPath -> UrlPath) -> [FormVar] -> RBAction RBResponse
post u vs = rbRequest POST (u "") vs

-- | Internal generalized request runner
--
rbRequest :: RequestMethod -> String -> [FormVar] -> RBAction RBResponse
rbRequest rm apiUrl vs = do
    uri  <- mkURI apiUrl
    let form = Form rm uri vs
    runRequest form return

-- ---------------------------------------------------------------------------
-- Util types and functions

-- | Synonym for URL path element
--
type UrlPath = String

-- | (MaKe UrlPath) Default URL element path maker
--
mkup :: String -> (UrlPath -> UrlPath)
mkup s = ((s ++ "/") ++)

-- | Make path element with a parameter of type a e.g.
-- reviewrequests (Just 5) => \"reviewrequests\/5\/\"
--
mkpup :: Show a => String -> (Maybe a -> UrlPath -> UrlPath)
mkpup s = \p u -> maybe (noparam u) (flip param u) p
    where
       noparam = mkup s
       param i = mkup s . mkup (show i)