#!/usr/bin/env runhaskell
-----------------------------------------------------------------------------
-- |
-- Module : mkrr.hs
--
-- Maintainer : adam.smyczek@gmail.com
-- Stability : experimental
-- Portability : portable
--
-- @mkrr@ is a sample application demonstrating the usage of ReviewBoard bindings.
-- To submit a new review request just execute:
--
-- > svn diff | mkrr -r [reviewers]
--
-- from the local repository copy. Most of the required/optional parameters
-- may be pre-defined in @~/.mkrrrc@ config file. The configuration options
-- are:
--
-- * url - ReviewBoard server URL
--
-- * user - User name
--
-- * password - Password
--
-- * repository - Repository path, e.g. <http://svn.mycompany.com/svn/>
--
-- * basedir - Diff base dir, e.g. @/trunk@ in case @svn diff@ was executed
-- in @/trunk@ directory
--
-- * publish - Publish immediately (not supported by ReivewBoard yet)
--
-- Run @mkrr --help@ and see ReviewBoard documentation at
-- <http://code.google.com/p/reviewboard/wiki/ReviewBoardAPI>.
--
-----------------------------------------------------------------------------
module Main (main) where
import System.Environment
import System.Console.GetOpt
import System.IO
import System.Directory
import Control.Exception(finally)
import Data.List
import Data.Maybe
import Control.Monad.Trans
import Control.Monad
import Data.Char
import ReviewBoard.Api
import qualified ReviewBoard.Response as R
import Control.Monad.Error
-- | Main
--
main :: IO ()
main = do
-- Parse and validate command line options
(opts, _) <- getArgs >>= parseOpts
validateRequired opts
-- Create the review request action ...
let action = mkrrAction (fromJust . optRepository $ opts)
(fromJust . optBasedir $ opts)
(fromJust . optReviewers $ opts)
(optDescription opts)
(optScreenshot opts)
(optPublish opts)
-- ... and run it
execAction (fromJust . optUrl $ opts)
(fromJust . optUser $ opts)
(fromJust . optPassword $ opts)
action
-- | Run new review request action
--
execAction :: String -> String -> String -> (String -> RBAction ()) -> IO ()
execAction url user pass action = do
-- Get diff from stdin
diff <- hGetContents stdin
-- Write diff to temp file
td <- catch (getTemporaryDirectory) (\_ -> return ".")
(tfn, tfh) <- openTempFile td "rbDiff.diff"
mapM (hPutStrLn tfh) $ lines diff
hClose tfh
-- Run action and delete temp file
finally (execRBAction url user pass $ action tfn)
(do removeFile tfn)
-- | New review request action
--
mkrrAction :: String -> String -> String -> Maybe String -> Maybe String -> Bool -> String -> RBAction ()
mkrrAction rep basedir revs dsc ss pub tfn = do
-- Create new review request and get the id
rsp <- reviewRequestNew rep Nothing
case rsp of
RBok r -> do
let id = R.id . R.review_request $ r
-- Set some fields
reviewRequestSetField id TARGET_PEOPLE revs
setOptional id DESCRIPTION dsc
-- Upload the diff
reviewRequestDiffNew id basedir tfn
-- Upload screenshot if provided
when (isJust ss) ( do
reviewRequestScreenshotNew id $ fromJust ss
return ()
)
-- And store the review request draft
reviewRequestSaveDraft id
liftIO $ print "Done."
RBerr e -> throwError e
where
setOptional id f (Just v) = reviewRequestSetField id f v >>= \_ -> return ()
setOptional id f Nothing = return()
-- ---------------------------------------------------------------------------
-- Option handling
-- | Parse options
--
parseOpts :: [String] -> IO (Options, [String])
parseOpts argv = do
dos <- defaultOpts
case getOpt Permute options argv of
(o,n,[] ) -> return (foldl (flip id) dos o, n)
(_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options))
where
header = "Usage: mkrr [OPTION...]"
-- | Option set
--
data Options = Options
{ optUrl :: Maybe String
, optUser :: Maybe String
, optPassword :: Maybe String
, optRepository :: Maybe String
, optBasedir :: Maybe String
, optReviewers :: Maybe String
, optDescription :: Maybe String
, optScreenshot :: Maybe String
, optPublish :: Bool
} deriving Show
-- | Option descriptor list
--
options :: [OptDescr (Options -> Options)]
options =
[ Option ['u'] [] (ReqArg (\ u opts -> opts { optUrl = Just u }) "URL") "URL to ReviewBoard server"
, Option ['U'] [] (ReqArg (\ u opts -> opts { optUser = Just u }) "USER") "USER name"
, Option ['P'] [] (ReqArg (\ p opts -> opts { optPassword = Just p }) "PASSWORD") "User PASSWORD"
, Option ['R'] [] (ReqArg (\ r opts -> opts { optRepository = Just r }) "REROSITORY") "Repository path"
, Option ['b'] [] (ReqArg (\ r opts -> opts { optBasedir = Just r }) "BASEDIR") "Diff base dir"
, Option ['r'] [] (ReqArg (\ r opts -> opts { optReviewers = Just r }) "REVIEWERS") "Comma separated REVIEWERS list"
, Option ['d'] [] (ReqArg (\ r opts -> opts { optDescription = Just r }) "DESCRIPTION") "Optional request description"
, Option ['s'] [] (ReqArg (\ f opts -> opts { optScreenshot = Just f }) "SCREENSHOT") "attach SCREENSHOT"
, Option ['l'] [] (NoArg (\ opts -> opts { optPublish = True })) "Publish review"
]
-- | Load default options from configuration file
--
defaultOpts :: IO Options
defaultOpts = do
hd <- getHomeDirectory
cf <- readFile $ hd ++ "/.mkrrrc"
return $ foldl parseOpt initOpts $ lines cf
where
parseOpt os l | isPrefixOf "url" l = os { optUrl = Just $ parseValue l }
| isPrefixOf "user" l = os { optUser = Just $ parseValue l }
| isPrefixOf "password" l = os { optPassword = Just $ parseValue l }
| isPrefixOf "repository" l = os { optRepository = Just $ parseValue l }
| isPrefixOf "basedir" l = os { optBasedir = Just $ parseValue l }
| isPrefixOf "publish" l = os { optPublish = read $ parseValue l }
| otherwise = os
parseValue :: String -> String
parseValue = takeWhile (not . isSeparator) . dropWhile isSeparator . drop 1 . dropWhile (/= '=')
-- | Initial option set
--
initOpts :: Options
initOpts = Options
{ optUrl = Nothing
, optUser = Nothing
, optPassword = Nothing
, optRepository = Nothing
, optBasedir = Nothing
, optReviewers = Nothing
, optDescription = Nothing
, optScreenshot = Nothing
, optPublish = False }
-- | Validate required options
--
validateRequired :: Options -> IO ()
validateRequired opts = do
-- TODO: this is imperative, improve this
when (isNothing . optUrl $ opts) $ error $ "URL required!" ++ help
when (isNothing . optUser $ opts) $ error $ "USER required!" ++ help
when (isNothing . optPassword $ opts) $ error $ "PASSWORD required!" ++ help
when (isNothing . optRepository $ opts) $ error $ "REPOSITORY required!" ++ help
when (isNothing . optBasedir $ opts) $ error $ "BASEDIR required!" ++ help
when (isNothing . optReviewers $ opts) $ error $ "REVIEWERS required!" ++ help
where
help = " Try mkrr --help"