packages feed

tempo (empty) → 0.1.0.0

raw patch · 11 files changed

+369/−0 lines, 11 filesdep +ConfigFiledep +MissingHdep +basesetup-changed

Dependencies added: ConfigFile, MissingH, base, base64-bytestring, bytestring, directory, filepath, http-conduit, mtl, process, regex-posix, resourcet, split, tempo, time

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Timur Rubeko (c) 2015++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Timur Rubeko nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/FromGit.hs view
@@ -0,0 +1,17 @@+module Main where++import System.Environment+import Data.Either.Utils++import Config+import Git+import CLI++main :: IO ()+main = do+  args <- getArgs+  user <- getGitUser+  config <- forceEither <$> readConfig+  gitLog <- getGitLog config user args+  let workLog = calculateWorkLog gitLog+  submitLogInteractive config workLog
+ app/Simple.hs view
@@ -0,0 +1,41 @@+module Simple where++import System.Environment+import Control.Monad.Except+import Data.Time+import Data.Time.Format+import Data.Either.Utils++import Config+import Jira+import Git+import CLI+++main :: IO ()+main = do+  args <- getArgs+  config <- forceEither <$> readConfig+  let workLog = forceEither $ parseArgs args+  submitLogInteractive config [workLog]++usage = "usage: tempo-simple DATE ISSUE HOURS"++parseArgs :: [String] -> Either String WorkLog+parseArgs [d,i,h] = do+  day <- parseDay d+  hrs <- parseFloat h+  return $ WorkLog day i hrs+parseArgs xs+  | length xs < 3 = throwError $ "not enough arguments; " ++ usage+  | otherwise     = throwError $ "too many arguments; " ++ usage++parseDay :: String -> Either String Day+parseDay xs = case parseTimeM False defaultTimeLocale "%Y/%m/%d" xs of+                Just d  -> return d+                Nothing -> throwError $ "cannot parse date " ++ xs ++ " in fomrat yyyy/mm/dd"++parseFloat :: String -> Either String Float+parseFloat xs = case reads xs of+                  [(n,"")] -> return n+                  _        -> throwError "cannot parse hours worked"
+ src/CLI.hs view
@@ -0,0 +1,30 @@+module CLI+( submitLogInteractive+) where++import Control.Monad+import Text.Printf++import Config+import Jira+++askToConfirm :: [WorkLog] -> IO Bool+askToConfirm workLog = do+  putStrLn "Will log following items:"+  mapM_ (putStrLn . sitem) workLog+  putStrLn "OK? (y/n)"+  r <- getLine+  return $ r == "y"++sitem :: WorkLog -> String+sitem workLog = " * " ++ show workLog++submitLogInteractive :: Config -> [WorkLog] -> IO ()+submitLogInteractive config workLog = do+  confirmed <- askToConfirm workLog+  when confirmed $ do+    logWork config workLog+    printf "Work logged. Find your timesheet at https://%s/secure/TempoUserBoard!timesheet.jspa\n" (getJiraHost config)+  unless confirmed $+    putStrLn "Abort. Nothing logged."
+ src/Config.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE FlexibleContexts #-}++module Config+( Config(..)+, IssuePattern+, readConfig+) where++import System.Directory+import System.FilePath+import Data.List.Split+import Data.ConfigFile+import Control.Monad.Except+import Data.ByteString.Char8 (ByteString(..), pack)+import Data.ByteString.Base64 (decodeLenient)+++type IssuePattern = String++data Config = Config { getGitRepositories::[FilePath]+                     , getIssuePatterns::[IssuePattern]+                     , getJiraHost::String+                     , getJiraUser::ByteString+                     , getJiraPassword::ByteString+                     } deriving (Show)++readConfig :: IO (Either String Config)+readConfig = do+  homePath <- getHomeDirectory+  errorOrConfig <- runExceptT $ do+    cp       <- join $ liftIO $ readfile emptyCP (homePath </> ".tempo.conf")+    repos    <- get cp "git" "repos"+    projects <- get cp "jira" "projects"+    jiraHost <- get cp "jira" "host"+    jiraUser <- get cp "jira" "user"+    jiraPass <- get cp "jira" "pass"+    return $ Config (splitOn "," repos)+                    (map projectToPattern (splitOn "," projects))+                    jiraHost+                    (pack jiraUser)+                    (decodeLenient . pack $ jiraPass)+  return $ case errorOrConfig of+    (Left err) -> Left $ show err+    (Right cfg) -> Right cfg++projectToPattern :: String -> IssuePattern+projectToPattern projectCode = projectCode ++ "\\-[0-9]+"
+ src/Git.hs view
@@ -0,0 +1,70 @@+module Git+( getGitUser+, getGitLog+, calculateWorkLog+) where++import System.IO+import System.Process+import System.FilePath++import Data.Time.Format+import Text.Regex.Posix+import Data.Time+import qualified Data.List as L++import Config+import Util+import Jira+++type User = String+type GitArgs = [String]++data Commit = Commit Day Issue deriving (Show, Eq, Ord)+++getGitUser :: IO User+getGitUser = trim <$> readProcess "git" ["config", "user.email"] []+++getGitLog :: Config -> User -> GitArgs -> IO [Commit]+getGitLog config user args = do+  log <- reflog user args (getGitRepositories config)+  return $ extractCommits log (getIssuePatterns config)+++-- extract commits matching any expected issue patter from git log+extractCommits :: [String] -> [IssuePattern] -> [Commit]+extractCommits log = concatMap (extractCommits' log)++-- extract commits mathcing expected issue pattern from git log+extractCommits' :: [String] -> IssuePattern -> [Commit]+extractCommits' log issuePattern =+  let relevant = filter (=~ issuePattern) log+      issues = map (=~ issuePattern) relevant+      dates = map (parseTimeOrError False defaultTimeLocale "%Y-%m-%d" . take 10) relevant+  in zipWith Commit dates issues+++-- extract git log lines for all given repositories, merged to one list+reflog :: User -> GitArgs -> [FilePath] -> IO [String]+reflog user gitArgs repos =+  let listOfLogs = mapM (reflog' user gitArgs) repos+  in  concat <$> listOfLogs++-- extract git log lines for one repository only+reflog' :: User -> GitArgs -> FilePath -> IO [String]+reflog' user gitArgs repoPath = do+  let args = ["log", "-g", "--all", "--format=%ai %gD %gs", "--author="++user] ++ gitArgs+      gitProcess = (proc "git" args){cwd = Just repoPath}+  lines <$> readCreateProcess gitProcess ""+++calculateWorkLog :: [Commit] -> [WorkLog]+calculateWorkLog gitLog =+  let noDuplicates = L.nub gitLog+      grouped = L.groupBy (\(Commit d1 _) (Commit d2 _) -> d1 == d2) $ L.sort noDuplicates+      avHours = map (\cs -> 8.0 / (fromIntegral . length $ cs)) grouped+      logs = zipWith (\cs h -> map (\(Commit d i) -> WorkLog d i h) cs) grouped avHours+  in  concat logs
+ src/Jira.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE OverloadedStrings #-}++module Jira+( Issue+, HoursWorked+, WorkLog(..)+, logWork+) where++import Data.Time+import Data.Time.Format+import Text.Printf+import Network.HTTP.Conduit+import Control.Monad.Trans.Resource (runResourceT)+import Data.ByteString.Char8 (ByteString(..), pack)++import Config+++type Issue = String+type HoursWorked = Float++data WorkLog = WorkLog Day Issue HoursWorked++instance Show WorkLog where+  show (WorkLog d i h) = printf "%s - %s - %.1f hours" (show d) i h+++logWork :: Config -> [WorkLog] -> IO ()+logWork conf ws = mapM_ (logOne conf) ws++logOne :: Config -> WorkLog -> IO ()+logOne conf (WorkLog d i h) = do+  request'' <- parseUrl $ issueUrl conf i+  let request' = applyBasicAuth (getJiraUser conf) (getJiraPassword conf) request''+      params = [("time", pack.show $ h), ("user", getJiraUser conf), ("date", datefmt d), ("ansidate", ansidatefmt d)]+      request = urlEncodedBody params request'+  manager <- newManager tlsManagerSettings+  runResourceT $ do+    response <- http request manager+    return ()++datefmt :: Day -> ByteString+datefmt = pack . formatTime defaultTimeLocale "%d/%b/%y"++ansidatefmt :: Day -> ByteString+ansidatefmt = pack . formatTime defaultTimeLocale "%Y-%m-%d"++issueUrl :: Config -> Issue -> String+issueUrl conf issue = printf "https://%s/rest/tempo-rest/1.0/worklogs/%s" (getJiraHost conf) issue
+ src/Util.hs view
@@ -0,0 +1,10 @@+module Util+( trim+) where++import Data.Char (isSpace)+import Data.ByteString.Char8 (ByteString, pack)++trim :: String -> String+trim = f . f+   where f = reverse . dropWhile isSpace
+ tempo.cabal view
@@ -0,0 +1,70 @@+name:                tempo+version:             0.1.0.0+synopsis:            Command-line tool to log time-tracking information into JIRA Tempo plugin+description:         Please see README.md+homepage:            http://github.com/candidtim/tempo#readme+license:             BSD3+license-file:        LICENSE+author:              Timur Rubeko+maintainer:          timur@rubeko.com+copyright:           Timur Rubeko+category:            NA+build-type:          Simple+-- extra-source-files:+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:     Config+                     , Util+                     , Jira+                     , Git+                     , CLI+  build-depends:       base >= 4.7 && < 5+                     , time+                     , process+                     , directory+                     , filepath+                     , regex-posix+                     , split+                     , ConfigFile+                     , mtl+                     , http-conduit+                     , resourcet+                     , bytestring+                     , base64-bytestring+  default-language:    Haskell2010++executable tempo-git+  hs-source-dirs:      app+  main-is:             FromGit.hs+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N -main-is Main+  build-depends:       base+                     , tempo+                     , mtl+                     , MissingH+  default-language:    Haskell2010++executable tempo-simple+  hs-source-dirs:      app+  main-is:             Simple.hs+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N -main-is Simple+  build-depends:       base+                     , tempo+                     , time+                     , mtl+                     , MissingH+  default-language:    Haskell2010++test-suite tempo-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  build-depends:       base+                     , tempo+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  default-language:    Haskell2010++source-repository head+  type:     git+  location: https://github.com/candidtim/tempo
+ test/Spec.hs view
@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"