From 51434dd66b03eea4762cc44b1d9b1ca62f7aac43 Mon Sep 17 00:00:00 2001 From: Nathaniel Filardo Date: Wed, 28 Dec 2016 19:52:57 -0500 Subject: [PATCH] Major rewrite of redmine.hs I'd forgotten about this repository! Oops! Anyway, it's here and it's checked in now. Much of the work done here is in preparation for subcommands which consume entries in the server in addition to populating them. In the process, we've moved from 'wreq' to 'req', a more-modern web framework (or at least, one with more active development) --- NOTES | 55 +++-- redmine.hs | 670 +++++++++++++++++++++++++++++++++++------------------ 2 files changed, 484 insertions(+), 241 deletions(-) diff --git a/NOTES b/NOTES index 3bc8ebe..9581558 100644 --- a/NOTES +++ b/NOTES @@ -13,8 +13,8 @@ through some magical process that is not clear to this author (i.e. nwf): Reviewer A should be a *student* and reviewer B should be *faculty*. The import script (below) depends on this when it picks assignees, trying reviewer B first. -Using csvRedmine.hs -=================== +Using redmine.hs +================ One-time Setup -------------- @@ -33,36 +33,55 @@ At a Bourne shell:: cabal update HPKGS=( - cassava-conduit - cmdlib - wreq + base bytestring mtl text transformers-base unordered-containers + regex-posix + monad-control + conduit conduit-extra + microlens microlens-th + aeson lens-aeson + cassava cassava-conduit + connection http-client http-client-tls + optparse-applicative + data-default + req ) cabal install -j --disable-tests ${HPKGS[@]} + ghc --make -hide-all-packages "${HPKGS[@]/#/-package }" redmine.hs + +Sorry about the need to explicitly pick a Debian release for new enough ghc +(the -t jessie-backports bit). Perhaps by the time you're reading this, it +won't be necessary. -Sorry about the need to explicitly pick a Debian release for new enough ghc. -Perhaps by the time you're reading this, it won't be necessary. +You can also leave off the last step and use 'runghc redmine.hs' everywhere +rather than './redmine' below. This is especially handy if you're writing +additions to the script. Running ------- +redmine.hs has "subcommands", the one you most likely care about is "upsert". +However, as many commands take common options, redmine expects those before +the subcommand name. As such, you are probably best off setting :: + + REDMINEHS="./redmine -h clsp-redmine.cs.jhu.edu -a $your_auth_token -p $project_name" + +and use this alias throughout your interaction. Common help can be gotten +by "./redmine --help" and each subcommand also understands "--help" for its +own parameters. + +Upsert +`````` + Review your proposed changes, if you like. This is probably a good idea; look through the output to see if something's likely to go wrong; the script tries to flag anything really egregious with "ERR". :: - runghc csvRedmine.hs \ - -h https://clsp-redmine.cs.jhu.edu \ - -a $your_auth_token \ - -p $project_name \ - upsert -n < foo.csv + $REDMINEHS upsert -n < foo.csv Commit your changes to the server: - runghc csvRedmine.hs \ - -h https://clsp-redmine.cs.jhu.edu \ - -a $your_auth_token \ - -p $project_name \ - upsert -x < foo.csv + $REDMINEHS upsert -x < foo.csv The ``-x`` indicates that we should clobber existing entries; leave it off if -you are just out to create new ones. +you are just out to create new ones. See "$REDMINEHS upsert --help" diff --git a/redmine.hs b/redmine.hs index 9147fde..87fb803 100644 --- a/redmine.hs +++ b/redmine.hs @@ -1,53 +1,56 @@ -- Headers ------------------------------------------------------------- {{{ - -{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, FlexibleInstances, +{-# LANGUAGE DataKinds, DeriveDataTypeable, FlexibleContexts, + FlexibleInstances, GADTs, GeneralizedNewtypeDeriving, MultiParamTypeClasses, RankNTypes, OverloadedStrings, ScopedTypeVariables, + StandaloneDeriving, TemplateHaskell, TypeFamilies, UndecidableInstances #-} {-# OPTIONS_GHC -Wall #-} module Main(main) where import Control.Exception(handle) -import Control.Monad.Trans(MonadIO, liftIO) +import Control.Monad(join,when) +import Control.Monad.Trans(MonadIO, liftIO, lift) import Data.Monoid((<>)) import Data.String(fromString) import Data.Text(Text) import System.IO(stderr) +import Text.Read(readMaybe) import Control.Applicative -import qualified Control.Lens as L -import Control.Lens.Operators import qualified Control.Monad.Reader as MR import qualified Control.Monad.Base as MC +import qualified Control.Monad.Except as ME import qualified Control.Monad.Trans.Control as MC import qualified Data.Aeson as A import qualified Data.Aeson.Lens as A -import qualified Data.Aeson.Types as A import qualified Data.ByteString.Char8 as BS8 import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy.Char8 as BL8 +import qualified Data.Char as DC import qualified Data.Conduit as C import qualified Data.Conduit.Binary as CB import qualified Data.Conduit.List as CL import qualified Data.Csv as CSV import qualified Data.Csv.Conduit as CSV -import qualified Data.Data as D +import qualified Data.Default as Def import qualified Data.HashMap.Strict as DHS import qualified Data.Maybe as M import qualified Data.Text as T --- import qualified Data.Vector.Lens as L --- import qualified Debug.Trace as DT +import qualified Data.Word as DW +import Lens.Micro as L +import qualified Lens.Micro.TH as L import qualified Network.Connection as N import qualified Network.HTTP.Client as N import qualified Network.HTTP.Client.Internal as N import qualified Network.HTTP.Client.TLS as N -import qualified Network.Wreq as W -import qualified Network.Wreq.Session as WS -import qualified System.Console.CmdLib as Cm +import qualified Network.HTTP.Req as WR +import qualified Options.Applicative as OA import qualified System.IO as IO import qualified Text.Regex.Posix as Re +-- import qualified Debug.Trace as DT ------------------------------------------------------------------------ }}} -- Early Type Definitions----------------------------------------------- {{{ @@ -59,6 +62,7 @@ data RedmineInfo = RI , _ri_trackId :: Integer , _ri_cf_areas :: Integer , _ri_cf_citizen :: Integer + , _ri_cf_email :: Integer , _ri_cf_faculty :: Integer , _ri_cf_gre :: Integer , _ri_cf_insts :: Integer @@ -66,10 +70,42 @@ data RedmineInfo = RI , _ri_cf_pdfURL :: Integer , _ri_cf_toefl :: Integer , _ri_cf_triageA :: Integer + , _ri_cf_scoreA :: Integer , _ri_cf_triageB :: Integer + , _ri_cf_scoreB :: Integer } $(L.makeLenses ''RedmineInfo) +------------------------------------------------------------------------ }}} +-- Redmine Applicant Data ---------------------------------------------- {{{ + +-- This approximates the Redmine schema. If that changes over time, this is +-- the right place to start changing this file. Note that these are +-- parameterized on the type of reviewers (and, perhaps, should be +-- parameterized on other things too); reason being that we need to go to +-- Redmine and ask it for the identifiers of users. So we move from email +-- text to numerics at some point (see 'lookupReviewers') + +data RedmineApplicant uid = RedmineApplicant + { _ra_jhuAppId :: Text + , _ra_email :: Text + , _ra_pdfURL :: Text + , _ra_subject :: Text -- formed from name fields + , _ra_citizen_us :: Bool + , _ra_areas :: [Text] -- formed from area fields + , _ra_faculty :: Text + , _ra_insts :: Text -- formed from inst field + , _ra_gre :: Text -- formed from GRE data + , _ra_toefl :: Text -- formed from TOEFL data + , _ra_reviewer1 :: uid + , _ra_score1 :: Maybe Integer + , _ra_reviewer2 :: uid + , _ra_score2 :: Maybe Integer + , _ra_assignee :: uid -- XXX not in CSV + } + deriving (Eq,Ord,Show) +$(L.makeLenses ''RedmineApplicant) + ------------------------------------------------------------------------ }}} -- CSV Data ------------------------------------------------------------ {{{ @@ -157,9 +193,9 @@ instance CSV.FromNamedRecord CSVApplicant where >>= (ca_insts $ \_ -> (filter (/= ("","",""))) <$> sequence - [ (,,) <$> grab' "Inst 1" <*> grab' "Deg 1" <*> grab' "GPA1" - , (,,) <$> grab' "Inst 2" <*> grab' "Deg 2" <*> grab' "GPA2" - , (,,) <$> grab' "Institution Name3" <*> grab' "Degree Awarded3" <*> grab' "GPA3" + [ (,,) <$> grab' "Institution 1" <*> grab' "Degree 1" <*> grab' "GPA1" + , (,,) <$> grab' "Institution 2" <*> grab' "Degree 2" <*> grab' "GPA2" + , (,,) <$> grab' "Institution 3" <*> grab' "Degree 3" <*> grab' "GPA3" ]) >>= (ca_gre $ \_ -> (filter (/= defGREText)) @@ -188,49 +224,22 @@ instance CSV.FromNamedRecord CSVApplicant where grabDef d f _ = fmap (maybe d id) (grabOpt' f) -showCSVError :: CSV.CsvParseError -> String -showCSVError (CSV.IncrementalError e) = "ERR: Incremental CSV parse error: " ++ e -showCSVError (CSV.CsvParseError bs e) = "ERR: CSV Parse error: " ++ (show bs) ++ ":" ++ e - ------------------------------------------------------------------------ }}} ------------------------------------------------------------------------ }}} --- Redmine Applicant Data ---------------------------------------------- {{{ - --- This approximates the Redmine schema. If that changes over time, this is --- the right place to start changing this file. Note that these are --- parameterized on the type of reviewers (and, perhaps, should be --- parameterized on other things too); reason being that we need to go to --- Redmine and ask it for the identifiers of users. So we move from email --- text to numerics at some point (see 'lookupReviewers') - -data RedmineApplicant uid = RedmineApplicant - { _ra_jhuAppId :: Text - , _ra_pdfURL :: Text - , _ra_subject :: Text -- formed from name fields - , _ra_citizen_us :: Bool - , _ra_areas :: [Text] -- formed from area fields - , _ra_faculty :: Text - , _ra_insts :: Text -- formed from inst field - , _ra_gre :: Text -- formed from GRE data - , _ra_toefl :: Text -- formed from TOEFL data - , _ra_reviewer1 :: uid - , _ra_reviewer2 :: uid - , _ra_assignee :: uid -- XXX not in CSV - } - deriving (Eq,Ord,Show) -$(L.makeLenses ''RedmineApplicant) - ---- Redmine Applicant From CSV ----------------------------------------- {{{ +-- Redmine Applicant From CSV ------------------------------------------ {{{ -- Here's our schema conversion, mostly. csvToRedmine :: CSVApplicant -> RedmineApplicant Text csvToRedmine ca = RedmineApplicant { _ra_jhuAppId = _ca_jhuAppId ca + , _ra_email = _ca_email ca , _ra_pdfURL = _ca_pdfURL ca , _ra_faculty = _ca_faculty ca , _ra_reviewer1 = _ca_reviewer1 ca -- copy across emails + , _ra_score1 = Nothing , _ra_reviewer2 = _ca_reviewer2 ca + , _ra_score2 = Nothing , _ra_assignee = error "Initial applicant assignee should not be accessed" , _ra_citizen_us = _ca_citizen ca == "U.S. Citizen" @@ -246,7 +255,7 @@ csvToRedmine ca = RedmineApplicant $ flip map (_ca_gre ca) $ \(GREText (qs,qp) (vs,vp) (ws,wp)) -> T.concat [mkQ qs, "M " , mkQ vs, "V " , mkQ ws, "AW (" - ,mkQ qp, "%, ", mkQ vp, "%," , mkQ wp, "%)"] + ,mkQ qp, "%, ", mkQ vp, "%, ", mkQ wp, "%)"] , _ra_toefl = ($ _ca_toefl ca) $ \tt@(TOEFLText cbt t l r s w) -> if tt == defTOEFLText @@ -271,49 +280,20 @@ csvToRedmine ca = RedmineApplicant --- let Right (_, d) = decodeCSV fc --- print (V.map csvToRedmine d) ------------------------------------------------------------------------- }}} ------------------------------------------------------------------------ }}} -- Redmine API Details ------------------------------------------------- {{{ - -data RestTD = RTD - { _rtd_sess :: WS.Session - , _rtd_opts :: W.Options - , _rtd_base :: String - , _rtd_show_resps :: W.Response BL.ByteString -> IO () - } -$(L.makeLensesFor [("_rtd_opts", "rtd_opts")] ''RestTD) - --- | Package up most things we need to make ReSTful queries -newtype RestT m a = RestT { runRestT :: MR.ReaderT RestTD m a } - deriving (Applicative,Functor,Monad,MonadIO,MR.MonadTrans,MR.MonadReader RestTD) - --- Yikes... we need these to get exception handlers working with our --- RestT transformer. Thankfully it's "chant default a lot". -instance (MC.MonadBase b m) => MC.MonadBase b (RestT m) where - liftBase = RestT . MC.liftBase - -instance MC.MonadTransControl RestT where - type StT RestT a = a - liftWith = MC.defaultLiftWith RestT runRestT - restoreT = MC.defaultRestoreT RestT - -instance (MC.MonadBaseControl b m) => MC.MonadBaseControl b (RestT m) where - type StM (RestT m) a = MC.ComposeSt RestT m a - liftBaseWith = MC.defaultLiftBaseWith - restoreM = MC.defaultRestoreM - --- Redmine API Query Core --------------------------------------------- {{{ -- Return the entire response body as well as a descended piece of it -redmineQuery :: MonadIO m - => IO (W.Response BL.ByteString) +redmineQuery :: (MonadIO m, WR.MonadHttp m) + => m (WR.JsonResponse A.Value) -> Text -> m (A.Value, A.Value) redmineQuery q d = do - resp :: W.Response A.Value <- liftIO (W.asJSON =<< q) - let rb = resp ^. W.responseBody + resp <- q + let rb = WR.responseBody resp case rb ^? A.key d of - Nothing -> error $ "ERR: Invalid Redmine response? " ++ (show resp) + Nothing -> error $ "ERR: Invalid Redmine response? " ++ (show $ WR.toVanillaResponse resp) Just value -> pure (rb, value) -- Sometimes we need to make Redmine queries for lists of things. Sometimes @@ -322,21 +302,20 @@ redmineQuery q d = do -- Hooray. redmineList, redmineListCursor :: MonadIO m - => String -- ^ URL suffix + => Text -- ^ URL suffix -> Text -- ^ Field to look for in Redmine response - -> C.ConduitM i A.Value (RestT m) () + -> C.ConduitM i A.Value (RestT scheme e m) () redmineList u d = do - RTD s o b vp <- MR.ask - (_, value) <- redmineQuery (WS.getWith o s (b ++ u) >>= \resp -> vp resp >> pure resp) d + RTD b _ o _ <- MR.ask + (_, value) <- lift $ redmineQuery (WR.req WR.GET (b WR./~ u) WR.NoReqBody WR.jsonResponse o) d CL.sourceList $ value ^.. A.values redmineListCursor u d = do - RTD s o b vp <- MR.ask - let fetch n = WS.getWith (o & W.param "offset" .~ [T.pack $ show n]) s (b ++ u) - >>= \resp -> vp resp >> pure resp + RTD b _ o _ <- MR.ask + let fetch n = WR.req WR.GET (b WR./~ u) WR.NoReqBody WR.jsonResponse (o <> "offset" WR.=: (T.pack $ show n)) go fetch 0 where go fetch off = do - (rb, value) <- redmineQuery (fetch off) d + (rb, value) <- lift $ redmineQuery (fetch off) d CL.sourceList $ value ^.. A.values maybe (error $ "ERR: JSON response missing position information: " ++ show rb) (\(tc,ooff,olim) -> if ooff + olim < tc then go fetch (ooff+olim) else return ()) @@ -355,10 +334,10 @@ redmineListCursor u d = do -- than values we care about later. That stinks. This is a convenience -- wrapper that maps us from the values we care about to the identifiers. withRedmineIdThing :: (MonadIO m, A.AsValue s) - => Text -- ^ Field carrying the name - -> ([Integer] -> m a) -- ^ Error callback - -> C.Conduit () m s -- ^ Source conduit - -> Text -- ^ Name of thing to look for + => Text -- ^ Field carrying the name + -> (Text -> [Integer] -> m a) -- ^ Error callback + -> C.Conduit () m s -- ^ Source conduit + -> Text -- ^ Name of thing to look for -> (Integer -> m a) -> m a withRedmineIdThing k err cond name f = do @@ -368,16 +347,16 @@ withRedmineIdThing k err cond name f = do C.=$= CL.mapMaybe (\p -> p ^? A.key "id" . A._Integer) case ids of [i] -> f i - _ -> err ids + _ -> err name ids -- A lot of Redmine things use "name" as the value we care about *and* -- we don't necessarily care about all the fancy error handling that -- the generic `withRedmineIdThing` would give us. This is a simplified -- interface. redmineIdNamed :: (MonadIO m, A.AsValue s) - => ([Integer] -> m Integer) -- ^ Error callback - -> C.Conduit () m s -- ^ Source conduit - -> Text -- ^ Name of thing to look for + => (Text -> [Integer] -> m Integer) -- ^ Error callback + -> C.Conduit () m s -- ^ Source conduit + -> Text -- ^ Name of thing to look for -> m Integer redmineIdNamed err cond name = withRedmineIdThing "name" err cond name pure @@ -388,19 +367,55 @@ redmineIdNamed err cond name = withRedmineIdThing "name" err cond name pure -- Using the above functions, make some convenience enumerators ("source -- conduits") for things in Redmine we care about. -redmineProjects, redmineUsers, redmineTrackers, redmineCustomFields, redmineIssues - :: MonadIO m => C.ConduitM i A.Value (RestT m) () -redmineProjects = redmineListCursor "/projects.json" "projects" -redmineUsers = redmineListCursor "/users.json" "users" -redmineIssues = redmineListCursor "/issues.json" "issues" -redmineTrackers = redmineList "/trackers.json" "trackers" -redmineCustomFields = redmineList "/custom_fields.json" "custom_fields" +redmineProjects, redmineUsers, redmineTrackers, redmineCustomFields, + redmineIssues, redmineIssueStats + :: MonadIO m => C.ConduitM i A.Value (RestT scheme e m) () +redmineProjects = redmineListCursor "projects.json" "projects" +redmineUsers = redmineListCursor "users.json" "users" +redmineIssues = redmineListCursor "issues.json" "issues" +redmineIssueStats = redmineList "issue_statuses.json" "issue_statuses" +redmineTrackers = redmineList "trackers.json" "trackers" +redmineCustomFields = redmineList "custom_fields.json" "custom_fields" ------------------------------------------------------------------------ }}} ---- Redmine Applicant To JSON ------------------------------------------ {{{ +--- Redmine API Updates ------------------------------------------------ {{{ + +-- Construct a new applicant; note that we have to add the project_id and +-- tracker_id from the RedmineInfo we have. +redmineNewIssue :: RedmineInfo -> RedmineApplicant (Maybe Integer) -> RestT scheme e IO WR.LbsResponse +redmineNewIssue ri ra = do + RTD u _ o _ <- MR.ask + let (A.Object fs) = jsonifyRedmineApp ri ra + let fs' = (DHS.fromList [ "project_id" A..= (ri ^. ri_projId), "tracker_id" A..= (ri ^. ri_trackId) ]) <> fs + WR.req WR.POST (u WR./: "issues.json") (WR.ReqBodyJson $ A.object ["issue" A..= fs']) WR.lbsResponse o + +-- Update an existing applicant; sends all fields and Redmine sorts it out +redmineUpdateIssue :: RedmineInfo -> Integer -> RedmineApplicant (Maybe Integer) -> RestT scheme e IO WR.LbsResponse +redmineUpdateIssue ri n ra = do + RTD u _ o _ <- MR.ask + WR.req WR.PUT + (u WR./: "issues" WR./: (T.pack (show n ++ ".json"))) + (WR.ReqBodyJson $ A.object ["issue" A..= jsonifyRedmineApp ri ra]) + WR.lbsResponse + o + +-- Update the status of an issue; status information is not captured in +-- RedmineApplicant for the moment (but perhaps it should be) +redmineUpdateIssueStatus :: Integer -> Integer -> RestT scheme e IO WR.LbsResponse +redmineUpdateIssueStatus which what = do + RTD u _ o _ <- MR.ask + WR.req WR.PUT + (u WR./: "issues" WR./: (T.pack (show which ++ ".json"))) + (WR.ReqBodyJson $ A.object ["issue" A..= A.object [ "status_id" A..= what ]]) + WR.lbsResponse + o + +------------------------------------------------------------------------ }}} +------------------------------------------------------------------------ }}} +-- Redmine Applicant To JSON ------------------------------------------- {{{ -- Map reviewer emails to possible identifiers -lookupReviewers :: RedmineApplicant Text -> RestT IO (RedmineApplicant (Maybe Integer)) +lookupReviewers :: RedmineApplicant Text -> RestT scheme e IO (RedmineApplicant (Maybe Integer)) lookupReviewers ra = do r1id <- findUserMaybe (_ra_reviewer1 ra) r2id <- findUserMaybe (_ra_reviewer2 ra) @@ -408,7 +423,7 @@ lookupReviewers ra = do let assignee = r2id <|> r1id pure $ ra { _ra_reviewer1 = r1id, _ra_reviewer2 = r2id, _ra_assignee = assignee } where - findUserMaybe :: Text -> RestT IO (Maybe Integer) + findUserMaybe :: Text -> RestT scheme e IO (Maybe Integer) findUserMaybe ue = -- Sometimes we don't have a reviewer assigned. This gets given to us in -- a variety of ad-hoc ways; filter them out here. @@ -418,7 +433,8 @@ lookupReviewers ra = do let ue' = case (T.unpack ue) Re.=~ ("^<(.*)>$" :: String) of (_ :: String, _ :: String, _ :: String, [t']) -> T.pack t' _ -> ue - in withRedmineIdThing "mail" (pure . M.listToMaybe) redmineUsers ue' (pure . Just) + -- if there's more than one, just pick the first; that's gross, but... + in withRedmineIdThing "mail" (\_ -> pure . M.listToMaybe) redmineUsers ue' (pure . Just) >>= maybe (warn ue *> pure Nothing) (pure . Just) warn ue = liftIO $ IO.hPutStrLn IO.stderr $ "ERR: Unable to find user ID for email: " ++ show ue @@ -434,8 +450,11 @@ jsonifyRedmineApp ri ra = do A.object $ addfm "assigned_to_id" ra_assignee $ [ "custom_fields" A..= (A.toJSON $ addcfm ri_cf_triageA ra_reviewer1 + $ addcfm ri_cf_scoreA ra_score1 $ addcfm ri_cf_triageB ra_reviewer2 + $ addcfm ri_cf_scoreB ra_score2 $ [ mkcf ri_cf_jhuAppId ra_jhuAppId + , mkcf ri_cf_email ra_email , mkcf ri_cf_pdfURL ra_pdfURL , mkcf ri_cf_citizen ra_citizen_us , mkcf ri_cf_areas ra_areas @@ -447,8 +466,8 @@ jsonifyRedmineApp ri ra = do , "subject" A..= (ra ^. ra_subject) ] where - addfm :: (A.ToJSON v) - => Text -> L.Lens' (RedmineApplicant (Maybe Integer)) (Maybe v) -> [A.Pair] -> [A.Pair] + addfm :: (A.ToJSON v, A.KeyValue a) + => Text -> L.Lens' (RedmineApplicant (Maybe Integer)) (Maybe v) -> [a] -> [a] addfm f v = maybe id (\vv -> ((f A..= vv) :)) (ra ^. v) addcfm :: (A.ToJSON v) @@ -464,35 +483,103 @@ jsonifyRedmineApp ri ra = do mkcf f v = A.object [ "id" A..= show (ri ^. f), "value" A..= (ra ^. v) ] ------------------------------------------------------------------------ }}} ---- Redmine API Updates ------------------------------------------------ {{{ - --- Construct a new applicant; note that we have to add the project_id and --- tracker_id from the RedmineInfo we have. -redmineNewIssue :: RedmineInfo -> RedmineApplicant (Maybe Integer) -> RestT IO (W.Response BL.ByteString) -redmineNewIssue ri ra = do - RTD s o u vp <- MR.ask - let (A.Object fs) = jsonifyRedmineApp ri ra - let fs' = (DHS.fromList [ "project_id" A..= (ri ^. ri_projId), "tracker_id" A..= (ri ^. ri_trackId) ]) <> fs - liftIO $ WS.postWith o s (u ++ "/issues.json") (A.object ["issue" A..= fs']) - >>= \resp -> vp resp >> pure resp +-- Redmine Applicant From Redmine JSON --------------------------------- {{{ + +-- Parse a Redmine JSON response into a RedmineApplicant structure +jsonToRedmineApplicant :: RedmineInfo -> A.Value -> Maybe (RedmineApplicant (Maybe Integer)) +jsonToRedmineApplicant ri va = do + subj <- va ^? A.key "subject" . A._String + cfs <- va ^? A.key "custom_fields" + let + lcf :: L.Lens' RedmineInfo Integer -> Maybe (A.Value) + lcf f = cfs ^? L.traverseOf A.values . L.filtered (`idIs` (ri ^. f)) . A.key "value" + email <- lcf ri_cf_email >>= (^? A._String) + pdf <- lcf ri_cf_pdfURL >>= (^? A._String) + appId <- lcf ri_cf_jhuAppId >>= (^? A._String) + gre <- lcf ri_cf_gre >>= (^? A._String) + toefl <- lcf ri_cf_toefl >>= (^? A._String) + facul <- lcf ri_cf_faculty >>= (^? A._String) + insts <- lcf ri_cf_insts >>= (^? A._String) + usCit <- lcf ri_cf_citizen >>= (^? A._String) >>= pure . (== "1") + areas <- lcf ri_cf_areas >>= (^? A._JSON) + let tA = lcf ri_cf_triageA >>= (^? A._String) >>= (readMaybe . T.unpack) + let tAs = lcf ri_cf_scoreA >>= (^? A._String) >>= (readMaybe . T.unpack) + let tB = lcf ri_cf_triageB >>= (^? A._String) >>= (readMaybe . T.unpack) + let tBs = lcf ri_cf_scoreB >>= (^? A._String) >>= (readMaybe . T.unpack) + let ae = va ^? A.key "assigned_to" . A.key "id" . A._Integer + return $ RedmineApplicant + { _ra_subject = subj + , _ra_email = email + , _ra_pdfURL = pdf + , _ra_jhuAppId = appId + , _ra_gre = gre + , _ra_toefl = toefl + , _ra_faculty = facul + , _ra_insts = insts + , _ra_citizen_us = usCit + , _ra_areas = areas + , _ra_reviewer1 = tA + , _ra_score1 = tAs + , _ra_reviewer2 = tB + , _ra_score2 = tBs + , _ra_assignee = ae + } + where + idIs :: A.Value -> Integer -> Bool + idIs o x = o L.^? A.key "id" == Just (A.toJSON x) --- Update an existing applicant; sends all fields and Redmine sorts it out -redmineUpdateIssue :: RedmineInfo -> Integer -> RedmineApplicant (Maybe Integer) -> RestT IO (W.Response BL.ByteString) -redmineUpdateIssue ri n ra = do - RTD s o u vp <- MR.ask - liftIO $ WS.putWith o s (u ++ "/issues/" ++ show n ++ ".json") (A.object ["issue" A..= jsonifyRedmineApp ri ra]) - >>= \resp -> vp resp >> pure resp ------------------------------------------------------------------------- }}} ------------------------------------------------------------------------ }}} --- withRedmine --------------------------------------------------------- {{{ +-- withRedmine and friends --------------------------------------------- {{{ +--- RestT Monad Transformer -------------------------------------------- {{{ +data RestTD scheme e = RTD + { _rtd_base :: WR.Url scheme + , _rtd_req_config :: WR.HttpConfig + , _rtd_req_opts :: WR.Option scheme + , _rtd_http_err :: WR.HttpException -> e + } + +-- | Package up most things we need to make ReSTful queries +newtype RestT scheme e m a = RestT { runRestT :: ME.ExceptT e (MR.ReaderT (RestTD scheme e) m) a } + deriving (Applicative,Functor,Monad,MonadIO,MR.MonadReader (RestTD scheme e)) + +$(L.makeLensesFor [("_rtd_req_opts", "rtd_req_opts")] ''RestTD) + +deriving instance (Monad m) => ME.MonadError e (RestT scheme e m) + +instance MR.MonadTrans (RestT scheme e) where + lift x = RestT (ME.lift (MR.lift x)) + +-- Yikes... we need these to get exception handlers working with our +-- RestT transformer. Thankfully it's "chant default a lot". +instance (MC.MonadBase b m) => MC.MonadBase b (RestT scheme e m) where + liftBase = RestT . MC.liftBase + +instance MC.MonadTransControl (RestT scheme e) where + type StT (RestT scheme e) a = Either e a + liftWith f = RestT $ ME.ExceptT $ ME.liftM return $ MR.ReaderT $ \r -> f (flip MR.runReaderT r . ME.runExceptT . runRestT) + restoreT = RestT . ME.ExceptT . MR.ReaderT . const + +instance (MC.MonadBaseControl b m) => MC.MonadBaseControl b (RestT scheme e m) where + type StM (RestT scheme e m) a = MC.ComposeSt (RestT scheme e) m a + liftBaseWith = MC.defaultLiftBaseWith + restoreM = MC.defaultRestoreM + +instance (Monad m, MonadIO m) => WR.MonadHttp (RestT scheme e m) where + handleHttpException e = MR.asks _rtd_http_err >>= ME.throwError . ($ e) + getHttpConfig = MR.asks _rtd_req_config +------------------------------------------------------------------------ }}} +--- withRedmine -------------------------------------------------------- {{{ -- | A wrapper which sets us up to make ReSTful queries against a Redmine -- instance given the common arguments. -- -- Makes a boatload of requests itself to figure out common parameters -- of the Redmine setup used by CLSP. Hooray. -withRedmine :: ArgCommon -> (RedmineInfo -> RestT IO a) -> IO a -withRedmine ac cb = do +withRedmine :: ArgCommon + -> (WR.HttpException -> e) + -> (forall scheme . RedmineInfo -> RestT scheme e IO a) + -> IO (Either e a) +withRedmine ac ecb cb = do let rurl = ac_redmineURL ac let tlss0 = if ac_cert_check ac then N.tlsManagerSettings @@ -503,18 +590,21 @@ withRedmine ac cb = do mkTLSC <- N.managerTlsConnection tlss0 c <- mkTLSC ha h p pure c { N.connectionWrite = \bs -> do - mapM_ (\bsl -> do - IO.hPutStr stderr "> " - BS8.hPutStrLn stderr bsl) - (BS8.lines bs) + mapM_ (trace "> ") (BS8.lines bs) N.connectionWrite c bs + -- , N.connectionRead = do + -- res <- N.connectionRead c + -- mapM_ (trace "< ") (BS8.lines res) + -- return res } } - let vp = if ac_debug ac < 2 - then \_ -> pure () - else print - let wreqOpts = W.defaults & W.auth .~ Just (W.basicAuth (fromString $ ac_redmineAuth ac) "") - WS.withSessionControl Nothing tlss $ \sess -> flip MR.runReaderT (RTD sess wreqOpts rurl vp) $ runRestT $ do + where trace pfx bsl = IO.hPutStr stderr pfx >> BS8.hPutStrLn stderr bsl + let reqOpts = WR.basicAuth (fromString $ ac_redmineAuth ac) "" + + N.newManager tlss >>= \manager -> + flip MR.runReaderT (RTD rurl (Def.def { WR.httpConfigAltManager = Just manager }) reqOpts ecb) + $ ME.runExceptT + $ runRestT $ do -- We need to look up a whole lot of custom fields; since there aren't -- that many of them, grab them all into RAM now and scan locally rather @@ -530,6 +620,7 @@ withRedmine ac cb = do -- custom fields <*> redmineIdNamed rerr (CL.sourceList customFields) "Research Areas" <*> redmineIdNamed rerr (CL.sourceList customFields) "US Citizen" + <*> redmineIdNamed rerr (CL.sourceList customFields) "Applicant Email Address" <*> redmineIdNamed rerr (CL.sourceList customFields) "Faculty of Interest" <*> redmineIdNamed rerr (CL.sourceList customFields) "GRE Scores" <*> redmineIdNamed rerr (CL.sourceList customFields) "Prior Institutions" @@ -537,59 +628,55 @@ withRedmine ac cb = do <*> redmineIdNamed rerr (CL.sourceList customFields) "PDF Application" <*> redmineIdNamed rerr (CL.sourceList customFields) "TOEFL Score" <*> redmineIdNamed rerr (CL.sourceList customFields) "Triage A" + <*> redmineIdNamed rerr (CL.sourceList customFields) "Triage A Score" <*> redmineIdNamed rerr (CL.sourceList customFields) "Triage B" + <*> redmineIdNamed rerr (CL.sourceList customFields) "Triage B Score" cb ri where - rerr [] = error "Could not find redmine project by name." - rerr _ = error "Redmine project name is not unique." + rerr n [] = error ("Could not find redmine object by name: " ++ (T.unpack n)) + rerr n _ = error ("Redmine object name is not unique: " ++ (T.unpack n)) -wreqParamRedmineProjAndTrack :: RedmineInfo -> W.Options -> W.Options -wreqParamRedmineProjAndTrack ri - = (W.param "project_id" .~ [tfi $ ri ^. ri_projId]) - . (W.param "tracker_id" .~ [tfi $ ri ^. ri_trackId]) +------------------------------------------------------------------------ }}} +------------------------------------------------------------------------ }}} +-- Command: Ping ------------------------------------------------------- {{{ + +doPing :: ArgCommon -> IO () +doPing ac = wrap =<< withRedmine ac show (\_ -> return ()) where - tfi :: Integer -> T.Text - tfi = T.pack . show + wrap :: Either String () -> IO () + wrap = either IO.putStrLn return ------------------------------------------------------------------------ }}} --- CSV Upsert ---------------------------------------------------------- {{{ +-- Command: CSV Upsert ------------------------------------------------- {{{ + +data CsvUpsertParams = CUP + { _cvsUpsertClobber :: Bool + , _cvsUpsertDryRun :: Bool + , _cvsUpsertSepChar :: DW.Word8 + } -- Insert or Update an applicant based on CSV data -data ArgUpsert = ArgUpsert - { upsert_clobber :: Bool - , upsert_dryrun :: Bool - } - deriving (D.Data,Eq) - -instance Cm.Attributes ArgUpsert where - attributes _ = Cm.group "Upsert Options" - [ upsert_clobber - Cm.%> [ Cm.Short "x" , Cm.Long ["clobber"] - , Cm.Help "Overwrite existing records" ] - , upsert_dryrun - Cm.%> [ Cm.Short "n" , Cm.Long ["dry-run","no-act"] - , Cm.Help "Do not actually run upserts" ] - ] - -data Upsert = Upsert ArgCommon - deriving (D.Data,Eq) - -instance Cm.Command Upsert (Cm.Record ArgUpsert) where - cmdname _ = "upsert" - run (Upsert ac) au _ = withRedmine ac go +doCsvUpsert :: CsvUpsertParams -> ArgCommon -> IO () +doCsvUpsert (CUP pClobber pDryRun pSepChar) ac = wrap =<< withRedmine ac (T.pack . show) go where + wrap :: Either Text () -> IO () + wrap = either IO.print return + + -- Cassava decode options + csvdec = CSV.defaultDecodeOptions { CSV.decDelimiter = pSepChar } + -- Alright, here's our pipeline; the heart of the upsert command. We -- start by... - go :: RedmineInfo -> RestT IO () + go :: RedmineInfo -> RestT scheme T.Text IO () go ri = C.runConduit $ -- ... reading stdin as chunks of bytes ... CB.sourceHandle IO.stdin -- ... converting those chunks of bytes to CSVApplicants ... - C.=$= CSV.fromNamedCsvStreamError CSV.defaultDecodeOptions + C.=$= CSV.fromNamedCsvStreamError csvdec raiseCsvStreamErr -- ... filtering out any CSV errors and showing them ... - C.=$= CL.mapMaybeM (either ((*> pure Nothing) . printErr) (pure . Just)) + C.=$= CL.mapMaybeM (either ((*> pure Nothing) . printCsvErr) (pure . Just)) -- ... purely mapping schemas ... C.=$= CL.map csvToRedmine -- ... using Redmine to convert reviewers ... @@ -598,7 +685,7 @@ instance Cm.Command Upsert (Cm.Record ArgUpsert) where C.=$= CL.mapM_ process where -- Once we've got an applicant... - process :: RedmineApplicant (Maybe Integer) -> RestT IO () + process :: RedmineApplicant (Maybe Integer) -> RestT scheme e IO () -- This cryptic little number traps any HTTP errors on -- a per-candidate basis so that we don't bail the -- first time there's an error. It matters a little @@ -607,15 +694,16 @@ instance Cm.Command Upsert (Cm.Record ArgUpsert) where process what = MC.control $ \run -> handle printHTTPErr $ run $ do let appid = _ra_jhuAppId what -- ... see if they already exist in Redmine ... - raids <- MR.local (rtd_opts %~ ( wreqParamRedmineProjAndTrack ri - . (W.param (fromString ("cf_" ++ show (_ri_cf_jhuAppId ri))) - .~ [appid]))) + raids <- MR.local (rtd_req_opts %~ ( + \x -> x <> ("project_id" WR.=: (tfi $ ri ^. ri_projId)) + <> ("tracker_id" WR.=: (tfi $ ri ^. ri_trackId)) + <> ((fromString ("cf_" ++ show (_ri_cf_jhuAppId ri))) WR.=: appid))) $ C.sourceToList $ redmineIssues C.=$= CL.mapMaybe (^? A.key "id" . A._Integer) -- ... and respond appropriately by... - case (raids, upsert_clobber au) of + case (raids, pClobber) of -- complaining if there's a problem (_:_:_, _) -> liftIO $ IO.putStrLn ("Multiple applicants with the same ID? " ++ show appid) @@ -631,74 +719,210 @@ instance Cm.Command Upsert (Cm.Record ArgUpsert) where ("Not clobbering existing applicant ID " ++ show appid) - new :: RedmineApplicant (Maybe Integer) -> RestT IO () - new what = if upsert_dryrun au - then liftIO $ do + tfi :: Integer -> T.Text + tfi = T.pack . show + + new :: RedmineApplicant (Maybe Integer) -> RestT scheme e IO () + new what = if pDryRun + then when (ac_debug ac > 0) $ liftIO $ do IO.putStrLn "Would insert new candidate" BL8.putStrLn (A.encode $ jsonifyRedmineApp ri what) else redmineNewIssue ri what >> pure () - upd :: Integer -> RedmineApplicant (Maybe Integer) -> RestT IO () - upd applicant what = if upsert_dryrun au + upd :: Integer -> RedmineApplicant (Maybe Integer) -> RestT scheme e IO () + upd applicant what = if pDryRun then liftIO $ do IO.putStrLn ("Would update existing candidate issue " ++ (show applicant)) BL8.putStrLn (A.encode $ jsonifyRedmineApp ri what) else redmineUpdateIssue ri applicant what >> pure () - printErr = liftIO . IO.putStrLn . showCSVError + printCsvErr (CSV.CsvStreamRecordParseError e) = liftIO $ IO.putStrLn $ "CSV ERR (skipping record): " ++ (T.unpack e) + + raiseCsvStreamErr :: CSV.CsvStreamHaltParseError -> Text + raiseCsvStreamErr (CSV.HaltingCsvParseError _ e) = e + + printHTTPErr :: N.HttpException -> IO (Either e ()) + printHTTPErr e = do + liftIO $ IO.putStrLn $ "ERR: Bad interaction; response is: " ++ (show e) + return (Right ()) - printHTTPErr (e :: N.HttpException) = liftIO $ IO.putStrLn $ "ERR: Bad interaction; response is: " ++ (show e) + progress :: RedmineApplicant a -> RestT scheme e IO () + progress what = liftIO $ IO.putStrLn $ "Processed applicant ID " ++ (T.unpack $ _ra_jhuAppId what) - progress what = liftIO $ IO.putStrLn $ "Processed applicant ID " ++ show (_ra_jhuAppId what) +parseUpsert :: OA.Parser CsvUpsertParams +parseUpsert = CUP + <$> OA.flag False True (OA.long "clobber" <> OA.short 'x' <> OA.help "Overwrite existing records") + <*> OA.flag False True (OA.long "dry-run" <> OA.long "no-act" <> OA.short 'n' <> OA.help "Do not actually run imports") + <*> OA.option argWord8AsChar (OA.long "sep" <> OA.short 's' <> OA.value (fromIntegral $ DC.ord ',') + <> OA.help "Set the separator value (defaults to ',')") + +------------------------------------------------------------------------ }}} +-- Command: Test Redmine Applicant Parser ------------------------------ {{{ + +doTestParse :: ArgCommon -> IO () +doTestParse ac = wrap =<< withRedmine ac show go + where + wrap :: Either String () -> IO () + wrap = either IO.putStrLn return + + go :: RedmineInfo -> RestT scheme e IO () + go ri = do + x <- liftIO $ BL.hGetContents IO.stdin + case A.decode x of + Just (v :: A.Value) -> liftIO $ print (jsonToRedmineApplicant ri v) + Nothing -> liftIO $ putStrLn "JSON decode failure" + +------------------------------------------------------------------------ }}} +-- Command: Applicants in Triage --------------------------------------- {{{ + +-- XXX Not quite yet done. + +data TriageParams = TP + { _triageDryRun :: Bool + } + +parseTriage :: OA.Parser TriageParams +parseTriage = TP + <$> OA.flag False True (OA.long "dry-run" <> OA.long "no-act" <> OA.short 'n' <> OA.help "Do not promote") + +doApplicantsInTriage :: TriageParams -> ArgCommon -> IO () +doApplicantsInTriage (TP pDryRun) ac = wrap =<< withRedmine ac show go + where + wrap :: Either String () -> IO () + wrap = either IO.putStrLn return + + go :: RedmineInfo -> RestT scheme e IO () + go ri = do + isstats <- C.sourceToList redmineIssueStats + + insid <- redmineIdNamed rerr (CL.sourceList isstats) "In Triage" + outsid <- redmineIdNamed rerr (CL.sourceList isstats) "Passed Triage" + + let applicants = + MR.local (rtd_req_opts %~ ( + \x -> x <> ("project_id" WR.=: (tfi $ ri ^. ri_projId)) + <> ("tracker_id" WR.=: (tfi $ ri ^. ri_trackId)) + <> ("status_id" WR.=: (tfi $ insid)) + )) + redmineIssues + + let process ra = do + liftIO $ IO.putStr ((T.unpack $ _ra_subject ra) ++ ": ") + liftIO $ IO.putStrLn $ + case (_ra_score1 ra, _ra_score2 ra) of + (Nothing, Nothing) -> "No scores" + (Just x, Nothing) | x >= 5 -> "No second score, but first good enough" + (Nothing, Just x) | x >= 5 -> "No first score, but second good enough" + (Just x1, Just x2) | let xs = [x1,x2] in all (>= 4) xs || any (>= 5) xs -> ("Passed; move to " ++ (show outsid)) + (_,_) -> "No go" + + C.runConduit + $ applicants + C.=$= CL.map (jsonToRedmineApplicant ri) + C.=$= CL.map (maybe (error "Failed to decode applicant") id) + C.=$= CL.mapM_ process + where + tfi :: Integer -> T.Text + tfi = T.pack . show + + rerr n [] = error ("Could not find redmine object by name: " ++ (T.unpack n)) + rerr n _ = error ("Redmine object name is not unique: " ++ (T.unpack n)) + +------------------------------------------------------------------------ }}} +-- Command: Expected Yield --------------------------------------------- {{{ + +-- XXX not yet + +-- data ExpectedYieldSummary = EYS +-- !Int -- number of applicants +-- !Double -- summed expected yield +-- ![Int] -- list of applicant IDs without EYs +-- +-- summarizeExpectedYield :: Monad m => C.Sink A.Value m ExpectedYieldSummary +-- summarizeExpectedYield = flip C.fold +-- (EYS 0 0 []) -- starting summary value +-- $ \(EYS n ey bs) v -> -- function to merge summary and new issue +-- case extractExpectedYield v of +-- -- Try to be nice and report the ID of any issues that +-- -- do not have parsable expected yields, rather than +-- -- just bailing or ignoring them. +-- Nothing -> EYS (n+1) ey ((unsafeGetID v):bs) +-- Just eyc -> EYS (n+1) (ey+eyc) bs +-- where +-- extractExpectedYield o = o `getCustomDouble` "Expected Yield" ------------------------------------------------------------------------ }}} -- Argument Parsing and main function ---------------------------------- {{{ --- Common argument parsing. Nothing terribly fancy. +argWord8AsChar :: OA.ReadM DW.Word8 +argWord8AsChar = do + c :: Char <- OA.auto + let i = DC.ord c + if i > (fromIntegral (maxBound :: DW.Word8)) + then OA.readerError "Selected character value does not fit in 8 bits!" + else return (fromIntegral i) + +infoh :: forall a. OA.Parser a -> OA.InfoMod a -> OA.ParserInfo a +infoh p = OA.info (p <**> OA.helper) -redmine_commands :: ArgCommon -> [Cm.CommandWrap] -redmine_commands f = Cm.commandGroup "Redmine Command" (Upsert f) +-- Common argument parsing. Nothing terribly fancy. data ArgCommon = ArgCommon - { ac_redmineURL :: String + { ac_redmineURL :: WR.Url 'WR.Https , ac_redmineAuth :: String , ac_redmineProjName :: String , ac_cert_check :: Bool , ac_debug :: Int } - deriving (D.Data,Eq,Show) - -instance Cm.Attributes ArgCommon where - attributes _ = Cm.group "Common Options" - [ ac_redmineURL - Cm.%> [ Cm.Short "h" , Cm.Long ["url", "host"] - , Cm.Help "Base to redmine server", Cm.ArgHelp "URL" ] - , ac_redmineAuth - Cm.%> [ Cm.Short "au", Cm.Long ["auth", "user"] - , Cm.Help "Authentication token" , Cm.ArgHelp "STRING" ] - , ac_redmineProjName - Cm.%> [ Cm.Short "p" , Cm.Long ["project"] - , Cm.Help "Project Name" , Cm.ArgHelp "STRING" ] - , ac_cert_check - Cm.%> [ Cm.Short "C" , Cm.Long ["cert"], Cm.Default False - , Cm.Help "certificate checking" ] - , ac_debug - Cm.%> [ Cm.Short "v" , Cm.Long ["debug"], Cm.Default (0 :: Int) - , Cm.Help "verbosity" , Cm.ArgHelp "LEVEL" ] - ] - -data RedmineCommand = RedmineCommand deriving (D.Typeable,Eq) - -instance Cm.Command RedmineCommand (Cm.Record ArgCommon) where - summary _ = "Interact with Redmine" - help _ = Cm.helpCommands (redmine_commands undefined) - cmdname _ = "redmine" - supercommand _ = True - synopsis _ = "redmine [COMMON OPTIONS] [REDMINE COMMAND] ..." - run _ f opts = Cm.dispatch [] (redmine_commands f) opts + +redmine_commands :: OA.Parser (ArgCommon -> IO ()) +redmine_commands = OA.subparser + $ pingCommand + <> upsertCommand + -- <> expectedYieldCommand + <> testParseCommand + <> inTriageCommand + where + pingCommand :: OA.Mod OA.CommandFields (ArgCommon -> IO ()) + pingCommand = OA.command "ping" + $ infoh (pure doPing) (OA.progDesc "Ping the Redmine server") + + upsertCommand :: OA.Mod OA.CommandFields (ArgCommon -> IO ()) + upsertCommand = OA.command "upsert" + $ infoh (doCsvUpsert <$> parseUpsert) + (OA.progDesc "Upsert from CSV on stdin" + <> OA.footer "Note that input *must* be UTF-8. Try 'iconv --from latin1 --to utf8'") + + testParseCommand :: OA.Mod OA.CommandFields (ArgCommon -> IO ()) + testParseCommand = OA.command "test-parse" + $ infoh (pure doTestParse) + (OA.progDesc "Test parse") + + inTriageCommand :: OA.Mod OA.CommandFields (ArgCommon -> IO ()) + inTriageCommand = OA.command "in-triage" + $ infoh (doApplicantsInTriage <$> parseTriage) + (OA.progDesc "In Triage (in progress)") + +oat :: OA.ReadM a -> [String] -> [Char] -> String -> String -> OA.Mod OA.OptionFields a -> OA.Parser a +oat t ls ss m h x = OA.option t (OA.help h <> OA.metavar m <> mconcat (map OA.long ls) <> mconcat (map OA.short ss) <> x) + +parseArgCommon :: OA.Parser ArgCommon +parseArgCommon = ArgCommon + <$> oat host ["host"] ['h'] "HOST" "Redmine server host" + (OA.value $ WR.https "clsp-redmine.cs.jhu.edu") + <*> oat OA.str ["auth","user"] ['a','u'] "STRING" "Authentication token" mempty + <*> oat OA.str ["project"] ['p'] "ProjName" "Project name" mempty + <*> OA.flag False True (OA.long "cert" <> OA.short 'C') + <*> oat OA.auto ["debug"] ['v'] "LEVEL" "Verbosity" (OA.value 0) + where + host = (WR.https . T.pack) <$> OA.str main :: IO () -main = Cm.getArgs >>= Cm.execute (Cm.cmd :: RedmineCommand) +main = do + putStrLn "Redmine client starting..." + join $ OA.execParser + $ infoh ((flip ($)) <$> parseArgCommon <*> redmine_commands) + (OA.progDesc "Interact with clsp-redmine.cs.jhu.edu") ------------------------------------------------------------------------ }}} --- vim: foldmethod=marker:ts=2 +-- vim: set foldmethod=marker ts=2 -- 2.50.1